From f8e44b3103b284f98b18c177b5904b064ad44f93 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Thu, 24 Oct 2002 13:23:25 +0000 Subject: [PATCH] 0.7.8.54: simpleminded release-might-be-tomorrow fix for non-toplevel DEFSTRUCT bug (antireported by WHN on cmucl-imp, pointed out by CSR on #lisp:-) --- src/code/defstruct.lisp | 32 +++++++++++++++++++++++++++++--- tests/defstruct.impure.lisp | 13 +++++++++++++ version.lisp-expr | 2 +- 3 files changed, 43 insertions(+), 4 deletions(-) diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp index 96c8caa..2adbc99 100644 --- a/src/code/defstruct.lisp +++ b/src/code/defstruct.lisp @@ -27,10 +27,36 @@ (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) diff --git a/tests/defstruct.impure.lisp b/tests/defstruct.impure.lisp index 9cdc9d0..c86fb9e 100644 --- a/tests/defstruct.impure.lisp +++ b/tests/defstruct.impure.lisp @@ -375,6 +375,19 @@ ;;; 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))) ;;; success (format t "~&/returning success~%") diff --git a/version.lisp-expr b/version.lisp-expr index b66d2ba..d185164 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.8.53" +"0.7.8.54" -- 1.7.10.4