X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fdefstruct.impure.lisp;h=7e5fad911510fedbba1f5103e68f6a1b0e0925a7;hb=81e608991b9f616a412564b26186fa29933d814c;hp=83475d091a81eaa971e540212134f11121dd84d8;hpb=970dd272dc84f7420252eadb4829cc193f795716;p=sbcl.git

diff --git a/tests/defstruct.impure.lisp b/tests/defstruct.impure.lisp
index 83475d0..7e5fad9 100644
--- a/tests/defstruct.impure.lisp
+++ b/tests/defstruct.impure.lisp
@@ -671,5 +671,33 @@
                            (aref (vector x) (incf i)))
                   (bug-348-x x))))
 
+;;; obsolete instance trapping
+;;;
+;;; FIXME: Both error conditions below should possibly be instances
+;;; of the same class. (Putting this FIXME here, since this is the only
+;;; place where they appear together.)
+
+(with-test (:name obsolete-defstruct/print-object)
+  (eval '(defstruct born-to-change))
+  (let ((x (make-born-to-change)))
+    (handler-bind ((error 'continue))
+      (eval '(defstruct born-to-change slot)))
+    (assert (eq :error
+                (handler-case
+                    (princ-to-string x)
+                  (sb-pcl::obsolete-structure ()
+                    :error))))))
+
+(with-test (:name obsolete-defstruct/typep)
+  (eval '(defstruct born-to-change-2))
+  (let ((x (make-born-to-change-2)))
+    (handler-bind ((error 'continue))
+      (eval '(defstruct born-to-change-2 slot)))
+      (assert (eq :error2
+                  (handler-case
+                      (typep x (find-class 'standard-class))
+                    (sb-kernel:layout-invalid ()
+                      :error2))))))
+
 ;;; success
 (format t "~&/returning success~%")