[Sbcl-commits] CVS: sbcl/tests arith.pure.lisp,1.28,1.29

[Juho S. <js...@us...>]

Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv11916/tests

Modified Files:
	arith.pure.lisp 
Log Message:
0.9.15.1:
	Faster implementation of the LOGCOUNT VOP for x86 and x86-64,
        and an faster BIGNUM-LOGCOUNT on all platforms. (Patch from
        Lutz Euler on sbcl-devel, "Patch: Optimisation of LOGCOUNT" on
        2006-07-23).


Index: arith.pure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/arith.pure.lisp,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -d -r1.28 -r1.29
--- arith.pure.lisp	14 Jul 2005 16:30:43 -0000	1.28
+++ arith.pure.lisp	28 Jul 2006 01:08:40 -0000	1.29
@@ -264,3 +264,29 @@
            (funcall (lambda ()
                       (declare (notinline logxor))
                       (min (logxor 0 0 0 286142502))))))
+
+;; Small bugs in LOGCOUNT can still allow SBCL to be built and thus go
+;; unnoticed, so check more thoroughly here.
+(with-test (:name :logcount)
+  (flet ((test (x n)
+           (unless (= (logcount x) n)
+             (error "logcount failure for ~a" x))))
+    ;; Test with some patterns with well known number of ones/zeroes ...
+    (dotimes (i 128)
+      (let ((x (ash 1 i)))
+        (test x 1)
+        (test (- x) i)
+        (test (1- x) i)))
+    ;; ... and with some random integers of varying length.
+    (flet ((test-logcount (x)
+             (declare (type integer x))
+             (do ((result 0 (1+ result))
+                  (x (if (minusp x)
+                         (lognot x)
+                         x)
+                     (logand x (1- x))))
+                 ((zerop x) result))))
+      (dotimes (i 200)
+        (let ((x (random (ash 1 i))))
+          (test x (test-logcount x))
+          (test (- x) (test-logcount (- x))))))))