X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=tests%2Fcompiler.pure.lisp;h=bd1ed4706214cba19b761d3c27943ce631d58cb7;hb=2b0710d31c3fa1e5448ec842504d5276842e394f;hp=9376ba164b6126af1728d2c8dda9aa25415f19d3;hpb=3a47903ad407d1c82f053912ff67c150d0d89afe;p=sbcl.git

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 9376ba1..bd1ed47 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -1915,3 +1915,100 @@
                  (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))))))))))
+
+;; mistyping found by random-tester
+(assert (zerop
+  (funcall
+   (compile
+    nil
+    '(lambda ()
+      (declare (optimize (speed 1) (debug 0)
+                (space 2) (safety 0) (compilation-speed 0)))
+      (unwind-protect 0
+        (* (/ (multiple-value-prog1 -29457482 -5602513511) 1))))))))
+
+;; aggressive constant folding (bug #400)
+(assert
+ (eq t (funcall (compile nil '(lambda () (or t (the integer (/ 1 0))))))))
+
+(with-test (:name (:compiler :constraint-propagation :var-eql-to-non-var-1))
+  (assert
+   (handler-case
+       (compile nil '(lambda (x y)
+                       (when (eql x (length y))
+                         (locally
+                             (declare (optimize (speed 3)))
+                           (1+ x)))))
+     (compiler-note () (error "The code is not optimized.")))))
+
+(with-test (:name (:compiler :constraint-propagation :var-eql-to-non-var-2))
+  (assert
+   (handler-case
+       (compile nil '(lambda (x y)
+                       (when (eql (length y) x)
+                         (locally
+                             (declare (optimize (speed 3)))
+                           (1+ x)))))
+     (compiler-note () (error "The code is not optimized.")))))