0.9.15.46: cosmetic cleanups

[sbcl.git] / tests / type.impure.lisp

diff --git a/tests/type.impure.lisp b/tests/type.impure.lisp
index d5edc2e..f8ab6d2 100644 (file)
--- a/tests/type.impure.lisp
+++ b/tests/type.impure.lisp
@@ -486,5 +486,41 @@
   (assert-t-t (subtypep `(and (member ,misc-629c)
                           sb-kernel:instance)
                         nil)))
+\f
+;;; this was broken during the FINALIZE-INHERITANCE rearrangement; the
+;;; MAKE-INSTANCE finalizes the superclass, thus invalidating the
+;;; subclass, so SUBTYPEP must be prepared to deal with
+(defclass ansi-tests-defclass1 () ())
+(defclass ansi-tests-defclass3 (ansi-tests-defclass1) ())
+(make-instance 'ansi-tests-defclass1)
+(assert-t-t (subtypep 'ansi-tests-defclass3 'standard-object))
+\f
+;;; so was this
+(let ((class (eval '(defclass to-be-type-ofed () ()))))
+  (setf (find-class 'to-be-type-ofed) nil)
+  (assert (eq (type-of (make-instance class)) class)))
+\f
+;;; accuracy of CONS :SIMPLE-TYPE-=
+(deftype goldbach-1 () '(satisfies even-and-greater-then-two-p))
+(deftype goldbach-2 () ' (satisfies sum-of-two-primes-p))
 
+(multiple-value-bind (ok win)
+    (sb-kernel:type= (sb-kernel:specifier-type '(cons goldbach1 integer))
+                     (sb-kernel:specifier-type '(cons goldbach1 integer)))
+  (assert ok)
+  (assert win))
+
+;; See FIXME in type method for CONS :SIMPLE-TYPE-=
+#+nil
+(multiple-value-bind (ok win)
+    (sb-kernel:type= (sb-kernel:specifier-type '(cons goldbach1 integer))
+                     (sb-kernel:specifier-type '(cons goldbach1 single-float)))
+  (assert (not ok))
+  (assert win))
+
+(multiple-value-bind (ok win)
+    (sb-kernel:type= (sb-kernel:specifier-type '(cons goldbach1 integer))
+                     (sb-kernel:specifier-type '(cons goldbach2 single-float)))
+  (assert (not ok))
+  (assert (not win)))
 ;;; success