;; GCD used to sometimes return negative values. The following did, on 32 bit
;; builds.
(with-test (:name :gcd)
+ ;; from lp#413680
(assert (plusp (gcd 20286123923750474264166990598656
- 680564733841876926926749214863536422912))))
+ 680564733841876926926749214863536422912)))
+ ;; from lp#516750
+ (assert (plusp (gcd 2596102012663483082521318626691873
+ 2596148429267413814265248164610048))))
(with-test (:name :expt-zero-zero)
;; Check that (expt 0.0 0.0) and (expt 0 0.0) signal error, but (expt 0.0 0)
(declare (type (integer -3 57216651) a))
(ldb (byte 9 27) a)))))
(assert (= 0 (- (funcall one 10) (funcall two 10))))))
+
+;; The ISQRT implementation is sufficiently complicated that it should
+;; be tested.
+(with-test (:name :isqrt)
+ (labels ((test (x)
+ (let* ((r (isqrt x))
+ (r2 (expt r 2))
+ (s2 (expt (1+ r) 2)))
+ (unless (and (<= r2 x)
+ (> s2 x))
+ (error "isqrt failure for ~a" x))))
+ (tests (x)
+ (test x)
+ (let ((x2 (expt x 2)))
+ (test x2)
+ (test (1+ x2))
+ (test (1- x2)))))
+ (test most-positive-fixnum)
+ (test (1+ most-positive-fixnum))
+ (loop for i from 1 to 200
+ for pow = (expt 2 (1- i))
+ for j = (+ pow (random pow))
+ do
+ (tests i)
+ (tests j))
+ (dotimes (i 10)
+ (tests (random (expt 2 (+ 1000 (random 10000))))))))
+
+;; bug 1026634 (reported by Eric Marsden on sbcl-devel)
+(with-test (:name :recursive-cut-to-width)
+ (assert (eql (funcall
+ (compile nil
+ `(lambda (x)
+ (declare (optimize (space 3))
+ (type (integer 12417236377505266230
+ 12417274239874990070) x))
+ (logand 8459622733968096971 x)))
+ 12417237222845306758)
+ 2612793697039849090)))
+
+;; Also reported by Eric Marsden on sbcl-devel (2013-06-06)
+(with-test (:name :more-recursive-cut-to-width)
+ (assert (eql (funcall
+ (compile nil `(lambda (a b)
+ (declare (optimize (speed 2) (safety 0)))
+ (logand (the (eql 16779072918521075607) a)
+ (the (integer 21371810342718833225 21371810343571293860) b))))
+ 16779072918521075607 21371810342718833263)
+ 2923729245085762055)))
+
+(with-test (:name :complicated-logand-identity)
+ (loop for k from -8 upto 8 do
+ (loop for min from -16 upto 16 do
+ (loop for max from min upto 16 do
+ (let ((f (compile nil `(lambda (x)
+ (declare (type (integer ,min ,max) x))
+ (logand x ,k)))))
+ (loop for x from min upto max do
+ (assert (eql (logand x k) (funcall f x)))))))))
+
+(with-test (:name :complicated-logior-identity)
+ (loop for k from -8 upto 8 do
+ (loop for min from -16 upto 16 do
+ (loop for max from min upto 16 do
+ (let ((f (compile nil `(lambda (x)
+ (declare (type (integer ,min ,max) x))
+ (logior x ,k)))))
+ (loop for x from min upto max do
+ (assert (eql (logior x k) (funcall f x)))))))))
+
+(with-test (:name :ldb-negative-index-no-error)
+ (assert
+ (raises-error?
+ (funcall (compile nil
+ `(lambda (x y)
+ (ldb (byte x y) 100)))
+ -1 -2)))
+ (assert
+ (raises-error?
+ (funcall (compile nil
+ `(lambda (x y)
+ (mask-field (byte x y) 100)))
+ -1 -2)))
+ (assert
+ (raises-error?
+ (funcall (compile nil
+ `(lambda (x y)
+ (dpb 0 (byte x y) 100)))
+ -1 -2)))
+ (assert
+ (raises-error?
+ (funcall (compile nil
+ `(lambda (x y)
+ (deposit-field 0 (byte x y) 100)))
+ -1 -2))))