open intervals and type derivation

[sbcl.git] / tests / compiler.impure.lisp

diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index b3970e6..4361794 100644 (file)
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -16,7 +16,7 @@
 ;;;; more information.
 
 (when (eq sb-ext:*evaluator-mode* :interpret)
-  (sb-ext:quit :unix-status 104))
+  (sb-ext:exit :code 104))
 
 (load "test-util.lisp")
 (load "compiler-test-util.lisp")
@@ -1298,6 +1298,31 @@
     (type-error (e)
       (and (eql 10 (type-error-datum e))
            (eql 'list (type-error-expected-type e))))))
+
+;;;; tests for compiler output
+(with-test (:name :unexpected-compiler-output)
+  (let* ((*error-output* (make-string-output-stream))
+         (output (with-output-to-string (*standard-output*)
+                   (compile-file "compiler-output-test.lisp"
+                                 :print nil :verbose nil))))
+    (unless (zerop (length output))
+      (error "Unexpected output: ~S" output))))
+
+(with-test (:name :bug-493380)
+  (flet ((test (forms)
+           (catch 'debug
+             (let ((*debugger-hook* (lambda (condition if)
+                                      (throw 'debug
+                                        (if (typep condition 'serious-condition)
+                                            :debug
+                                            :oops)))))
+               (multiple-value-bind (warned failed) (ctu:file-compile forms)
+                 (when (and warned failed)
+                   :failed))))))
+    (assert (eq :failed (test "(defun")))
+    (assert (eq :failed (test "(defun no-pkg::foo ())")))
+    (assert (eq :failed (test "(cl:no-such-sym)")))
+    (assert (eq :failed (test "...")))))
 \f
 ;;;; tests not in the problem domain, but of the consistency of the
 ;;;; compiler machinery itself
@@ -1365,14 +1390,6 @@
           (grovel-results name))))))
 (identify-suspect-vops)
 \f
-;;;; tests for compiler output
-(let* ((*error-output* (make-broadcast-stream))
-       (output (with-output-to-string (*standard-output*)
-                 (compile-file "compiler-output-test.lisp"
-                               :print nil :verbose nil))))
-  (print output)
-  (assert (zerop (length output))))
-
 ;;;; bug 305: INLINE/NOTINLINE causing local ftype to be lost
 
 (define-condition optimization-error (error) ())
@@ -2258,4 +2275,14 @@
             (assert (= 7 (funcall fun 15 3))))))
     (assert (string= "" trace-output))))
 
+(test-util:with-test (:name :bug-997528)
+  (let ((fun (compile nil '(lambda (x)
+                            (declare (optimize (speed 0) (space 0))
+                             (type (integer -228645653448155482 -228645653447928749) x))
+                            (floor 1.0 (the (integer -228645653448151677 -228645653448150900) x))))))
+    (multiple-value-bind (quo rem)
+        (funcall fun -228645653448151381)
+      (assert (= quo -1))
+      (assert (= rem (float -228645653448151381))))))
+
 ;;; success