[Sbcl-commits] CVS: sbcl/tests arith.impure.lisp,1.4,1.5

[Christophe R. <cr...@us...>]

Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs1:/tmp/cvs-serv14448/tests

Modified Files:
	arith.impure.lisp 
Log Message:
0.8.3.31:
	Fix ASH bug on PPC
	... add a test for it, which will probably fail on most if not all
		other architectures.  To be continued...


Index: arith.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/arith.impure.lisp,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- arith.impure.lisp	16 Dec 2002 16:23:55 -0000	1.4
+++ arith.impure.lisp	3 Sep 2003 14:13:36 -0000	1.5
@@ -67,5 +67,30 @@
 (assert (= (compiled-logxor -6) -6))
 
 (assert (raises-error? (coerce (expt 10 1000) 'single-float) type-error))
+
+(defun are-we-getting-ash-right (x y)
+  (declare (optimize speed)
+	   (type (unsigned-byte 32) x)
+	   (type (integer -40 0) y))
+  (ash x y))
 
+(defun what-about-with-constants (x)
+  (declare (optimize speed) (type (unsigned-byte 32) x))
+  (ash x -32))
+
+(dotimes (i 41)
+  (assert (= (are-we-getting-ash-right (1- (ash 1 32)) (- i))
+	     (if (< i 32)
+		 (1- (ash 1 (- 32 i)))
+	         0))))
+
+(assert (= (what-about-with-constants (1- (ash 1 32))) 0))
+
+(defun one-more-test-case-to-catch-sparc (x y)
+  (declare (optimize speed (safety 0))
+	   (type (unsigned-byte 32) x) (type (integer -40 2) y))
+  (the (unsigned-byte 32) (ash x y)))
+
+(assert (= (one-more-test-case-to-catch-sparc (1- (ash 1 32)) -40) 0))
+
 (sb-ext:quit :unix-status 104)