(if (dd-class-p dd)
(let ((inherits (inherits-for-structure dd)))
`(progn
- ;; Note we intentionally call %DEFSTRUCT first, and
- ;; especially before %COMPILER-DEFSTRUCT. %DEFSTRUCT
- ;; has the tests (and resulting CERROR) for collisions
- ;; with LAYOUTs which already exist in the runtime. If
- ;; there are any collisions, we want the user's
- ;; response to CERROR to control what happens.
- ;; Especially, if the user responds to the collision
- ;; with ABORT, we don't want %COMPILER-DEFSTRUCT to
- ;; modify the definition of the class.
+ ;; Note we intentionally enforce package locks and
+ ;; call %DEFSTRUCT first, and especially before
+ ;; %COMPILER-DEFSTRUCT. %DEFSTRUCT has the tests (and
+ ;; resulting CERROR) for collisions with LAYOUTs which
+ ;; already exist in the runtime. If there are any
+ ;; collisions, we want the user's response to CERROR
+ ;; to control what happens. Especially, if the user
+ ;; responds to the collision with ABORT, we don't want
+ ;; %COMPILER-DEFSTRUCT to modify the definition of the
+ ;; class.
+ (with-single-package-locked-error
+ (:symbol ',name "defining ~A as a structure"))
(%defstruct ',dd ',inherits)
(eval-when (:compile-toplevel :load-toplevel :execute)
(%compiler-defstruct ',dd ',inherits))
(class-method-definitions dd)))
',name))
`(progn
+ (with-single-package-locked-error
+ (:symbol ',name "defining ~A as a structure"))
(eval-when (:compile-toplevel :load-toplevel :execute)
(setf (info :typed-structure :info ',name) ',dd))
,@(unless expanding-into-code-for-xc-host-p
remove the ambiguity in your code.~@:>"
accessor-name)
(setf (dd-predicate-name defstruct) nil))
- #-sb-xc-host
- (when (and (fboundp accessor-name)
- (not (accessor-inherited-data accessor-name defstruct)))
- (style-warn "redefining ~S in DEFSTRUCT" accessor-name)))
-
+ ;; FIXME: It would be good to check for name collisions here, but
+ ;; the easy check,
+ ;;x#-sb-xc-host
+ ;;x(when (and (fboundp accessor-name)
+ ;;x (not (accessor-inherited-data accessor-name defstruct)))
+ ;;x (style-warn "redefining ~S in DEFSTRUCT" accessor-name)))
+ ;; which was done until sbcl-0.8.11.18 or so, is wrong: it causes
+ ;; a warning at MACROEXPAND time, when instead the warning should
+ ;; occur not just because the code was constructed, but because it
+ ;; is actually compiled or loaded.
+ )
+
(when default-p
(setf (dsd-default slot) default))
(when type-p
(if read-only
(setf (dsd-read-only slot) t)
(when (dsd-read-only slot)
- (error "Slot ~S is :READ-ONLY in parent and must be :READ-ONLY in subtype ~S."
- name
+ (error "~@<The slot ~S is :READ-ONLY in superclass, and so must ~
+ be :READ-ONLY in subclass.~:@>"
(dsd-name slot)))))
slot))