[Sbcl-commits] CVS: sbcl/tests compiler.impure.lisp,1.33,1.34

[Alexey D. <ade...@us...>]

Update of /cvsroot/sbcl/sbcl/tests
In directory usw-pr-cvs1:/tmp/cvs-serv6297/tests

Modified Files:
	compiler.impure.lisp 
Log Message:
0.7.9.41:
        * Weaken type checks immediately when they are set according
          to the corresponding policy.
        * Because this change significantly increases load on the type
          algebra system, add caches to the latter.
        * Fix bug in %CONTINUATION-%EXTERNALLY-CHECKABLE-TYPE: an
          argument of a combination might be omitted.


Index: compiler.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/compiler.impure.lisp,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -d -r1.33 -r1.34
--- compiler.impure.lisp	4 Nov 2002 14:41:22 -0000	1.33
+++ compiler.impure.lisp	11 Nov 2002 08:37:04 -0000	1.34
@@ -578,6 +578,42 @@
 ;;; (fix provided by Matthew Danish) on sbcl-devel
 (assert (null (ignore-errors
 		(defmacro bug172 (&rest rest foo) `(list ,rest ,foo)))))
+
+;;; embedded THEs
+(defun check-embedded-thes (policy1 policy2 x y)
+  (handler-case
+      (funcall (compile nil
+                        `(lambda (f)
+                           (declare (optimize (speed 2) (safety ,policy1)))
+                           (multiple-value-list
+                            (the (values (integer 2 3) t)
+                              (locally (declare (optimize (safety ,policy2)))
+                                (the (values t (single-float 2f0 3f0))
+                                  (funcall f)))))))
+               (lambda () (values x y)))
+    (type-error (error)
+      error)))
+
+(assert (equal (check-embedded-thes 0 0  :a :b) '(:a :b)))
+
+(assert (equal (check-embedded-thes 0 3  :a 2.5f0) '(:a 2.5f0)))
+(assert (typep (check-embedded-thes 0 3  2 3.5f0) 'type-error))
+
+(assert (equal (check-embedded-thes 0 1  :a 3.5f0) '(:a 3.5f0)))
+(assert (typep (check-embedded-thes 0 1  2 2.5d0) 'type-error))
+
+#+nil
+(assert (equal (check-embedded-thes 3 0  2 :a) '(2 :a)))
+(assert (typep (check-embedded-thes 3 0  4 2.5f0) 'type-error))
+
+(assert (equal (check-embedded-thes 1 0  4 :b) '(4 :b)))
+(assert (typep (check-embedded-thes 1 0  1.0 2.5f0) 'type-error))
+
+
+(assert (equal (check-embedded-thes 3 3  2 2.5f0) '(2 2.5f0)))
+(assert (typep (check-embedded-thes 3 3  0 2.5f0) 'type-error))
+(assert (typep (check-embedded-thes 3 3  2 3.5f0) 'type-error))
+
 
 ;;;; tests not in the problem domain, but of the consistency of the
 ;;;; compiler machinery itself