X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Ftype.pure.lisp;h=919d7053e0172941c55cb5bf3a8ca78817b9e135;hb=9bdd2579f980573a74daabe03120ed64b1733b11;hp=1e0b27a442ce824178fe7365643a32426d65c268;hpb=281e26e9e1142c343211fdc0ac65d7d3c62f2612;p=sbcl.git

diff --git a/tests/type.pure.lisp b/tests/type.pure.lisp
index 1e0b27a..919d705 100644
--- a/tests/type.pure.lisp
+++ b/tests/type.pure.lisp
@@ -396,3 +396,47 @@ ACTUAL ~D DERIVED ~D~%"
   (let ((bignum1 (+ 12 most-positive-fixnum))
         (bignum2 (- (+ 15 most-positive-fixnum) 3)))
     (assert (eval `(typep ,bignum1 '(member ,bignum2))))))
+
+(with-test (:name :opt+rest+key-canonicalization)
+  (let ((type '(function (&optional t &rest t &key (:x t) (:y t)) *)))
+    (assert (equal type (sb-kernel:type-specifier (sb-kernel:specifier-type type))))))
+
+(with-test (:name :bug-369)
+  (let ((types (mapcar #'sb-c::values-specifier-type
+                       '((values (vector package) &optional)
+                         (values (vector package) &rest t)
+                         (values (vector hash-table) &rest t)
+                         (values (vector hash-table) &optional)
+                         (values t &optional)
+                         (values t &rest t)
+                         (values nil &optional)
+                         (values nil &rest t)
+                         (values sequence &optional)
+                         (values sequence &rest t)
+                         (values list &optional)
+                         (values list &rest t)))))
+    (dolist (x types)
+      (dolist (y types)
+        (let ((i (sb-c::values-type-intersection x y)))
+          (assert (sb-c::type= i (sb-c::values-type-intersection i x)))
+          (assert (sb-c::type= i (sb-c::values-type-intersection i y))))))))
+
+(with-test (:name :bug-485972)
+  (assert (equal (multiple-value-list (subtypep 'symbol 'keyword)) '(nil t)))
+  (assert (equal (multiple-value-list (subtypep 'keyword 'symbol)) '(t t))))
+
+;; WARNING: this test case would fail by recursing into the stack's guard page.
+(with-test (:name :bug-883498)
+  (sb-kernel:specifier-type
+   `(or (INTEGER -2 -2)
+        (AND (SATISFIES FOO) (RATIONAL -3/2 -3/2)))))
+
+;; The infinite recursion mentioned in the previous test was caused by an
+;; attempt to get the following right.
+(with-test (:name :quirky-integer-rational-union)
+  (assert (subtypep `(or (integer * -1)
+                         (and (rational * -1/2) (not integer)))
+                    `(rational * -1/2)))
+  (assert (subtypep `(rational * -1/2)
+                    `(or (integer * -1)
+                         (and (rational * -1/2) (not integer))))))