In aliencomp.c #+(and ppc darwin) should be #!+(and ppc darwin), which

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

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 8febbbf..1a4a58c 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -1723,15 +1723,16 @@
       (error "bad RANDOM event"))))
 
 ;;; 0.8.17.28-sma.1 lost derived type information.
-(handler-bind ((sb-ext:compiler-note #'error))
-  (compile nil
-    '(lambda (x y v)
-      (declare (optimize (speed 3) (safety 0)))
-      (declare (type (integer 0 80) x)
-       (type (integer 0 11) y)
-       (type (simple-array (unsigned-byte 32) (*)) v))
-      (setf (aref v 0) (* (* x #.(floor (ash 1 32) (* 11 80))) y))
-      nil)))
+(with-test (:name "0.8.17.28-sma.1" :fails-on :sparc)
+  (handler-bind ((sb-ext:compiler-note (lambda (c) (error "~A" c))))
+    (compile nil
+      '(lambda (x y v)
+        (declare (optimize (speed 3) (safety 0)))
+        (declare (type (integer 0 80) x)
+         (type (integer 0 11) y)
+         (type (simple-array (unsigned-byte 32) (*)) v))
+        (setf (aref v 0) (* (* x #.(floor (ash 1 32) (* 11 80))) y))
+        nil))))
 
 ;;; Bug reported by Robert J. Macomber: instrumenting of more-entry
 ;;; prevented open coding of %LISTIFY-REST-ARGS.
@@ -1896,7 +1897,7 @@
                    (declare (optimize (speed 3)))
                    (1+ x))))
   ;; forced-to-do GENERIC-+, etc
-  (assert (= count0 4))
+  (assert (> count0 0))
   (handler-bind ((sb-ext:compiler-note (lambda (c) (incf count1))))
     (compile nil '(lambda (x)
                    (declare (optimize (speed 3)))
@@ -1904,4 +1905,77 @@
                    (1+ x))))
   (assert (= count1 0)))
 
+;;; Up to 0.9.8.22 x86-64 had broken return value handling in the
+;;; %SET-SAP-REF-DOUBLE/SINGLE VOPs.
+(with-test (:name :sap-ref-float)
+  (compile nil '(lambda (sap)
+                 (let ((x (setf (sb-vm::sap-ref-double sap 0) 1d0)))
+                   (1+ x))))
+  (compile nil '(lambda (sap)
+                 (let ((x (setf (sb-vm::sap-ref-single sap 0) 1d0)))
+                   (1+ x)))))
+
+;;; bug #399
+(with-test (:name :string-union-types)
+  (compile nil '(lambda (x)
+                 (declare (type (or (simple-array character (6))
+                                    (simple-array character (5))) x))
+                 (aref x 0))))
+
+;;; MISC.623: missing functions for constant-folding
+(assert (eql 0
+             (funcall
+              (compile
+               nil
+               '(lambda ()
+                 (declare (optimize (space 2) (speed 0) (debug 2)
+                           (compilation-speed 3) (safety 0)))
+                 (loop for lv3 below 1
+                    count (minusp
+                           (loop for lv2 below 2
+                              count (logbitp 0
+                                             (bit #*1001101001001
+                                                  (min 12 (max 0 lv3))))))))))))
+
+;;; MISC.624: erronous AVER in x86's %LOGBITP VOPs
+(assert (eql 0
+             (funcall
+              (compile
+               nil
+               '(lambda (a)
+                 (declare (type (integer 21 28) a))
+                 (declare       (optimize (compilation-speed 1) (safety 2)
+                                 (speed 0) (debug 0) (space 1)))
+                 (let* ((v7 (flet ((%f3 (f3-1 f3-2)
+                                     (loop for lv2 below 1
+                                        count
+                                        (logbitp 29
+                                                 (sbit #*10101111
+                                                       (min 7 (max 0 (eval '0))))))))
+                              (%f3 0 a))))
+                   0)))
+              22)))
+
+;;; MISC.626: bandaged AVER was still wrong
+(assert (eql -829253
+             (funcall
+              (compile
+               nil
+               '(lambda (a)
+                  (declare (type (integer -902970 2) a))
+                  (declare (optimize (space 2) (debug 0) (compilation-speed 1)
+                                     (speed 0) (safety 3)))
+                  (prog2 (if (logbitp 30 a) 0 (block b3 0)) a)))
+              -829253)))
+
+;; MISC.628: constant-folding %LOGBITP was buggy
+(assert (eql t
+             (funcall
+              (compile
+               nil
+               '(lambda ()
+                  (declare (optimize (safety 3) (space 3) (compilation-speed 3)
+                                     (speed 0) (debug 1)))
+                  (not (not (logbitp 0 (floor 2147483651 (min -23 0))))))))))
+