0.8.10.57:

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

diff --git a/tests/type.impure.lisp b/tests/type.impure.lisp
index 38cee27..7170619 100644 (file)
--- a/tests/type.impure.lisp
+++ b/tests/type.impure.lisp
@@ -109,6 +109,16 @@
 (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)))
@@ -324,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))))