Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv20044/tests
Modified Files:
compiler.impure-cload.lisp
Log Message:
0.9.1.41:
* BIT-* functions are not foldable (reported by Paul F.
Dietz).
Index: compiler.impure-cload.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/compiler.impure-cload.lisp,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -d -r1.23 -r1.24
--- compiler.impure-cload.lisp 13 Jun 2005 11:05:52 -0000 1.23
+++ compiler.impure-cload.lisp 13 Jun 2005 16:36:03 -0000 1.24
@@ -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)))
(sb-ext:quit :unix-status 104)
|