X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Farith.pure.lisp;h=f98ba6467a4097ff019a91caf5587ccd73accedc;hb=bbe8a5877fab63f5c159e6c481a449e68b0a5d8f;hp=630c0a8c2b36fa4072f1480d5b0b33cf9dc33627;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git

diff --git a/tests/arith.pure.lisp b/tests/arith.pure.lisp
index 630c0a8..f98ba64 100644
--- a/tests/arith.pure.lisp
+++ b/tests/arith.pure.lisp
@@ -21,9 +21,9 @@
              `(progn
                (assert (= (,op 4 2) ,res1))
                (assert (= (,op 2 4) ,res2))
-               (assert (= (funcall (compile nil (lambda (x y) (,op x y))) 4 2)
+               (assert (= (funcall (compile nil '(lambda (x y) (,op x y))) 4 2)
                         ,res1))
-               (assert (= (funcall (compile nil (lambda (x y) (,op x y))) 2 4)
+               (assert (= (funcall (compile nil '(lambda (x y) (,op x y))) 2 4)
                         ,res2)))))
   (test + 6 6)
   (test - 2 -2)
@@ -264,3 +264,34 @@
            (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))))))))
+
+;; 1.0 had a broken ATANH on win32
+(with-test (:name :atanh)
+  (assert (= (atanh 0.9d0) 1.4722194895832204d0)))
+