X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-defstruct.lisp;h=b36c483f6cbc6e9f05e8ae30126987e99776f82f;hb=ee5629ee974ee8ce7a1cb245a99e94f8943ffd90;hp=2661f0681718373203f4f0e6ac75216035ae6901;hpb=b002696f4d26c41ea09fc9af296a2d1f10b2ebb6;p=sbcl.git

diff --git a/src/code/target-defstruct.lisp b/src/code/target-defstruct.lisp
index 2661f06..b36c483 100644
--- a/src/code/target-defstruct.lisp
+++ b/src/code/target-defstruct.lisp
@@ -521,28 +521,25 @@
   (/nohexstr obj)
   (/nohexstr layout)
   (when (layout-invalid layout)
-    (error "An obsolete structure accessor function was called."))
+    (error "An obsolete structure typecheck function was called."))
   (/noshow0 "back from testing LAYOUT-INVALID LAYOUT")
   (and (%instancep obj)
        (let ((obj-layout (%instance-layout obj)))
-         (cond ((eq obj-layout layout)
-                ;; (In this case OBJ-LAYOUT can't be invalid, because
-                ;; we determined LAYOUT is valid in the test above.)
-                (/noshow0 "EQ case")
-                t)
-               ((layout-invalid obj-layout)
-                (/noshow0 "LAYOUT-INVALID case")
-                (error 'layout-invalid
-                       :expected-type (layout-classoid obj-layout)
-                       :datum obj))
-               (t
-                (let ((depthoid (layout-depthoid layout)))
-                  (/noshow0 "DEPTHOID case, DEPTHOID,LAYOUT-INHERITS=..")
-                  (/nohexstr depthoid)
-                  (/nohexstr layout-inherits)
-                  (and (> (layout-depthoid obj-layout) depthoid)
-                       (eq (svref (layout-inherits obj-layout) depthoid)
-                           layout))))))))
+         (when (eq obj-layout layout)
+           ;; (In this case OBJ-LAYOUT can't be invalid, because
+           ;; we determined LAYOUT is valid in the test above.)
+           (/noshow0 "EQ case")
+           (return-from typep-to-layout t))
+         (when (layout-invalid obj-layout)
+           (/noshow0 "LAYOUT-INVALID case")
+           (setf obj-layout (update-object-layout-or-invalid obj layout)))
+         (let ((depthoid (layout-depthoid layout)))
+           (/noshow0 "DEPTHOID case, DEPTHOID,LAYOUT-INHERITS=..")
+           (/nohexstr depthoid)
+           (/nohexstr layout-inherits)
+           (and (> (layout-depthoid obj-layout) depthoid)
+                (eq (svref (layout-inherits obj-layout) depthoid)
+                    layout))))))
 
 ;;;; checking structure types