0.8.16.10:

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

diff --git a/tests/type.impure.lisp b/tests/type.impure.lisp
index 441f6ff..248955e 100644 (file)
--- a/tests/type.impure.lisp
+++ b/tests/type.impure.lisp
@@ -30,7 +30,7 @@
               (real 4 8) (real -1 7) (real 2 11)
               null symbol keyword
               (member #\a #\b #\c) (member 1 #\a) (member 3.0 3.3)
-              (integer -1 1)
+              (member #\a #\c #\d #\f) (integer -1 1)
               unsigned-byte
               (rational -1 7) (rational -2 4)
               ratio
@@ -102,10 +102,24 @@
 (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)))
+;;; and while it doesn't specifically disallow illegal compound
+;;; specifiers from the CL package, we don't have any.
+(assert (raises-error? (subtypep 'fixnum '(fixnum 1))))
+(assert (raises-error? (subtypep 'class '(list))))
+(assert (raises-error? (subtypep 'foo '(ratio 1/2 3/2))))
+(assert (raises-error? (subtypep 'character '(character 10))))
+#+nil ; doesn't yet work on PCL-derived internal types
+(assert (raises-error? (subtypep 'lisp '(class))))
+#+nil
+(assert (raises-error? (subtypep 'bar '(method number number))))
+
 ;;; Of course empty lists of subtypes are still OK.
 (assert (typep 11 '(and)))
 (assert (not (typep 11 '(or))))
@@ -320,24 +334,25 @@
      (assert (eq (car (sb-pcl:class-direct-superclasses
                       (find-class 'simple-condition)))
                 (find-class 'condition)))
-
-    (let ((subclasses (mapcar #'find-class
-                              '(simple-type-error
-                                simple-error
-                                simple-warning
-                                sb-int:simple-file-error
-                                sb-int:simple-style-warning))))
-      (assert (null (set-difference
-                     (sb-pcl:class-direct-subclasses (find-class
-                                                      'simple-condition))
-                     subclasses))))
-
+    
+     #+nil ; doesn't look like a good test
+     (let ((subclasses (mapcar #'find-class
+                               '(simple-type-error
+                                 simple-error
+                                 simple-warning
+                                 sb-int:simple-file-error
+                                 sb-int:simple-style-warning))))
+       (assert (null (set-difference
+                      (sb-pcl:class-direct-subclasses (find-class
+                                                       'simple-condition))
+                      subclasses))))
+    
      ;; precedence lists
-     (assert (equal (sb-pcl:class-precedence-list
-                    (find-class 'simple-condition))
-                   (mapcar #'find-class '(simple-condition
-                                          condition
-                                          sb-pcl::slot-object
+     (assert (equal (sb-pcl:class-precedence-list 
+                    (find-class 'simple-condition))
+                   (mapcar #'find-class '(simple-condition
+                                          condition
+                                          sb-pcl::slot-object
                                           sb-kernel:instance
                                           t))))
 
@@ -398,6 +413,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))))
 \f
 ;;; success
 (quit :unix-status 104)