X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompiler.pure.lisp;h=828d9bc40fb8e0d4b8e7d4f01734f15814662acf;hb=a4a5e8fb87c7af981cb4c759dc3c5e6d44074f42;hp=a528b67a34165e447e079edeee5d9015f55aa4cc;hpb=b8a2248d3193902592fb58c5ea74209dc1124f08;p=sbcl.git

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index a528b67..828d9bc 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -13,6 +13,10 @@
 
 (cl:in-package :cl-user)
 
+;; The tests in this file assume that EVAL will use the compiler
+(when (eq sb-ext:*evaluator-mode* :interpret)
+  (invoke-restart 'run-tests::skip-file))
+
 ;;; Exercise a compiler bug (by crashing the compiler).
 ;;;
 ;;; This test code is from Douglas Crosher's simplified TICKLE-BUG
@@ -407,11 +411,12 @@
 ;;; Moellmann: CONVERT-MORE-CALL failed on the following call
 (assert (eq (eval '((lambda (&key) 'u) :allow-other-keys nil)) 'u))
 
-(raises-error? (multiple-value-bind (a b c)
-                   (eval '(truncate 3 4))
-                 (declare (integer c))
-                 (list a b c))
-               type-error)
+(assert
+ (raises-error? (multiple-value-bind (a b c)
+                    (eval '(truncate 3 4))
+                  (declare (integer c))
+                  (list a b c))
+                type-error))
 
 (assert (equal (multiple-value-list (the (values &rest integer)
                                       (eval '(values 3))))
@@ -2113,3 +2118,27 @@
 (compile nil '(lambda ()
                (let ((x (make-array '(1) :element-type '(signed-byte 32))))
                  (setf (aref x 0) 1))))
+
+;;; step instrumentation confusing the compiler, reported by Faré
+(handler-bind ((warning #'error))
+  (compile nil '(lambda ()
+                 (declare (optimize (debug 2))) ; not debug 3!
+                 (let ((val "foobar"))
+                   (map-into (make-array (list (length val))
+                                         :element-type '(unsigned-byte 8))
+                             #'char-code val)))))
+
+;;; overconfident primitive type computation leading to bogus type
+;;; checking.
+(let* ((form1 '(lambda (x)
+                (declare (type (and condition function) x))
+                x))
+       (fun1 (compile nil form1))
+       (form2 '(lambda (x)
+                (declare (type (and standard-object function) x))
+                x))
+       (fun2 (compile nil form2)))
+  (assert (raises-error? (funcall fun1 (make-condition 'error))))
+  (assert (raises-error? (funcall fun1 fun1)))
+  (assert (raises-error? (funcall fun2 fun2)))
+  (assert (eq (funcall fun2 #'print-object) #'print-object)))