Fix APPEND/NCONC type derivation properly this time.

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

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index e16ad55..90d0775 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -4408,7 +4408,15 @@
             (lambda (x) (append x (cons 1 2))) cons
             (lambda (x y) (append x (cons 1 2) y)) cons
             (lambda (x y) (nconc x (the list y) x)) t
-            (lambda (x y) (print (length y)) (append x y)) sequence)))
+            (lambda (x y) (nconc (the atom x) y)) t
+            (lambda (x y) (nconc (the (or null (eql 10)) x) y)) t
+            (lambda (x y) (nconc (the (or cons vector) x) y)) cons
+            (lambda (x y) (nconc (the sequence x) y)) t
+            (lambda (x y) (print (length y)) (append x y)) sequence
+            (lambda (x y) (print (length y)) (append x y)) sequence
+            (lambda (x y) (append (the (member (a) (b)) x) y)) cons
+            (lambda (x y) (append (the (member (a) (b) c) x) y)) cons
+            (lambda (x y) (append (the (member (a) (b) nil) x) y)) t)))
     (loop for (function result-type) on test-cases by #'cddr
           do (assert (equal (car (cdaddr (sb-kernel:%simple-fun-type
                                           (compile nil function))))
@@ -4567,3 +4575,32 @@
           (test (- x) y)
           (test (- most-positive-fixnum x) y)
           (test (+ most-negative-fixnum x) y))))))
+
+;; expected failure
+(test-util:with-test (:name :fold-index-addressing-positive-offset
+                      :fails-on '(and))
+  (let ((f (compile nil `(lambda (i)
+                           (if (typep i '(integer -31 31))
+                               (aref #. (make-array 63) (+ i 31))
+                               (error "foo"))))))
+    (funcall f -31)))
+
+;; 5d3a728 broke something like this in CL-PPCRE
+(test-util:with-test (:name :fold-index-addressing-potentially-negative-index)
+  (compile nil `(lambda (index vector)
+                  (declare (optimize speed (safety 0))
+                           ((simple-array character (*)) vector)
+                           ((unsigned-byte 24) index))
+                  (aref vector (1+ (mod index (1- (length vector))))))))
+
+(test-util:with-test (:name :constant-fold-ash/right-fixnum)
+  (compile nil `(lambda (a b)
+                  (declare (type fixnum a)
+                           (type (integer * -84) b))
+                  (ash a b))))
+
+(test-util:with-test (:name :constant-fold-ash/right-word)
+  (compile nil `(lambda (a b)
+                  (declare (type word a)
+                           (type (integer * -84) b))
+                  (ash a b))))