0.9.17.14:
[sbcl.git] / tests / compiler.pure.lisp
index c5e11ca..828d9bc 100644 (file)
 
 (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
 ;;; 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))))
                    (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)))