1 (defpackage "SB-GMP-TESTS"
2 (:use "COMMON-LISP" "SB-GMP" "SB-RT"))
4 (in-package "SB-GMP-TESTS")
6 (defparameter *state* (make-gmp-rstate))
7 (rand-seed *state* 1234)
9 (defmacro defgenerator (name arguments &body body)
10 `(defun ,name ,arguments
13 (defgenerator gen-mpz (&key (limbs 5) sign nonzero)
14 (let ((integer (random-bitcount *state*
15 (* limbs sb-vm:n-word-bits))))
16 (when (and nonzero (zerop integer))
21 ((t random) (if (zerop (random 2))
25 (defun gen-mpq (&key (limbs 5) sign nonzero)
26 (let ((numerator (gen-mpz :limbs limbs :sign sign
28 (denominator (gen-mpz :limbs limbs :nonzero t)))
30 (/ (funcall numerator) (funcall denominator)))))
32 (defun maybe-apply (maybe-function &optional arguments)
33 (if (typep maybe-function '(or function symbol))
34 (apply maybe-function arguments)
37 (defun test-one-case (base tested &rest arguments)
38 (let* ((initial-hashes (mapcar #'sxhash arguments))
39 (base-values (let ((*gmp-disabled* t))
40 (multiple-value-list (maybe-apply base arguments))))
41 (test-values (let ((*gmp-disabled* nil))
42 (multiple-value-list (apply tested arguments))))
43 (final-hashes (mapcar #'sxhash arguments)))
44 (unless (and (= (length base-values) (length test-values))
45 (every #'eql base-values test-values))
46 (error "Failed test: ~S returned ~S; expected ~S"
47 (cons tested arguments) test-values base-values))
48 (unless (every #'eql initial-hashes final-hashes)
49 (error "Failed test: ~S modified arguments ~{~A~^, ~} ~
50 (printed modified values)"
51 (cons tested arguments)
53 for initial in initial-hashes
54 for final in final-hashes
55 unless (eql initial final)
59 ;; Really just the most basic smoke test, otherwise
60 ;; build times ballon up a bit on slow machines.
61 (defvar *iteration-count* 3)
63 (defun test-n-cases (base tested &rest argument-generators)
64 (let ((*random-state* (sb-ext:seed-random-state 54321)))
65 (loop repeat *iteration-count* do
66 (apply 'test-one-case base tested
67 (mapcar #'maybe-apply argument-generators)))))
69 (defmacro define-gmp-test ((name &key (repeat 1) limbs (gmp-seed 1234))
72 (let ((*random-state* (sb-ext:seed-random-state 54321)))
73 (rand-seed *state* ,gmp-seed)
76 ;; try to get small failures first
78 (0 ,(subst `(lambda (x)
82 (1 ,(subst `(lambda (x)
87 (declare (ignorable limbs))
92 (:no-error (&rest _) _ t)))
95 (define-gmp-test (mpz-add :repeat 7 :limbs (+ (random #xFFFFF) 2))
96 (test-n-cases '+ 'mpz-add
97 (gen-mpz :limbs limbs :sign t)
98 (gen-mpz :limbs limbs :sign t)))
100 (define-gmp-test (mpz-sub :repeat 7 :limbs (+ (random #x1FFFF) 2))
101 (test-n-cases '- 'mpz-sub
102 (gen-mpz :limbs limbs :sign t)
103 (gen-mpz :limbs limbs :sign t)))
105 (define-gmp-test (mpz-mul :repeat 7 :limbs (+ (random #x253F) 2))
106 (test-n-cases '* 'mpz-mul
107 (gen-mpz :limbs limbs :sign t)
108 (gen-mpz :limbs limbs :sign t)))
110 (define-gmp-test (mpz-tdiv :repeat 7 :limbs (+ (random #x253F) 2))
111 (test-n-cases 'truncate 'mpz-tdiv
112 (gen-mpz :limbs limbs :sign t)
113 (gen-mpz :limbs limbs :sign t :nonzero t)))
115 (define-gmp-test (mpz-fdiv :repeat 7 :limbs (+ (random #x253F) 2))
116 (test-n-cases 'floor 'mpz-fdiv
117 (gen-mpz :limbs limbs :sign t)
118 (gen-mpz :limbs limbs :sign t :nonzero t)))
120 (define-gmp-test (mpz-cdiv :repeat 7 :limbs (+ (random #x253F) 2))
121 (test-n-cases 'ceiling 'mpz-cdiv
122 (gen-mpz :limbs limbs :sign t)
123 (gen-mpz :limbs limbs :sign t :nonzero t)))
125 (define-gmp-test (mpz-gcd :repeat 7 :limbs (+ (random #x253F) 2))
126 (test-n-cases 'gcd 'mpz-gcd
127 (gen-mpz :limbs limbs :sign t)
128 (gen-mpz :limbs limbs :sign t)))
130 (define-gmp-test (mpz-lcm :repeat 7 :limbs (+ (random #x253F) 2))
131 (test-n-cases 'lcm 'mpz-lcm
132 (gen-mpz :limbs limbs :sign t)
133 (gen-mpz :limbs limbs :sign t)))
135 (define-gmp-test (isqrt :repeat 7 :limbs (+ (random #x253F) 2))
136 (test-n-cases 'isqrt 'mpz-sqrt (gen-mpz :limbs limbs)))
138 (define-gmp-test (mpz-mod :repeat 7 :limbs (1+ (random #x253F)))
139 (test-n-cases 'mod 'mpz-mod
140 (gen-mpz :limbs limbs :sign t)
141 (gen-mpz :limbs limbs :sign t :nonzero t)))
143 (define-gmp-test (mpz-powm :repeat 7 :limbs (1+ (random #x253F)))
144 (test-n-cases (lambda (base exponent mod)
145 (let ((*gmp-disabled* nil)) ; atrociously slow otherwise
146 (mod (expt base exponent) mod)))
148 (gen-mpz :limbs limbs :sign t)
151 (gen-mpz :limbs (ceiling limbs 2) :nonzero t)))
153 ;; bugs that have been fixed
154 (define-gmp-test (sign-conversion)
155 (test-one-case '+ 'mpz-add #x7FFFFFFFFFFFFFFF #x7FFFFFFFFFFFFFFF))
156 (define-gmp-test (truncate-1)
157 (test-one-case 'truncate 'mpz-tdiv
158 30951488519636377404900619671461408624764773310745985021994671444676860083493
159 200662724990805535745252242839121922075))
160 (define-gmp-test (truncate-2)
161 (test-one-case 'truncate 'mpz-tdiv
162 320613729464106236061704728914573914390
163 -285049280629101090500613812618405407883))
165 (define-gmp-test (mpz-nextprime :repeat 7
167 :limbs (1+ (random #x2F)))
168 (let ((a (gen-mpz :limbs limbs)))
169 (dotimes (i *iteration-count*)
170 (let* ((a (funcall a))
171 (p (mpz-nextprime a)))
173 (assert (plusp (mpz-probably-prime-p p)))))))
175 (define-gmp-test (mpq-add :repeat 7 :limbs (1+ (random #x3FF))
177 (test-n-cases '+ 'mpq-add
178 (gen-mpq :limbs limbs :sign t)
179 (gen-mpq :limbs limbs :sign t)))
181 (define-gmp-test (mpq-sub :repeat 7 :limbs (1+ (random #x1FF))
183 (test-n-cases '- 'mpq-sub
184 (gen-mpq :limbs limbs :sign t)
185 (gen-mpq :limbs limbs :sign t)))
187 (define-gmp-test (mpq-mul :repeat 7 :limbs (1+ (random #x5FF))
189 (test-n-cases '* 'mpq-mul
190 (gen-mpq :limbs limbs :sign t)
191 (gen-mpq :limbs limbs :sign t)))
193 (define-gmp-test (mpq-div :repeat 7 :limbs (1+ (random #x3FF))
195 (test-n-cases '/ 'mpq-div
196 (gen-mpq :limbs limbs :sign t)
197 (gen-mpq :limbs limbs :sign t)))