(t res))))
;;; Delay looking for compiler-layout until the constructor is being
-;;; compiled, since it doesn't exist until after the EVAL-WHEN (COMPILE)
-;;; stuff is compiled.
+;;; compiled, since it doesn't exist until after the EVAL-WHEN
+;;; (COMPILE) stuff is compiled. (Or, in the oddball case when
+;;; DEFSTRUCT is executing in a non-toplevel context, the
+;;; compiler-layout still doesn't exist at compilation time, and we
+;;; delay still further.)
(sb!xc:defmacro %delayed-get-compiler-layout (name)
- `',(compiler-layout-or-lose name))
+ (let ((layout (info :type :compiler-layout name)))
+ (cond (layout
+ ;; ordinary case: When the DEFSTRUCT is at top level,
+ ;; then EVAL-WHEN (COMPILE) stuff will have set up the
+ ;; layout for us to use.
+ (unless (typep (layout-info layout) 'defstruct-description)
+ (error "Class is not a structure class: ~S" name))
+ `,layout)
+ (t
+ ;; KLUDGE: In the case that DEFSTRUCT is not at top-level
+ ;; the layout doesn't exist at compile time. In that case
+ ;; we laboriously look it up at run time. This code will
+ ;; run on every constructor call and will likely be quite
+ ;; slow, so if anyone cares about performance of
+ ;; non-toplevel DEFSTRUCTs, it should be rewritten to be
+ ;; cleverer. -- WHN 2002-10-23
+ (sb!c::compiler-note
+ "implementation limitation: ~
+ Non-toplevel DEFSTRUCT constructors are slow.")
+ (let ((layout (gensym "LAYOUT")))
+ `(let ((,layout (info :type :compiler-layout ',name)))
+ (unless (typep (layout-info ,layout) 'defstruct-description)
+ (error "Class is not a structure class: ~S" ',name))
+ ,layout))))))
;;; Get layout right away.
(sb!xc:defmacro compile-time-find-layout (name)
;;; Even with bug 210, these assertions succeeded.
(assert (typep (nth-value 1 (ignore-errors *bug210*)) 'unbound-variable))
(assert (typep (nth-value 1 (ignore-errors (make-bug210b))) 'unbound-variable))
+
+;;; In sbcl-0.7.8.53, DEFSTRUCT blew up in non-toplevel contexts
+;;; because it implicitly assumed that EVAL-WHEN (COMPILE) stuff
+;;; setting up compiler-layout information would run before the
+;;; constructor function installing the layout was compiled. Make sure
+;;; that doesn't happen again.
+(defun foo-0-7-8-53 () (defstruct foo-0-7-8-53 x (y :not)))
+(assert (not (find-class 'foo-0-7-8-53 nil)))
+(foo-0-7-8-53)
+(assert (find-class 'foo-0-7-8-53 nil))
+(let ((foo-0-7-8-53 (make-foo-0-7-8-53 :x :s)))
+ (assert (eq (foo-0-7-8-53-x foo-0-7-8-53) :s))
+ (assert (eq (foo-0-7-8-53-y foo-0-7-8-53) :not)))
\f
;;; success
(format t "~&/returning success~%")