0.8.3.74:

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

diff --git a/tests/compiler.impure-cload.lisp b/tests/compiler.impure-cload.lisp
index 5982b02..194a4c6 100644 (file)
--- a/tests/compiler.impure-cload.lisp
+++ b/tests/compiler.impure-cload.lisp
@@ -1,5 +1,6 @@
-(load "assertoid.lisp")
-(use-package "ASSERTOID")
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (load "assertoid.lisp")
+  (use-package "ASSERTOID"))
 
 ;;; bug 254: compiler falure
 (defpackage :bug254 (:use :cl))
@@ -142,6 +143,8 @@
 
 (delete-package :bug258)
 
+(in-package :cl-user)
+
 ;;;
 (defun bug233a (x)
   (declare (optimize (speed 2) (safety 3)))
@@ -153,5 +156,100 @@
      (funcall (eval ''list) y (+ y 2d0) (* y 3d0)))))
 (assert (raises-error? (bug233a 4) type-error))
 
+;;; compiler failure
+(defun bug145b (x)
+  (declare (type (double-float -0d0) x))
+  (declare (optimize speed))
+  (+ x (sqrt (log (random 1d0)))))
+
+;;; compiler failures reported by Paul Dietz: inaccurate dealing with
+;;; BLOCK-LAST in CONSTANT-FOLD-CALL and DO-NODES
+(defun #:foo (a b c d)
+  (declare (type (integer -1 1000655) b)
+           (optimize (speed 3) (safety 1) (debug 1)))
+  (- (logior
+      (abs (- (+ b (logandc1 -473949 (max 5165 (abs (logandc1 a 250775)))))))
+      (logcount (logeqv (max (logxor (abs c) -1) 0) -4)))
+     d))
+
+(defun #:foo (a d)
+  (declare (type (integer -8507 26755) a)
+           (type (integer -393314538 2084485) d)
+           (optimize (speed 3) (safety 1) (debug 1)))
+  (gcd
+   (if (= 0 a) 10 (abs -1))
+   (logxor -1
+           (min -7580
+                (max (logand a 31365125) d)))))
+
+;;; compiler failure "NIL is not of type LVAR"
+(defun #:foo (x)
+  (progn (truly-the integer x)
+         (1+ x)))
+
+;;; bug 291 reported by Nikodemus Siivola (modified version)
+(defstruct line
+  (%chars ""))
+(defun update-window-imag (line)
+  (tagbody
+   TOP
+     (if (null line)
+         (go DONE)
+         (go TOP))
+   DONE
+     (unless (eq current the-sentinel)
+       (let* ((cc (car current))
+              (old-line (dis-line-line cc)))
+         (if (eq old-line line)
+             (do ((chars (line-%chars line) nil))
+                 (())
+               (let* ()
+                 (multiple-value-call
+                     #'(lambda (&optional g2740 g2741 &rest g2742)
+                         (declare (ignore g2742))
+                         (catch 'foo
+                           (values (setq string g2740) (setq underhang g2741))))
+                   (foo)))
+               (setf (dis-line-old-chars cc) chars)))))))
+
+;;; and similar cases found by Paul Dietz
+(defun #:foo (a b c)
+  (declare (optimize (speed 0) (safety 3) (debug 3)))
+  (FLET ((%F11 ()
+           (BLOCK B6
+             (LET ((V2 B))
+               (IF (LDB-TEST (BYTE 27 14) V2)
+                   (LET ((V6
+                          (FLET ((%F7 ()
+                                   B))
+                            -1)))
+                     (RETURN-FROM B6 V2))
+                   C)))))
+    A))
+(defun #:foo (a b c)
+  (declare (optimize (speed 0) (safety 3) (debug 3)))
+  (FLET ((%F15 ()
+           (BLOCK B8
+             (LET ((V5 B))
+               (MIN A (RETURN-FROM B8 C))))))
+    C))
+
+;;; bug 292, reported by Paul Dietz
+(defun #:foo (C)
+  (DECLARE (TYPE (INTEGER -5945502333 12668542) C)
+           (OPTIMIZE (SPEED 3)))
+  (LET ((V2 (* C 12)))
+    (- (MAX (IF (/= 109335113 V2) -26479 V2)
+            (DEPOSIT-FIELD 311
+                           (BYTE 14 28)
+                           (MIN (MAX 521326 C) -51))))))
+
+;;; zombie variables, arising from constraints
+(defun #:foo (A B)
+  (DECLARE (TYPE (INTEGER -40945116 24028306) B)
+           (OPTIMIZE (SPEED 3)))
+  (LET ((V5 (MIN 31883 (LOGCOUNT A))))
+    (IF (/= B V5) (IF (EQL 122911784 V5) -43765 1487) B)))
+
 \f
 (sb-ext:quit :unix-status 104)