0.7.4.1:
[sbcl.git] / tests / type.impure.lisp
index 4b423bb..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)
@@ -91,7 +96,7 @@
 (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.6.11.10.
+#| ; 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-nil-t (subtypep '(not float) 'single-float))
 (assert-t-t (subtypep '(not atom) 'cons))
 (assert-t-t (subtypep 'cons '(not atom)))
-;;; FIXME: Another thing to revisit is %INVOKE-TYPE-METHOD.
-;;; Essentially, the problem is that when the two arguments to
-;;; subtypep are of different specifier-type types (e.g. HAIRY and
-;;; UNION), there are two applicable type methods -- in this case
+;;; ANSI requires that SUBTYPEP relationships among built-in primitive
+;;; types never be uncertain, i.e. never return NIL as second value.
+;;; Prior to about sbcl-0.7.2.6, ATOM caused a lot of problems here
+;;; (because it's a negation type, implemented as a HAIRY-TYPE, and
+;;; CMU CL's HAIRY-TYPE logic punted a lot).
+(assert-t-t (subtypep 'integer 'atom))
+(assert-t-t (subtypep 'function 'atom))
+(assert-nil-t (subtypep 'list 'atom))
+(assert-nil-t (subtypep 'atom 'integer))
+(assert-nil-t (subtypep 'atom 'function))
+(assert-nil-t (subtypep 'atom 'list))
+;;; ATOM is equivalent to (NOT CONS):
+(assert-t-t (subtypep 'integer '(not cons)))
+(assert-nil-t (subtypep 'list '(not cons)))
+(assert-nil-t (subtypep '(not cons) 'integer))
+(assert-nil-t (subtypep '(not cons) 'list))
+;;; And we'd better check that all the named types are right. (We also
+;;; do some more tests on ATOM here, since once CSR experimented with
+;;; making it a named type.)
+(assert-t-t (subtypep 'nil 'nil))
+(assert-t-t (subtypep 'nil 'atom))
+(assert-t-t (subtypep 'nil 't))
+(assert-nil-t (subtypep 'atom 'nil))
+(assert-t-t (subtypep 'atom 'atom))
+(assert-t-t (subtypep 'atom 't))
+(assert-nil-t (subtypep 't 'nil))
+(assert-nil-t (subtypep 't 'atom))
+(assert-t-t (subtypep 't 't))
+;;; Also, LIST is now somewhat special, in that (NOT LIST) should be
+;;; recognized as a subtype of ATOM:
+(assert-t-t (subtypep '(not list) 'atom))
+(assert-nil-t (subtypep 'atom '(not list)))
+;;; These used to fail, because when the two arguments to subtypep are
+;;; of different specifier-type types (e.g. HAIRY and UNION), there
+;;; are two applicable type methods -- in this case
 ;;; HAIRY-COMPLEX-SUBTYPEP-ARG1-TYPE-METHOD and
-;;; UNION-COMPLEX-SUBTYPEP-ARG2-TYPE-METHOD.  Both of these exist, but
+;;; UNION-COMPLEX-SUBTYPEP-ARG2-TYPE-METHOD. Both of these exist, but
 ;;; [!%]INVOKE-TYPE-METHOD aren't smart enough to know that if one of
 ;;; them returns NIL, NIL (indicating uncertainty) it should try the
-;;; other; this is complicated by the presence of other TYPE-METHODS
-;;; (e.g. INTERSECTION and UNION) whose return convention may or may
-;;; not follow the same standard.
-#||
+;;; other. However, as of sbcl-0.7.2.6 or so, CALL-NEXT-METHOD-ish
+;;; logic in those type methods fixed it.
 (assert-nil-t (subtypep '(not cons) 'list))
 (assert-nil-t (subtypep '(not single-float) 'float))
-||#
-;;; If we fix the above FIXME, we should for free have fixed bug 58.
-#||
+;;; Somewhere along the line (probably when adding CALL-NEXT-METHOD-ish
+;;; logic in SUBTYPEP type methods) we fixed bug 58 too:
 (assert-t-t (subtypep '(and zilch integer) 'zilch))
-||#
+(assert-t-t (subtypep '(and integer zilch) 'zilch))
+
 ;;; Bug 84: SB-KERNEL:CSUBTYPEP was a bit enthusiastic at
 ;;; special-casing calls to subtypep involving *EMPTY-TYPE*,
 ;;; 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)