X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdefstruct.lisp;h=b0f374b0bf7629b017ac196f45b7c792ecafb2cb;hb=15d6e7c9a2c3234f95dfe278046fa2fee1b0c007;hp=6d70ebeed6980add1042cd96452344d6634ecec8;hpb=beccf6c476f5cf2ef0bd839866527a46ec88d626;p=sbcl.git

diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp
index 6d70ebe..b0f374b 100644
--- a/src/code/defstruct.lisp
+++ b/src/code/defstruct.lisp
@@ -337,15 +337,18 @@
        (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))
@@ -358,6 +361,8 @@
 			    (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