0.7.4.1:
[sbcl.git] / tests / type.impure.lisp
index 7a4e89e..bf127c7 100644 (file)
@@ -9,16 +9,21 @@
 (defmacro assert-t-t (expr)
   `(assert (equal '(t t) (multiple-value-list ,expr))))
 
+(defmacro assert-t-t-or-uncertain (expr)
+  `(assert (let ((list (multiple-value-list ,expr)))
+            (or (equal '(nil nil) list)
+                (equal '(t t) list)))))
+
 (let ((types '(character
               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)
+              null symbol keyword
               (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
+              (integer -1 1)
+              unsigned-byte
+              (rational -1 7) (rational -2 4)
+              ratio
               )))
   (dolist (i types)
     (format t "type I=~S~%" i)
 ;;; corresponding to the NIL type-specifier; we were bogusly returning
 ;;; NIL, T (indicating surety) for the following:
 (assert-nil-nil (subtypep '(satisfies some-undefined-fun) 'nil))
+
+;;; It turns out that, as of sbcl-0.7.2, we require to be able to
+;;; detect this to compile src/compiler/node.lisp (and in particular,
+;;; the definition of the component structure). Since it's a sensible
+;;; thing to want anyway, let's test for it here:
+(assert-t-t (subtypep '(or some-undefined-type (member :no-ir2-yet :dead))
+                     '(or some-undefined-type (member :no-ir2-yet :dead))))
+;;; BUG 158 (failure to compile loops with vector references and
+;;; increments of greater than 1) was a symptom of type system
+;;; uncertainty, to wit:
+(assert-t-t (subtypep '(and (mod 536870911) (or (integer 0 0) (integer 2 536870912)))
+                     '(mod 536870911))) ; aka SB-INT:INDEX.
 \f
 ;;;; Douglas Thomas Crosher rewrote the CMU CL type test system to
 ;;;; allow inline type tests for CONDITIONs and STANDARD-OBJECTs, and
   #.*tests-of-inline-type-tests*)
 (tests-of-inline-type-tests)
 (format t "~&/done with compiled (TESTS-OF-INLINE-TYPE-TESTS)~%")
-
+\f
+;;; Redefinition of classes should alter the type hierarchy (BUG 140):
+(defclass superclass () ())
+(defclass maybe-subclass (superclass) ())
+(assert-t-t (subtypep 'maybe-subclass 'superclass))
+(defclass maybe-subclass () ())
+(assert-nil-t (subtypep 'maybe-subclass 'superclass))
+\f
 ;;; success
 (quit :unix-status 104)