X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Ftype.impure.lisp;h=38cee279b3c66d36635be49d45ff7d48641c5728;hb=2eee1c446adf860571a0d5e89eb5c547806cda76;hp=d07044f2b7b784364df1ffa1108476cb2d95cced;hpb=086927c64682b73e00cb5090ec72e1a72fb30ece;p=sbcl.git

diff --git a/tests/type.impure.lisp b/tests/type.impure.lisp
index d07044f..38cee27 100644
--- a/tests/type.impure.lisp
+++ b/tests/type.impure.lisp
@@ -102,10 +102,14 @@
 (assert-nil-nil (subtypep '(vector t) '(vector utype-2)))
 
 ;;; ANSI specifically disallows bare AND and OR symbols as type specs.
-#| ; Alas, this is part of bug 10, still unfixed as of sbcl-0.7.2.
 (assert (raises-error? (typep 11 'and)))
 (assert (raises-error? (typep 11 'or)))
-|#
+(assert (raises-error? (typep 11 'member)))
+(assert (raises-error? (typep 11 'values)))
+(assert (raises-error? (typep 11 'eql)))
+(assert (raises-error? (typep 11 'satisfies)))
+(assert (raises-error? (typep 11 'not)))
+
 ;;; Of course empty lists of subtypes are still OK.
 (assert (typep 11 '(and)))
 (assert (not (typep 11 '(or))))
@@ -224,6 +228,11 @@
 
 (assert-t-t (subtypep '(not (single-float 0.0 0.0)) '(not (member 0.0))))
 (assert-t-t (subtypep '(not (double-float 0.0d0 0.0d0)) '(not (member 0.0d0))))
+
+(assert-t-t (subtypep '(float -0.0) '(float 0.0)))
+(assert-t-t (subtypep '(float 0.0) '(float -0.0)))
+(assert-t-t (subtypep '(float (0.0)) '(float (-0.0))))
+(assert-t-t (subtypep '(float (-0.0)) '(float (0.0))))
 
 ;;;; Douglas Thomas Crosher rewrote the CMU CL type test system to
 ;;;; allow inline type tests for CONDITIONs and STANDARD-OBJECTs, and
@@ -332,6 +341,7 @@
 		     (find-class 'simple-condition))
 		    (mapcar #'find-class '(simple-condition
 					   condition
+					   sb-pcl::slot-object
 					   sb-kernel:instance
 					   t))))
 
@@ -392,6 +402,21 @@
 (deftype bar () 'single-float)
 (assert (eql (foo (make-array 3 :element-type 'bar :initial-element 0.0f0))
 	     0.0f0))
+
+;;; bug 260a
+(assert-t-t
+ (let* ((s (gensym))
+        (t1 (sb-kernel:specifier-type s)))
+   (eval `(defstruct ,s))
+   (sb-kernel:type= t1 (sb-kernel:specifier-type s))))
+
+;;; bug found by PFD's random subtypep tester
+(let ((t1 '(cons rational (cons (not rational) (cons integer t))))
+      (t2 '(not (cons (integer 0 1) (cons single-float long-float)))))
+  (assert-t-t (subtypep t1 t2))
+  (assert-nil-t (subtypep t2 t1))
+  (assert-t-t (subtypep `(not ,t2) `(not ,t1)))
+  (assert-nil-t (subtypep `(not ,t1) `(not ,t2))))
 
 ;;; success
 (quit :unix-status 104)