0.6.12.26:
[sbcl.git] / tests / type.impure.lisp
index 9697487..1036aff 100644 (file)
               integer fixnum (integer 0 10)
               single-float (single-float -1.0 1.0) (single-float 0.1)
               (real 4 8) (real -1 7) (real 2 11)
-              (member #\a #\b #\c) (member 1 #\a) (member 3.0 3.3))))
+              (member #\a #\b #\c) (member 1 #\a) (member 3.0 3.3)
+              ;; FIXME: When bug 91 is fixed, add these to the list:
+              ;;   (INTEGER -1 1)
+              ;;   UNSIGNED-BYTE
+              ;;   (RATIONAL -1 7) (RATIONAL -2 4)
+              ;;   RATIO
+              )))
   (dolist (i types)
     (format t "type I=~S~%" i)
     (dolist (j types)
       (dolist (k types)
        (format t "    type K=~S~%" k)
        (assert (subtypep `(or ,i ,j) `(or ,i ,j ,k)))
-       ;; FIXME: The old code (including original CMU CL code)
-       ;; fails this test. When this is fixed, we can re-enable it.
-       #+nil (assert (subtypep `(or ,i ,j) `(or ,k ,j ,i)))))))
+       (assert (subtypep `(or ,i ,j) `(or ,k ,j ,i)))))))
 
 ;;; gotchas that can come up in handling subtypeness as "X is a
 ;;; subtype of Y if each of the elements of X is a subtype of Y"
-#+nil ; FIXME: suppressed until we can fix old CMU CL big
 (let ((subtypep-values (multiple-value-list
                        (subtypep '(single-float -1.0 1.0)
                                  '(or (real -100.0 0.0)
@@ -43,7 +46,8 @@
                    ;; But if it does, that'd be neat.
                    (t t)
                    ;; (And any other return would be wrong.)
-                   ))))
+                   )
+                 :test #'equal)))
 
 (defun type-evidently-= (x y)
   (and (subtypep x y)
 (assert (not (typep 11 '(or))))
 
 ;;; bug 12: type system didn't grok nontrivial intersections
-#| ; "we gotta target, but you gotta be patient": 0.6.11.x work in progress 
 (assert (subtypep '(and symbol (satisfies keywordp)) 'symbol))
 (assert (not (subtypep '(and symbol (satisfies keywordp)) 'null)))
 (assert (subtypep 'keyword 'symbol))
 (assert (not (subtypep 'symbol 'keyword)))
 (assert (subtypep 'ratio 'real))
 (assert (subtypep 'ratio 'number))
-|#
+
+;;; Pierre Mai rewrote the CMU CL type test system to allow inline
+;;; type tests for CONDITIONs and STANDARD-OBJECTs, and generally be
+;;; nicer, and Martin Atzmueller ported the patches. They look nice
+;;; but they're nontrivial enough that it's not obvious from
+;;; inspection that everything is OK. Let's make sure that things
+;;; still basically work.
+(defstruct foo1)
+(defstruct (foo2 (:include foo1))
+  x)
+(defstruct (foo3 (:include foo2)))
+(defstruct (foo4 (:include foo3))
+  y z)
+(assert (typep (make-foo3) 'foo2))
+(assert (not (typep (make-foo1) 'foo4)))
+(assert (null (ignore-errors (setf (foo2-x (make-foo1)) 11))))
+;;; (More tests here would be nice before merging the patches. More
+;;; tests for STRUCTURE-OBJECT, tests for CONDITION, tests for
+;;; STANDARD-OBJECT, compiled tests to make sure that the inline
+;;; versions of the tests work..)
 
 ;;; success
 (quit :unix-status 104)