From: Alexey D. <ade...@us...> - 2005-06-13 16:36:13
|
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) |