0.9.2.43:

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

diff --git a/tests/compiler.impure-cload.lisp b/tests/compiler.impure-cload.lisp
index c82bef3..7d5e99d 100644 (file)
--- a/tests/compiler.impure-cload.lisp
+++ b/tests/compiler.impure-cload.lisp
@@ -364,20 +364,20 @@
 ;;; failed on Alpha prior to sbcl-0.8.10.30
 (defun lotso-values ()
   (values 0 1 2 3 4 5 6 7 8 9
-         0 1 2 3 4 5 6 7 8 9
-         0 1 2 3 4 5 6 7 8 9
-         0 1 2 3 4 5 6 7 8 9
-         0 1 2 3 4 5 6 7 8 9
-         0 1 2 3 4 5 6 7 8 9
-         0 1 2 3 4 5 6 7 8 9
-         0 1 2 3 4 5 6 7 8 9
-         0 1 2 3 4 5 6 7 8 9
-         0 1 2 3 4 5 6 7 8 9))
+          0 1 2 3 4 5 6 7 8 9
+          0 1 2 3 4 5 6 7 8 9
+          0 1 2 3 4 5 6 7 8 9
+          0 1 2 3 4 5 6 7 8 9
+          0 1 2 3 4 5 6 7 8 9
+          0 1 2 3 4 5 6 7 8 9
+          0 1 2 3 4 5 6 7 8 9
+          0 1 2 3 4 5 6 7 8 9
+          0 1 2 3 4 5 6 7 8 9))
 
 ;;; bug 313: source transforms were "lisp-1"
 (defun srctran-lisp1-1 (cadr) (if (functionp cadr) (funcall cadr 1) nil))
 (assert (eql (funcall (eval #'srctran-lisp1-1) #'identity) 1))
-(without-package-locks 
+(without-package-locks
    ;; this be a nasal demon, but test anyways
    (defvar caar))
 (defun srctran-lisp1-2 (caar) (funcall (sb-ext:truly-the function caar) 1))
@@ -420,5 +420,27 @@
   (incf (aref x 0))
   (assert (equalp x #(2 11))))
 
+;;; and BIT-* too (reported by Paul F. Dietz)
+(loop with v1 = #*0011
+      and  v2 = #*0101
+      for f in '(bit-and bit-andc1 bit-andc2 bit-eqv
+                 bit-ior bit-nand bit-nor bit-not
+                 bit-orc1 bit-orc2 bit-xor
+                 )
+      for form = `(lambda ()
+                    (let ((v (,f ,v1 ,v2)))
+                      (setf (aref v 0) (- 1 (aref v 0)))
+                      (aref v 0)))
+      for compiled-res = (funcall (compile nil form))
+      for real-res = (- 1 (aref (funcall f v1 v2) 0))
+      do (assert (equal compiled-res real-res)))
+(let* ((v #*0011)
+       (form `(lambda ()
+                (let ((v (bit-not ,v)))
+                  (setf (aref v 0) (- 1 (aref v 0)))
+                  (aref v 0))))
+       (compiled-res (funcall (compile nil form)))
+       (real-res (- 1 (aref (funcall (eval #'bit-not) v) 0))))
+  (assert (equal compiled-res real-res)))
 \f
 (sb-ext:quit :unix-status 104)