X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Ftype.impure.lisp;h=e1e0b738133ee0b5f323da11777875a1f27362df;hb=b76dac3d5f89700f3a076403157eae3c52e4c118;hp=8ab2a975635d705b8b18293d9ab26b858b61d960;hpb=4f8f4b25cb564509437d8fc26038143150077f14;p=sbcl.git

diff --git a/tests/type.impure.lisp b/tests/type.impure.lisp
index 8ab2a97..e1e0b73 100644
--- a/tests/type.impure.lisp
+++ b/tests/type.impure.lisp
@@ -558,4 +558,27 @@
              (not sb-eval:interpreted-function))
            nil))
 
+;;; weakening of union type checks
+(defun weaken-union-1 (x)
+  (declare (optimize speed))
+  (car x))
+(multiple-value-bind (res err)
+    (ignore-errors (weaken-union-1 "askdjhasdkj"))
+  (assert (not res))
+  (assert (typep err 'type-error)))
+(defun weaken-union-2 (x)
+  (declare (optimize speed)
+           (type (or cons fixnum) x))
+  (etypecase x
+    (fixnum x)
+    (cons
+     (setf (car x) 3)
+     x)))
+(multiple-value-bind (res err)
+    (ignore-errors (weaken-union-2 "asdkahsdkhj"))
+  (assert (not res))
+  (assert (typep err 'type-error))
+  (assert (or (equal '(or cons fixnum) (type-error-expected-type err))
+              (equal '(or fixnum cons) (type-error-expected-type err)))))
+
 ;;; success