0.6.12.2:

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

diff --git a/tests/type.impure.lisp b/tests/type.impure.lisp
index 33b3f0c..31b42e9 100644 (file)
--- a/tests/type.impure.lisp
+++ b/tests/type.impure.lisp
@@ -1,10 +1,25 @@
 (in-package :cl-user)
 
+(load "assertoid.lisp")
+
+(defmacro assert-nil-nil (expr)
+  `(assert (equal '(nil nil) (multiple-value-list ,expr))))
+(defmacro assert-nil-t (expr)
+  `(assert (equal '(nil t) (multiple-value-list ,expr))))
+(defmacro assert-t-t (expr)
+  `(assert (equal '(t t) (multiple-value-list ,expr))))
+
 (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)
-              (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)
@@ -12,7 +27,27 @@
       (assert (subtypep i `(or ,i ,j)))
       (assert (subtypep i `(or ,j ,i)))
       (assert (subtypep i `(or ,i ,i ,j)))
-      (assert (subtypep i `(or ,j ,i))))))
+      (assert (subtypep i `(or ,j ,i)))
+      (dolist (k types)
+       (format t "    type K=~S~%" k)
+       (assert (subtypep `(or ,i ,j) `(or ,i ,j ,k)))
+       (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"
+(let ((subtypep-values (multiple-value-list
+                       (subtypep '(single-float -1.0 1.0)
+                                 '(or (real -100.0 0.0)
+                                      (single-float 0.0 100.0))))))
+  (assert (member subtypep-values
+                 '(;; The system isn't expected to
+                   ;; understand the subtype relationship.
+                   (nil nil)
+                   ;; 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)
@@ -22,5 +57,45 @@
 
 (assert (type-evidently-= '(integer 0 10) '(or (integer 0 5) (integer 4 10))))
 
+;;; sbcl-0.6.10 did (UPGRADED-ARRAY-ELEMENT-TYPE 'SOME-UNDEF-TYPE)=>T
+;;; and (UPGRADED-COMPLEX-PART-TYPE 'SOME-UNDEF-TYPE)=>T.
+(assert (raises-error? (upgraded-array-element-type 'some-undef-type)))
+(assert (eql (upgraded-array-element-type t) t))
+(assert (raises-error? (upgraded-complex-part-type 'some-undef-type)))
+(assert (subtypep (upgraded-complex-part-type 'fixnum) 'real))
+
+;;; Do reasonable things with undefined types, and with compound types
+;;; built from undefined types.
+;;;
+;;; part I: TYPEP
+(assert (typep #(11) '(simple-array t 1)))
+(assert (typep #(11) '(simple-array (or integer symbol) 1)))
+(assert (raises-error? (typep #(11) '(simple-array undef-type 1))))
+(assert (not (typep 11 '(simple-array undef-type 1))))
+;;; part II: SUBTYPEP
+(assert (subtypep '(vector some-undef-type) 'vector))
+(assert (not (subtypep '(vector some-undef-type) 'integer)))
+(assert-nil-nil (subtypep 'utype-1 'utype-2))
+(assert-nil-nil (subtypep '(vector utype-1) '(vector utype-2)))
+(assert-nil-nil (subtypep '(vector utype-1) '(vector t)))
+(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.
+(assert (raises-error? (typep 11 'and)))
+(assert (raises-error? (typep 11 'or)))
+|#
+;;; Of course empty lists of subtypes are still OK.
+(assert (typep 11 '(and)))
+(assert (not (typep 11 '(or))))
+
+;;; bug 12: type system didn't grok nontrivial intersections
+(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))
+
 ;;; success
 (quit :unix-status 104)