silent non-toplevel DEFSTRUCT

  Use TRULY-THE in the constructor inline expansion only if the compiler knows
  the layout: using it for the lazy version doesn't help, and only causes a
  STYLE-WARNING.

diff --git a/NEWS b/NEWS
index a69f353..99a266b 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -30,6 +30,7 @@ changes relative to sbcl-1.0.54:
     (lp#898331)
   * bug fix: *EVALUATOR-MODE* :COMPILE treated (LET () ...) identically
     to (LOCALLY ...) leading to internally inconsistent toplevel-formness.
+  * bug fix: non-toplevel DEFSTRUCT signaled a style warning for unknown type.
 
 changes in sbcl-1.0.54 relative to sbcl-1.0.53:
   * minor incompatible changes:

diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp
index 27722b0..c3beef9 100644 (file)
--- a/src/code/defstruct.lisp
+++ b/src/code/defstruct.lisp
@@ -31,20 +31,20 @@
     (and layout (typep (layout-info layout) 'defstruct-description))))
 
 (sb!xc:defmacro %make-structure-instance-macro (dd slot-specs &rest slot-vars)
-  `(truly-the ,(dd-name dd)
-              ,(if (compiler-layout-ready-p (dd-name dd))
-                   `(%make-structure-instance ,dd ,slot-specs ,@slot-vars)
-                   ;; Non-toplevel defstructs don't have a layout at compile time,
-                   ;; so we need to construct the actual function at runtime -- but
-                   ;; we cache it at the call site, so that we don't perform quite
-                   ;; so horribly.
-                   `(let* ((cell (load-time-value (list nil)))
-                           (fun (car cell)))
-                      (if (functionp fun)
-                          (funcall fun ,@slot-vars)
-                          (funcall (setf (car cell)
-                                         (%make-structure-instance-allocator ,dd ,slot-specs))
-                                   ,@slot-vars))))))
+  (if (compiler-layout-ready-p (dd-name dd))
+      `(truly-the ,(dd-name dd)
+                  (%make-structure-instance ,dd ,slot-specs ,@slot-vars))
+      ;; Non-toplevel defstructs don't have a layout at compile time,
+      ;; so we need to construct the actual function at runtime -- but
+      ;; we cache it at the call site, so that we don't perform quite
+      ;; so horribly.
+      `(let* ((cell (load-time-value (list nil)))
+              (fun (car cell)))
+         (if (functionp fun)
+             (funcall fun ,@slot-vars)
+             (funcall (setf (car cell)
+                            (%make-structure-instance-allocator ,dd ,slot-specs))
+                      ,@slot-vars)))))
 
 (declaim (ftype (sfunction (defstruct-description list) function)
                 %make-structure-instance-allocator))

diff --git a/tests/defstruct.impure.lisp b/tests/defstruct.impure.lisp
index 5e5ed66..f9b4145 100644 (file)
--- a/tests/defstruct.impure.lisp
+++ b/tests/defstruct.impure.lisp
@@ -1121,3 +1121,9 @@ redefinition."
 (with-test (:name (:struct-predicate :obsolete-instance))
   (defclass class-to-be-redefined () ((a :initarg :a :initform 1)))
   (function-trampoline #'structure-with-predicate-p))
+
+(with-test (:name (:defstruct :not-toplevel-silent))
+  (let ((sb-ext:*evaluator-mode* :compile))
+    (handler-bind ((warning #'error))
+     (eval `(let ()
+              (defstruct destruct-no-warning-not-at-toplevel bar))))))