1 ;;; ent-tests.el -- Tests for Enhanced Number Types
2 ;; Copyright (C) 2005 Sebastian Freundt
4 ;; Author: Sebastian Freundt <hroptatyr@sxemacs.org>
7 ;; This file is part of SXEmacs.
9 ;; SXEmacs is free software: you can redistribute it and/or modify it
10 ;; under the terms of the GNU General Public License as published by the
11 ;; Free Software Foundation, either version 3 of the License, or (at your
12 ;; option) any later version.
14 ;; SXEmacs is distributed in the hope that it will be
15 ;; useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 ;; General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
22 ;;; Synched up with: Not in FSF.
25 ;; - test for conceptionally correct arithmetic
26 ;; See test-harness.el for instructions on how to run these tests.
30 (require 'test-harness)
33 (when (and (boundp 'load-file-name) (stringp load-file-name))
34 (push (file-name-directory load-file-name) load-path))
35 (require 'test-harness))))
37 ;;-----------------------------------------------------
39 ;;-----------------------------------------------------
41 ;;; test simple syntaxes
42 ;; this tests for `1' being read and coerced to a fixnum
45 (Assert (not (floatp num)))
46 (Assert (integerp num))
47 (Assert (rationalp num))
48 (Assert (not (realp num)))
49 (Assert (comparablep num))
50 (Assert (not (complexp num)))
51 (Assert (archimedeanp num))
52 (Assert (numberp num))
54 (when (featurep 'bigz)
55 (Assert (not (bigzp num))))
56 (when (featurep 'bigq)
57 (Assert (not (bigqp num))))
58 (when (featurep 'bigf)
59 (Assert (not (bigfp num))))
60 (when (featurep 'bigfr)
61 (Assert (not (bigfrp num))))
62 (when (featurep 'bigg)
63 (Assert (not (biggp num))))
64 (when (featurep 'bigc)
65 (Assert (not (bigcp num)))))
68 ;; this tests for `1/2' being read and coerced to a fraction
69 (when (featurep 'bigq)
71 (Assert (not (intp num)))
72 (Assert (not (floatp num)))
73 (Assert (not (integerp num)))
74 (Assert (rationalp num))
75 (Assert (not (realp num)))
76 (Assert (comparablep num))
77 (Assert (not (complexp num)))
78 (Assert (archimedeanp num))
79 (Assert (numberp num))
81 (when (featurep 'bigz)
82 (Assert (not (bigzp num))))
83 (when (featurep 'bigq)
85 (when (featurep 'bigf)
86 (Assert (not (bigfp num))))
87 (when (featurep 'bigfr)
88 (Assert (not (bigfrp num))))
89 (when (featurep 'bigg)
90 (Assert (not (biggp num))))
91 (when (featurep 'bigc)
92 (Assert (not (bigcp num))))))
95 ;; this tests for `1.0' being read and coerced to a float
96 (let* ((read-real-as 'float)
98 (Assert (not (intp num)))
100 (Assert (not (integerp num)))
101 (Assert (not (rationalp num)))
103 (Assert (comparablep num))
104 (Assert (not (complexp num)))
105 (Assert (archimedeanp num))
106 (Assert (numberp num))
108 (when (featurep 'bigz)
109 (Assert (not (bigzp num))))
110 (when (featurep 'bigq)
111 (Assert (not (bigqp num))))
112 (when (featurep 'bigf)
113 (Assert (not (bigfp num))))
114 (when (featurep 'bigfr)
115 (Assert (not (bigfrp num))))
116 (when (featurep 'bigg)
117 (Assert (not (biggp num))))
118 (when (featurep 'bigc)
119 (Assert (not (bigcp num)))))
122 ;; this tests for `1+i' being read and coerced to a Gaussian, if provided
123 (when (featurep 'bigg)
125 (Assert (not (intp num)))
126 (Assert (not (floatp num)))
127 (Assert (not (integerp num)))
128 (Assert (not (rationalp num)))
129 (Assert (not (realp num)))
130 (Assert (not (comparablep num)))
131 (Assert (complexp num))
132 (Assert (archimedeanp num))
133 (Assert (numberp num))
135 (when (featurep 'bigz)
136 (Assert (not (bigzp num))))
137 (when (featurep 'bigq)
138 (Assert (not (bigqp num))))
139 (when (featurep 'bigf)
140 (Assert (not (bigfp num))))
141 (when (featurep 'bigfr)
142 (Assert (not (bigfrp num))))
144 (when (featurep 'bigc)
145 (Assert (not (bigcp num))))))
148 ;; this tests for `1.0+0.0i' being read and coerced to a bigc if provided
149 (when (featurep 'bigc)
150 (let ((num 1.0+0.0i))
151 (Assert (not (intp num)))
152 (Assert (not (floatp num)))
153 (Assert (not (integerp num)))
154 (Assert (not (rationalp num)))
155 (Assert (not (realp num)))
156 (Assert (not (comparablep num)))
157 (Assert (complexp num))
158 (Assert (archimedeanp num))
159 (Assert (numberp num))
161 (when (featurep 'bigz)
162 (Assert (not (bigzp num))))
163 (when (featurep 'bigq)
164 (Assert (not (bigqp num))))
165 (when (featurep 'bigf)
166 (Assert (not (bigfp num))))
167 (when (featurep 'bigfr)
168 (Assert (not (bigfrp num))))
169 (when (featurep 'bigg)
170 (Assert (not (biggp num))))
171 (Assert (bigcp num))))
174 ;;-----------------------------------------------------
176 ;;-----------------------------------------------------
177 (when (featurep 'bigz)
178 (Assert (bigzp (coerce-number 0 'bigz)))
179 (Assert (bigzp (coerce-number 1 'bigz)))
180 (Assert (and (bigzp (factorial 100))
181 (bigzp (coerce-number (factorial 100) 'bigz))))
182 (Assert (bigzp (coerce-number 1.0 'bigz)))
183 (Assert (intp (coerce-number (factorial 100) 'int)))
184 (Assert (zerop (coerce-number (factorial 100) 'int)))
185 (Assert (let ((more-than-mpf (1+ most-positive-fixnum)))
186 (equal (coerce-number more-than-mpf 'float)
187 (1+ (coerce-number most-positive-fixnum 'float))))))
189 (when (featurep 'bigq)
190 (Assert (bigqp (coerce-number 0 'bigq)))
191 (Assert (bigqp (coerce-number 1 'bigq)))
192 (Assert (and (bigqp 3/2)
193 (bigqp (coerce-number 3/2 'bigq))))
194 (Assert (bigqp (coerce-number 1.5 'bigq)))
195 (Assert (intp (coerce-number 3/2 'int)))
196 (Assert (bigzp (coerce-number 3/2 'bigz)))
197 (Assert (bigqp (// 2)))
198 (Assert (bigqp (// 2 3)))
199 (Assert (intp (// 4 2)))
200 (when (featurep 'bigz)
201 (Assert (bigzp (numerator 3/2)))
202 (Assert (bigzp (denominator 3/2)))))
204 (when (and (featurep 'bigg)
206 (Assert (biggp (coerce-number 1.0+2.0i 'bigg)))
207 (Assert (bigcp (coerce-number 1+2i 'bigc))))
211 ;;-----------------------------------------------------
212 ;; Testing auto-coercion in operations
213 ;;-----------------------------------------------------
214 (when (featurep 'bigz)
217 ;; this test should reveal re-canonicalisation
218 (eval `(Assert (intp (+ ,num1 (coerce-number ,num1 'bigz)))))
219 (eval `(Assert (intp (* ,num1 (coerce-number ,num1 'bigz)))))
220 (eval `(Assert (intp (- ,num1 (coerce-number ,num1 'bigz)))))
221 (eval `(Assert (intp (/ ,num1 (coerce-number ,num1 'bigz)))))
222 (eval `(Assert (intp (^ ,num1 (coerce-number ,num1 'bigz)))))
223 (eval `(Assert (intp (+ (coerce-number ,num1 'bigz) ,num1))))
224 (eval `(Assert (intp (* (coerce-number ,num1 'bigz) ,num1))))
225 (eval `(Assert (intp (- (coerce-number ,num1 'bigz) ,num1))))
226 (eval `(Assert (intp (/ (coerce-number ,num1 'bigz) ,num1))))
227 (eval `(Assert (intp (^ (coerce-number ,num1 'bigz) ,num1))))
228 ;; floats and bigz should always result in a float
229 (eval `(Assert (floatp (+ ,num2 (coerce-number ,num1 'bigz)))))
230 (eval `(Assert (floatp (* ,num2 (coerce-number ,num1 'bigz)))))
231 (eval `(Assert (floatp (- ,num2 (coerce-number ,num1 'bigz)))))
232 (eval `(Assert (floatp (/ ,num2 (coerce-number ,num1 'bigz)))))
233 ;; (when (featurep 'bigfr)
234 ;; (eval `(Assert (bigfrp (^ ,num2 (coerce-number ,num1 'bigz))))))
235 (eval `(Assert (floatp (+ (coerce-number ,num1 'bigz) ,num2))))
236 (eval `(Assert (floatp (* (coerce-number ,num1 'bigz) ,num2))))
237 (eval `(Assert (floatp (- (coerce-number ,num1 'bigz) ,num2))))
238 (eval `(Assert (floatp (/ (coerce-number ,num1 'bigz) ,num2))))
241 ;;-----------------------------------------------------
242 ;; Testing selectors and constructors
243 ;;-----------------------------------------------------
244 (when (featurep 'bigg)
245 (let ((read-real-as 'bigfr)
246 (default-real-precision 128))
248 ;; testing bigg selector
249 (Assert-Not-Equal (real-part (read "2+3i")) 2)
250 (Assert-Not-Equal (imaginary-part (read "2+3i")) 3)
251 (Assert-Not-Equal (real-part 2+3i) 2)
252 (Assert-Not-Equal (imaginary-part 2+3i) 3)
253 (Assert-Equal (real-part (read "2+3i")) (bigz 2))
254 (Assert-Equal (imaginary-part (read "2+3i")) (bigz 3))
255 (Assert-Equal (real-part 2+3i) (bigz 2))
256 (Assert-Equal (imaginary-part 2+3i) (bigz 3))
257 ;; use numerical equality
258 (Assert (= (real-part (read "2+3i")) 2))
259 (Assert (= (imaginary-part (read "2+3i")) 3))
260 (Assert (= (real-part 2+3i) 2))
261 (Assert (= (imaginary-part 2+3i) 3))
262 (Assert (= (real-part (read "2+3i")) (bigz 2)))
263 (Assert (= (imaginary-part (read "2+3i")) (bigz 3)))
264 (Assert (= (real-part 2+3i) (bigz 2)))
265 (Assert (= (imaginary-part 2+3i) (bigz 3)))
267 ;; testing bigg constructor
268 (Assert-Not-Equal (real-part (make-bigg 1 2)) 1)
269 (Assert-Not-Equal (imaginary-part (make-bigg 1 2)) 2)
270 (Assert-Equal (real-part (make-bigg 1 2)) (bigz 1))
271 (Assert-Equal (imaginary-part (make-bigg 1 2)) (bigz 2))
272 (Assert (= (real-part (make-bigg 1 2)) 1))
273 (Assert (= (imaginary-part (make-bigg 1 2)) 2))
275 ;; compare reader and constructor
276 (Assert-Equal (make-bigg 1.0 2.0) (read "1+2i"))
277 (Assert-Equal (make-bigg 1 2) (read "1+2i"))
278 (Assert (and (= (real-part (make-bigg 1.0 2.0))
279 (real-part (read "1+2i")))
280 (= (imaginary-part (make-bigg 1.0 2.0))
281 (imaginary-part (read "1+2i")))))
282 (Assert (and (= (real-part (make-bigg 1 2))
283 (real-part (read "1+2i")))
284 (= (imaginary-part (make-bigg 1 2))
285 (imaginary-part (read "1+2i")))))))
287 (when (featurep 'bigc)
288 (let ((read-real-as 'bigfr)
289 (default-real-precision 128))
291 ;; testing bigc selector
292 (Assert-Equal (real-part (read "2.3+3.2i"))
294 (Assert-Equal (imaginary-part (read "2.3+3.2i"))
296 ;; use numerical equality
297 (Assert (= (real-part (read "2.3+3.2i"))
299 (Assert (= (imaginary-part (read "2.3+3.2i"))
302 ;; testing bigc constructor
303 (Assert-Not-Equal (real-part (make-bigc 1 2)) 1)
304 (Assert-Not-Equal (imaginary-part (make-bigc 1 2)) 2)
305 (Assert-Equal (real-part (make-bigc 1 2)) (bigfr 1))
306 (Assert-Equal (imaginary-part (make-bigc 1 2)) (bigfr 2))
307 (Assert (= (real-part (make-bigc 1 2)) 1))
308 (Assert (= (imaginary-part (make-bigc 1 2)) 2))
310 ;; now compare reader and constructor
311 (Assert-Equal (make-bigc 1.0 2.0) (read "1.0+2.0i"))
312 (Assert-Equal (make-bigc 1 2) (read "1.0+2.0i"))
313 (Assert (and (= (real-part (make-bigc 1.0 2.0))
314 (real-part (read "1.0+2.0i")))
315 (= (imaginary-part (make-bigc 1.0 2.0))
316 (imaginary-part (read "1.0+2.0i")))))
317 (Assert (and (= (real-part (make-bigc 1 2))
318 (real-part (read "1.0+2.0i")))
319 (= (imaginary-part (make-bigc 1 2))
320 (imaginary-part (read "1.0+2.0i")))))))
325 ;;-----------------------------------------------------
326 ;; Testing formatting output
327 ;;-----------------------------------------------------
329 (Assert-Equal (format "%d" 2) "2")
330 (Assert-Equal (format "%d" -2) "-2")
331 (Assert-Equal (format "%2.2E" -2) "-2.00E+00")
333 (Assert-Equal (format "%x" 100) "64")
334 (Assert-Equal (format "%#x" 100) "0x64")
335 (Assert-Equal (format "%X" 122) "7A")
336 (Assert-Equal (format "%.4X" 122) "007A")
337 (Assert-Equal (format "%4o" 100) " 144")
338 (Assert-Equal (format "%x" 10.58) "a")
339 (Assert-Equal (format "%o" 10.58) "12")
340 (Assert-Equal (format "%#o" 10.58) "0o12")
344 '(1.0 1.00000 0.5 0.005 5.000005 4.0625 8.03125
345 9876.54321 10000.00001 12004.40021
346 1.5e+10 1.125e+11 1.0703125e+12
347 1.1e+15 1.2e+16 1.4e+20 1.45e+24
348 1.52e+28 1.55e+30 1.52105432e+31 1.5445633221e+32
349 1.7777777777777e+33 1.7777777777777776e+33
350 1.8999999999999e+33 1.999989999999999e+33
351 1.99999999e+35 1.9999999999e+36 1.999999999999e+37
352 1.99999999999999e+38 1.999999999999999e+39
353 1.9999999999999999e+40 2.000000000000000000e+40
354 2.000000000000001e+42 2.000000000000009e+44
355 2.002000200002000002000000e+48
356 2.000000200000200002000200e+50
357 200000020000020000200020.0e+50
358 12345555555555555555.999999999e+60
359 12344444444444444444.999999999e+60
360 1234545454545454545454545454545.000
361 123454545454545454545454545454545454545454545.000
362 4444444444444.55555555555e+100
363 5555555555555.55555555555e+102
364 5555555555555.44444444444e+104
365 5555555555555.99999999998e+106
366 50505050505050505050505.0e+200
367 1e+300 1e+301 1e+302 -1e+300 -1e+301 -1e+302
368 1e+304 -1e+304 1e+305 -1e+305 1e+306 -1e+306
369 1e+307 2e+307 8e+307 -8e+307
370 1e+308 -1e+308 8e+308 -8e+308
371 1e+309 -1e+309 -8e+309 8e+309
372 ;; we should be outta range of double floats
373 1.00e+310 2.50e+310 2.55e+310
374 2.125e+312 2.0004500045e+313 1.2e+314 1.2e+320
375 1.22229e+320 100e+320 101e+321 102e+322
376 ;; we're still alive?
377 most-positive-float most-negative-float
378 ;; the following two may not work correctly if the number
379 ;; distribution has many subnormal numbers
380 ;;(1+ most-positive-float) (1- most-negative-float)
381 ;;(1- most-positive-float) (1+ most-negative-float)
382 1.0e+340 1.0e+350 1.0e+380 1.0e+400
383 1.2e+300 1.2e+310 1.2e+320 1.2e+400
384 1.2e+2000 1.2e+3000 1.2e+4000 1.2e+5000))
386 ;; known errors (due to precision issues, not SXE's fault)
387 '(1e-300 1e-301 1e-302 1e-303 1e-304 1e-305 1e-306
389 2.5e-310 2.55e-311 2.55e-312
390 1.2e-320 1.201e-320 1.25e-320
391 1.22229e-320 100e-306 100e-307 100e-308 100e-309
392 100e-310 100e-311 100e-312 100e-313 100e-314 100e-315
393 100e-316 100e-317 100e-318 100e-319 100e-320 100e-321
394 100e-322 100e-323 100e-324 100e-325 100e-326 100e-327
395 100e-328 100e-329 100e-330 1.2e-330 1.25e-330
396 0.5e-306 0.5e-307 0.5e-308 0.5e-309 0.5e-310 0.5e-311
397 0.5e-312 0.5e-313 0.5e-314 0.5e-315 0.5e-316 0.5e-317
398 0.5e-318 0.5e-319 0.5e-320 0.5e-321 0.5e-322 0.5e-323)))
401 (unless (or (infinityp (eval str)) (zerop (eval str)))
402 (eval `(Assert (= (read (format "%f" ,str)) ,str)))
403 (eval `(Assert (eql (read (format "%f" ,str)) ,str)))))
407 (unless (or (infinityp (eval str)) (zerop (eval str)))
408 (eval `(Assert (not (= (read (format "%f" ,str)) ,str))))
409 (eval `(Assert (not (eql (read (format "%f" ,str)) ,str))))))
412 ;; now testing bigz formatting
413 (when (featurep 'bigz)
417 (("%2Z" 200) . "200")
426 (("%4.2Z" 2) . " 02")
427 (("%04.2Z" 2) . " 02")
428 (("%-4.2Z" 2) . "02 ")
429 (("%0-4.2Z" 2) . "02 ")
430 (("%Z" (factorial 20)) .
431 "2432902008176640000")
432 (("%40Z" (factorial 20)) .
433 " 2432902008176640000")
434 (("%-40Z" (factorial 20)) .
435 "2432902008176640000 ")
436 (("%.40Z" (factorial 20)) .
437 "0000000000000000000002432902008176640000")
438 (("%040Z" (factorial 20)) .
439 "0000000000000000000002432902008176640000")
440 (("%.8Z" (factorial 20)) .
441 "2432902008176640000")
442 (("%08Z" (factorial 20)) .
443 "2432902008176640000")
444 (("%24.8Z" (factorial 20)) .
445 " 2432902008176640000")
446 (("%36.28Z" (factorial 20)) .
447 " 0000000002432902008176640000")
448 (("%036.28d" (factorial 20)) .
449 " 0000000002432902008176640000")
450 (("%0-36.28d" (factorial 20)) .
451 "0000000002432902008176640000 ")
453 ;; now the same with the %d specifier
456 (("%2d" 200) . "200")
465 (("%4.2d" 2) . " 02")
466 (("%04.2d" 2) . " 02")
467 (("%-4.2d" 2) . "02 ")
468 (("%0-4.2d" 2) . "02 ")
469 (("%d" (factorial 20)) . "2432902008176640000")
470 (("%40d" (factorial 20)) .
471 " 2432902008176640000")
472 (("%-40d" (factorial 20)) .
473 "2432902008176640000 ")
474 (("%.40d" (factorial 20)) .
475 "0000000000000000000002432902008176640000")
476 (("%040d" (factorial 20)) .
477 "0000000000000000000002432902008176640000")
478 (("%.8d" (factorial 20)) . "2432902008176640000")
479 (("%24.8d" (factorial 20)) . " 2432902008176640000")
480 (("%36.28d" (factorial 20)) .
481 " 0000000002432902008176640000")
482 (("%036.28d" (factorial 20)) .
483 " 0000000002432902008176640000")
484 (("%0-36.28d" (factorial 20)) .
485 "0000000002432902008176640000 ")
487 ;; testing base converters on big ints
488 ;; moved to format-tests
492 (let ((format (cons 'format (car f)))
494 (eval `(Assert (string= ,format ,expected)))))
498 ;; now testing bigq formatting
499 (when (featurep 'bigq)
503 (("%2Q" 200) . "200")
516 (("%-4.2Q" 2) . "2 ")
518 ;; testing with proper fractions
520 (("%5Q" 2/3) . " 2/3")
521 (("%5.5Q" 2/3) . " 2/3")
522 (("%+Q" 2/3) . "+2/3")
523 (("% Q" 2/3) . " 2/3")
524 (("% +Q" 2/3) . "+2/3")
525 (("%+ Q" 2/3) . "+2/3")
526 (("%Q" (float 1.5)) . "3/2")
527 (("%Q" (float 0.66666)) . "3002369727582815/4503599627370496")
528 (("%-10Q" 2/3) . "2/3 ")
530 ;; testing coercion to Z
532 (("%Z" 2/3) . "0"))))
535 (let ((format (cons 'format (car f)))
537 (eval `(Assert (string= ,format ,expected)))))
541 (when (featurep 'bigfr)
543 '((("%f" (exp 1)) . "2.718282")
544 (("%2.2f" (exp 1)) . "2.72")
545 ;; this test uses a wrong output string deliberately
546 ;; it's wrong because the precision of IEEE-754 doubles is
547 ;; not enough to have 20 correct digits in the fractional part
548 ;; however, since we _can_ have long doubles now, this test
549 ;; is no longer feasible since lisp should know a shit about
550 ;; the internal representation of fpfloats. -hroptatyr
551 ;;(("%2.20f" (exp 1)) . "2.71828182845904509080")
553 ;; now testing with %F
554 (("%F" (exp 1)) . "2.718281828459045235360287471352662497759")
555 (("%2.2F" (exp 1)) . "2.71")
556 (("%+2.2F" (exp 1)) . "+2.71")
557 (("%10.0F" (exp 1)) . " 2")
558 (("%10.1F" (exp 1)) . " 2.7")
559 (("%12.12F" (exp 1)) . "2.718281828459")
560 (("%30.12F" (exp 1)) . " 2.718281828459")
561 (("%5.5F" (exp 13)) . "442413.39200")
562 (("%F" (/ (exp 1))) .
563 "0.3678794411714423215955237701614608674462")
564 (("%2.2F" (/ (exp 1))) . "0.36")
565 (("%3.3F" (/ (exp 1))) . "0.367")
566 (("%.5F" (bigfr 1)) . "1.00000")
568 (("%.4F" (bigfr 23213231 25)) . "23213231.0000")
570 ;;(("%.4F" (bigfr 23213231 8)) . "23200000.0000")
571 (("%Z" (bigfr 23213231 25)) . "23213231")
572 (("%Z" (bigfr 23213231 8)) . "23199744")
574 (("%+.4f" 2) . "+2.0000")
575 (("%+.4F" 2) . "+2.0000")
576 (("% .4F" 2) . " 2.0000")
577 (("%+10.4F" 2) . " +2.0000")))
578 (default-real-precision 128))
581 (let ((format (cons 'format (car f)))
583 (eval `(Assert (string= ,format ,expected)))))
586 (when (featurep 'bigg)
588 '((("%B" 2+i) . "2+1i")
589 (("%+B" 2+i) . "+2+1i")
590 (("% B" 2+i) . " 2+1i")
592 (format "%Z%+Zi" (real-part 2+i) (imaginary-part 2+i)))
594 (("%+10.4B" 1.2) . " +0001 +0000i")
595 (("%-10.4B" 0+2i) . "0000 +0002 i"))))
598 (let ((format (cons 'format (car f)))
600 (eval `(Assert (string= ,format ,expected)))))
603 ;; Gaussian numbers shall not be coerced to comparables
604 (Check-Error domain-error (format "%d" 1+i))
605 (Check-Error domain-error (format "%f" 1+i))
606 (when (featurep 'bigq)
607 (Check-Error domain-error (format "%Q" 1+i)))
608 (when (featurep 'bigfr)
609 (Check-Error domain-error (format "%F" 1+i))))
612 (when (featurep 'bigc)
614 '((("%.2C" 2+i) . "2.00+1.00i")
615 (("%+.2C" 2+i) . "+2.00+1.00i")
616 (("% .2C" 2+i) . " 2.00+1.00i")
618 (format "%.2F%+.2Fi" (real-part 2+i) (imaginary-part 2+i)))
619 (("%.2C" 1) . "1.00+0.00i")
620 (("%+10.4C" 1.5) . " +1.5000 +0.0000i")
621 (("%-10.4C" 0+2i) . "0.0000 +2.0000 i"))))
624 (let ((format (cons 'format (car f)))
626 (eval `(Assert (string= ,format ,expected)))))
629 ;; complex numbers shall not be coerced to comparables
630 (Check-Error domain-error (format "%d" (sqrt -2)))
631 (Check-Error domain-error (format "%f" (sqrt -2)))
632 (when (featurep 'bigq)
633 (Check-Error domain-error (format "%Q" (sqrt -2))))
634 (when (featurep 'bigfr)
635 (Check-Error domain-error (format "%F" (sqrt -2)))))
638 ;;-----------------------------------------------------
640 ;;-----------------------------------------------------
641 (when (featurep 'bigz)
643 (let ((sums '((1 2 3)
644 (12332112344321 10000000000000 22332112344321)
645 (12332112344321 1 12332112344322)
646 (1 12332112344321 12332112344322)
647 (10101010101010 1010101010101 11111111111111)
648 (-10101010101010 10101010101010 0)))
650 (1002004002001 402010204 402815833253238418204)
651 (-1002004002001 402010204 -402815833253238418204)))
656 (32 32 1461501637330902918203684832716283019655932542976)
659 (when (featurep 'bigq)
663 (32 32 1461501637330902918203684832716283019655932542976)
664 (32 -32 1/1461501637330902918203684832716283019655932542976)))))
665 (mapc #'(lambda (sum)
666 (eval `(Assert (= (+ ,(car sum) ,(cadr sum)) ,(caddr sum))))
667 (eval `(Assert (= (- ,(caddr sum) ,(cadr sum)) ,(car sum))))
668 (unless (bigzp (caddr sum))
669 (eval `(Assert (= (bigz (+ (bigz ,(car sum))
671 (bigz ,(caddr sum)))))
672 (eval `(Assert (= (bigz (- (bigz ,(caddr sum))
675 ;; testing triangle inequality
676 ;; | a + b | <= |a| + |b|
677 (eval `(Assert (<= (abs (+ ,(car sum) ,(cadr sum)))
678 (+ (abs ,(car sum)) (abs ,(cadr sum))))))))
680 (mapc #'(lambda (prod)
681 (eval `(Assert (= (* ,(car prod) ,(cadr prod)) ,(caddr prod))))
682 (eval `(Assert (= (/ ,(caddr prod) ,(cadr prod)) ,(car prod))))
683 (unless (bigzp (caddr prod))
684 (eval `(Assert (= (bigz (* (bigz ,(car prod))
685 (bigz ,(cadr prod))))
686 (bigz ,(caddr prod)))))
687 (eval `(Assert (= (bigz (/ (bigz ,(caddr prod))
688 (bigz ,(cadr prod))))
689 (bigz ,(car prod)))))
690 ;; testing multiplicativiy of abs
692 (eval `(Assert (= (abs (* ,(car prod) ,(cadr prod)))
693 (* (abs ,(car prod)) (abs ,(cadr prod))))))))
695 (let ((common-lisp-slash nil))
696 (mapc #'(lambda (pow)
697 (eval `(Assert (= (^ ,(car pow) ,(cadr pow)) ,(caddr pow))))
698 (unless (bigzp (caddr pow))
699 (eval `(Assert (= (bigz (^ (bigz ,(car pow))
701 (bigz ,(caddr pow)))))))
703 (let ((common-lisp-slash t))
704 (mapc #'(lambda (pow)
705 (eval `(Assert (= (^ ,(car pow) ,(cadr pow)) ,(caddr pow))))
706 (unless (bigzp (caddr pow))
707 (eval `(Assert (= (bigz (^ (bigz ,(car pow))
709 (bigz ,(caddr pow)))))))
712 ;; exponentiation overflows at some point
713 ;; we use (factorial 400) which is a ~2887 bit number
714 ;; should be large enough to never ever be a native integer (fixnum)
715 ;; oh, in case someone already bought a 3072-bit processor,
717 (Check-Error range-error (^ (factorial 400) (factorial 400)))
718 ;; unless we try a unit or a zero as base
719 (Assert (= (^ 1 (factorial 400)) 1))
720 (Assert (= (^ -1 (factorial 400)) 1))
721 (Assert (= (^ -1 (1+ (factorial 400))) -1))
722 (Assert (= (^ 0 (factorial 400)) 0))
724 ;;; maxima and minima
725 (let ((sets '(((1 2 3 -44) :max 3 :min -44)
726 ((1 1 1 1 1) :max 1 :min 1)
727 ((-100 -2000 -4000) :max -100 :min -4000)
728 ((+infinity 5000 -6000 -8000 -infinity)
729 :max +infinity :min -infinity))))
730 (mapc #'(lambda (set)
731 (let ((max (plist-get (cdr set) :max))
732 (min (plist-get (cdr set) :min)))
733 (eval `(Assert (= ,max (max ,@(car set)))))
734 (eval `(Assert (= ,min (min ,@(car set)))))))
738 ;; we cannot use eq for big integers
739 ;; also, (mod (coerce -1 'bigz) 17) => 16 and not -1, therefore
740 ;; the result differs by 17 when we have negative x
741 (Assert (= 16 (% (coerce -1 'bigz) 17)))
745 (eval `(Assert (= ,x (+ (% ,x 17) (* (/ ,x 17) 17)))))
746 (eval `(Assert (= (- ,x) (+ (% (- ,x) 17) (* (/ (- ,x) 17) 17)))))
747 (let ((z (+ (% y 17) (* (/ y 17) 17))))
749 (eval `(Assert (= ,y (- ,z 17))))
750 (eval `(Assert (= ,y z)))))
756 (let* ((r (abs (random)))
758 (rf `(remove-factor ,i ,r))
759 (-rf `(remove-factor ,i ,-r))
760 (rf! (remove-factor i r))
761 (-rf! (remove-factor i -r)))
762 ;; first, test a positive number
763 (eval `(Assert (consp ,rf)))
764 (eval `(Assert (nonnegativep (cdr ,rf))))
765 (eval `(Assert (or (< (car ,rf) ,r)
767 ;; then a negative number
768 (eval `(Assert (consp ,-rf)))
769 (eval `(Assert (nonnegativep (cdr ,-rf))))
770 (eval `(Assert (or (< ,-r (car ,-rf))
771 (zerop (cdr ,-rf)))))
772 ;; then test if reduced number is coprime to factor
773 (eval `(Assert (= (car (remove-factor ,i ,(car rf!)))
775 (eval `(Assert (zerop (cdr (remove-factor ,i ,(car rf!))))))
776 (eval `(Assert (= (car (remove-factor ,i ,(car -rf!)))
778 (eval `(Assert (zerop (cdr (remove-factor ,i ,(car -rf!)))))))))
779 '(2 3 4 10 20 50 100 200))
781 ;; check the consistency of the result values
785 (rf `(remove-factor ,i ,r))
786 (rf! (remove-factor i r)))
787 ;; check if car*factor^cdr is the original number
788 (eval `(Assert (= (* ,(car rf!) (^ ,i ,(cdr rf!))) ,r)))
790 (eval `(Assert (coprimep ,i ,(car rf!))))))))
791 '(-29 -19 -17 -13 -11 -7 -5 -3 -2 -1 0
792 1 2 3 5 7 11 13 17 19 29))
797 (let* ((r (sqrt (abs (random))))
798 (rf `(remove-factor ,i ,r))
799 (rf! (remove-factor i r)))
800 (eval `(Assert (consp ,rf)))
801 (eval `(Assert (nonnegativep (cdr ,rf))))
802 (eval `(Assert (or (< (car ,rf) ,r)
803 (zerop (cdr ,rf))))))
804 ;; test quotient args
805 (let* ((r (// (random) (random)))
806 (rf `(remove-factor ,i ,r))
807 (rf! (remove-factor i r)))
808 (eval `(Assert (consp ,rf)))
809 (eval `(Assert (nonnegativep (cdr ,rf))))
810 (eval `(Assert (or (/= (car ,rf) ,r)
811 (zerop (cdr ,rf))))))))
812 '(-29 -29/3 -19 -19/2 -17 -17.25 -13 -13.2
814 7/3 11 11/3 13 13.4 17 17/2 19 19.25 29 29.3))
816 ;;; test primep, coprimep, next prime, etc.
818 (eval `(Assert (primep ,i)))
820 (let ((r (car (remove-factor i (random)))))
821 (eval `(Assert (coprimep ,i ,r)))))
822 (eval `(Assert (< ,i (next-prime ,i))))
823 (eval `(Assert (primep ,(next-prime i))))
824 (eval `(Assert (coprimep ,i ,(next-prime i)))))
825 '(-521 -101 -61 -29 2 3 5 7 11 13 17 19 29 101))
826 ;; test some Mersenne primes (this may take some time)
828 (let ((Mi (1- (2^ i))))
829 (eval `(Assert (primep ,Mi)))
830 (eval `(Assert (oddp ,Mi)))))
831 '(2 3 5 7 13 17 19 31 61 89 107 127 521 607))
836 (r (loop for j from 2 to i
841 (rf-1 `(factorial ,(1- i))))
842 ;; check if (factorial i) == 1*2*...*i
843 (eval `(Assert (= ,r ,rf)))
844 (eval `(Assert (evenp ,rf)))
845 (eval `(Assert (not (primep ,rf))))
846 (eval `(Assert (= (car (remove-factor ,rf-1 ,rf)) ,i)))
847 (eval `(Assert (= (cdr (remove-factor ,rf-1 ,rf)) 1)))))
848 '(3 4 5 6 7 8 9 10 11 20 30))
849 ;; further tests with inductive Assert
851 (let* ((rf `(factorial ,i))
852 (rf-1 `(factorial ,(1- i))))
853 ;; check if (factorial i) == 1*2*...*i
854 (eval `(Assert (= ,rf (* ,i ,rf-1))))
856 (eval `(Assert (> (log ,rf) (- (* ,i (log ,i)) ,i))))
857 (eval `(Assert (or (> (log ,rf) (- (* ,i (log ,i)) ,i))
858 (eq +infinity (log ,rf))))))))
859 '(60 100 120 150 200 300 500 1000))
861 (eval `(Check-Error wrong-type-argument (factorial ,i))))
862 '(-1 -2 3/2 -3/2 1.5 -10.5 10.0))
864 ;; test congruency and divisibility
872 (17 . 2) (17 . 3) (17 . 4) (17 . 5) (17 . 7) (17 . 11)
873 (22 . 3) (22 . 13) (22 . 21) (22 . 23)
876 '((5 (16 . 1) (16 . 11) (17 . 2) (-17 . 3) (5 . 0))
877 (7 (16 . 2) (16 . 51) (51 . 16) (2 . 16) (-1 . 6))
878 (16 (4 . 20) (32 . 0) (-32 . 16) (16 . -32))))
880 '((5 (16 . -1) (16 . 2) (17 . 16) (16 . 17) (2 . -2))
881 (21 (7 . 21) (21 . 7) (3 . 23) (-3 . 19)))))
883 (mapc #'(lambda (val)
884 (eval `(Assert (divisiblep ,(car val) ,(cdr val)))))
886 (mapc #'(lambda (val)
887 (eval `(Assert (not (divisiblep ,(car val) ,(cdr val))))))
890 (mapc #'(lambda (val)
891 (let ((module (car val))
893 (mapc #'(lambda (cong)
895 (congruentp ,(car cong) ,(cdr cong)
899 (mapc #'(lambda (val)
900 (let ((module (car val))
902 (mapc #'(lambda (cong)
904 (not (congruentp ,(car cong) ,(cdr cong)
909 (when (featurep 'bigq)
911 (let ((sums '((1/2 2/3 7/6)
912 (1233211/2344321 10000/125897 25528682181/42163282991)
913 (12332112344321/2 1 12332112344323/2)
914 (1/3 12332112344321 36996337032964/3)
915 (10101/10101 101589/101589 2/1)
916 (-100/99 -50/51 -3350/1683)))
917 (prods '((2/3 3/4 1/2)
918 (1002004/2001 5/2 2505010/2001)
919 (-1002004/2001 5/2 -2505010/2001)))
922 (7/3 -16 43046721/33232930569601))))
923 (mapc #'(lambda (sum)
924 (eval `(Assert (= (+ ,(car sum) ,(cadr sum)) ,(caddr sum))))
925 (eval `(Assert (= (- ,(caddr sum) ,(cadr sum)) ,(car sum))))
926 (unless (bigqp (caddr sum))
927 (eval `(Assert (= (bigq (+ (bigq ,(car sum))
929 (bigq ,(caddr sum)))))
930 (eval `(Assert (= (bigq (- (bigq ,(caddr sum))
933 ;; testing triangle inequality
934 ;; | a + b | <= |a| + |b|
935 (eval `(Assert (<= (abs (+ ,(car sum) ,(cadr sum)))
936 (+ (abs ,(car sum)) (abs ,(cadr sum))))))))
938 (mapc #'(lambda (prod)
939 (eval `(Assert (= (* ,(car prod) ,(cadr prod)) ,(caddr prod))))
940 (eval `(Assert (= (/ ,(caddr prod) ,(cadr prod)) ,(car prod))))
941 (unless (bigqp (caddr prod))
942 (eval `(Assert (= (bigq (* (bigq ,(car prod))
943 (bigq ,(cadr prod))))
944 (bigq ,(caddr prod)))))
945 (eval `(Assert (= (bigq (/ (bigq ,(caddr prod))
946 (bigq ,(cadr prod))))
947 (bigq ,(car prod)))))
948 ;; testing multiplicativiy of abs
950 (eval `(Assert (= (abs (* ,(car prod) ,(cadr prod)))
951 (* (abs ,(car prod)) (abs ,(cadr prod))))))))
953 (mapc #'(lambda (pow)
954 (eval `(Assert (= (^ ,(car pow) ,(cadr pow)) ,(caddr pow))))
955 (eval `(Assert (= (bigq (^ (bigq ,(car pow))
957 (bigq ,(caddr pow))))))
962 (let ((one-arg-floor-list `((0 0)
967 (when (featurep 'bigz)
968 (setq one-arg-floor-list
969 (append one-arg-floor-list
970 `((,(factorial 20) ,(factorial 20))
971 (,(- (factorial 20)) ,(- (factorial 20)))))))
972 (when (featurep 'bigq)
973 (setq one-arg-floor-list
974 (append one-arg-floor-list
979 (when (featurep 'bigf)
980 (setq one-arg-floor-list
981 (append one-arg-floor-list
983 (,(bigf -7.4) -8)))))
984 (when (featurep 'bigfr)
985 (setq one-arg-floor-list
986 (append one-arg-floor-list
992 (mapc #'(lambda (arg-list)
993 (eval `(Assert (= (floor ,(car arg-list))
997 (let ((two-arg-floor-list `((0 1 0)
1002 (when (featurep 'bigz)
1003 (setq two-arg-floor-list
1004 (append two-arg-floor-list
1005 `((,(factorial 20) 100001 24328776793998)
1006 (,(- (factorial 20)) 100001 -24328776793999)))))
1007 (when (featurep 'bigq)
1008 (setq two-arg-floor-list
1009 (append two-arg-floor-list
1016 (when (featurep 'bigf)
1017 (setq two-arg-floor-list
1018 (append two-arg-floor-list
1021 (,(bigf 3880.5) 2 1940)
1022 (,(bigf -3880.5) 2 -1941)))))
1023 (when (featurep 'bigfr)
1024 (setq two-arg-floor-list
1025 (append two-arg-floor-list
1030 (,(exp 37) 37 316733577643313)))))
1032 (mapc #'(lambda (arg-list)
1033 (eval `(Assert (= (floor ,(car arg-list) ,(cadr arg-list))
1034 ,(caddr arg-list)))))
1035 two-arg-floor-list))
1038 ;;-----------------------------------------------------
1039 ;; Testing relations
1040 ;;-----------------------------------------------------
1041 (when (featurep 'ent)
1044 (and (featurep 'bigz)
1045 (add-to-list 'ones (coerce 1 'bigz))
1046 (add-to-list 'twos (coerce 2 'bigz)))
1047 (and (featurep 'bigq)
1048 (add-to-list 'ones 101/100)
1049 (add-to-list 'twos 202/100))
1050 (and (featurep 'bigf)
1051 (add-to-list 'ones (coerce 1.01 'bigf))
1052 (add-to-list 'twos (coerce 2.02 'bigf)))
1053 (and (featurep 'bigfr)
1054 (add-to-list 'ones (coerce 1.01 'bigfr))
1055 (add-to-list 'twos (coerce 2.02 'bigfr)))
1058 (eval `(Assert (< ,one ,two)))
1059 (eval `(Assert (<= ,one ,two)))
1060 (eval `(Assert (<= ,two ,two)))
1061 (eval `(Assert (> ,two ,one)))
1062 (eval `(Assert (>= ,two ,one)))
1063 (eval `(Assert (>= ,two ,two)))
1064 (eval `(Assert (/= ,one ,two)))
1065 (eval `(Assert (not (/= ,two ,two))))
1066 (eval `(Assert (not (< ,one ,one))))
1067 (eval `(Assert (not (> ,one ,one))))
1068 (eval `(Assert (<= ,one ,one ,two ,two)))
1069 (eval `(Assert (not (< ,one ,one ,two ,two))))
1070 (eval `(Assert (>= ,two ,two ,one ,one)))
1071 (eval `(Assert (not (> ,two ,two ,one ,one))))
1072 (eval `(Assert (= ,one ,one ,one)))
1073 (eval `(Assert (not (= ,one ,one ,one ,two))))
1074 (eval `(Assert (not (/= ,one ,two ,one))))
1076 (when (featurep 'bigc)
1077 ;; now check complexes, these are not comparable
1079 (eval `(Check-Error relation-error (< ,one 1+i)))
1080 (eval `(Check-Error relation-error (<= ,one 1+i)))
1081 (eval `(Check-Error relation-error (<= 1+i 1+i)))
1082 (eval `(Check-Error relation-error (> ,one 1+i)))
1083 (eval `(Check-Error relation-error (>= ,one 1+i)))
1084 (eval `(Check-Error relation-error (>= 1+i 1+i)))
1085 (eval `(Check-Error relation-error (not (/= ,one 1+i))))
1086 (eval `(Check-Error relation-error (= ,one 1+i)))
1089 ;;-----------------------------------------------------
1090 ;; Testing infinities
1091 ;;-----------------------------------------------------
1092 (Assert (boundp '+infinity))
1093 (Assert (boundp '-infinity))
1094 (Assert (boundp 'complex-infinity))
1095 (Assert (boundp 'not-a-number))
1097 (Assert (infinityp +infinity))
1098 (Assert (infinityp -infinity))
1099 (Assert (infinityp complex-infinity))
1100 (Assert (indefinitep +infinity))
1101 (Assert (indefinitep -infinity))
1102 (Assert (indefinitep complex-infinity))
1103 (Assert (indefinitep not-a-number))
1105 ;;; testing arithmetics with infinity symbols
1106 (let* ((ASSERT-EQUAL
1107 #'(lambda (form result)
1108 (eval `(Assert-Equal ,form ,result))))
1110 #'(lambda (form result)
1111 (eval `(Assert (= ,form ,result)))))
1113 #'(lambda (form result)
1114 (eval `(Check-Error wrong-type-argument (equal ,form ,result)))))
1116 #'(lambda (form result)
1117 (eval `(Check-Error relation-error (= ,form ,result)))))
1119 #'(lambda (form result)
1120 (funcall ASSERT-EQUAL form result)
1121 (funcall ASSERT-= form result)))
1123 #'(lambda (form result)
1124 (funcall ASSERT-EQUAL form result)
1125 (funcall ASSERT-=-nc form result)))
1126 (ASSERT-EQUAL-nc+=-nc
1127 #'(lambda (form result)
1128 (funcall ASSERT-EQUAL-nc form result)
1129 (funcall ASSERT-=-nc form result))))
1132 (funcall ASSERT-EQUAL+= '(+ 0 +infinity) '+infinity)
1133 (funcall ASSERT-EQUAL+= '(+ 1 +infinity) '+infinity)
1134 (funcall ASSERT-EQUAL+= '(+ -1 +infinity) '+infinity)
1135 (funcall ASSERT-EQUAL+= '(+ +infinity 0) '+infinity)
1136 (funcall ASSERT-EQUAL+= '(+ +infinity 1) '+infinity)
1137 (funcall ASSERT-EQUAL+= '(+ +infinity -1) '+infinity)
1138 (funcall ASSERT-EQUAL+= '(+ +infinity) '+infinity)
1139 (funcall ASSERT-EQUAL+= '(1+ +infinity) '+infinity)
1140 (funcall ASSERT-EQUAL+= '(+ +infinity +infinity) '+infinity)
1141 (funcall ASSERT-EQUAL+=-nc '(+ complex-infinity +infinity) 'not-a-number)
1142 (funcall ASSERT-EQUAL+=-nc '(+ -infinity +infinity) 'not-a-number)
1144 (funcall ASSERT-EQUAL+= '(+ 0 -infinity) '-infinity)
1145 (funcall ASSERT-EQUAL+= '(+ 1 -infinity) '-infinity)
1146 (funcall ASSERT-EQUAL+= '(+ -1 -infinity) '-infinity)
1147 (funcall ASSERT-EQUAL+= '(+ -infinity 0) '-infinity)
1148 (funcall ASSERT-EQUAL+= '(+ -infinity 1) '-infinity)
1149 (funcall ASSERT-EQUAL+= '(+ -infinity -1) '-infinity)
1150 (funcall ASSERT-EQUAL+=-nc '(+ -infinity +infinity) 'not-a-number)
1151 (funcall ASSERT-EQUAL+= '(+ -infinity) '-infinity)
1152 (funcall ASSERT-EQUAL+= '(1+ -infinity) '-infinity)
1153 (funcall ASSERT-EQUAL+=-nc '(+ +infinity -infinity) 'not-a-number)
1154 (funcall ASSERT-EQUAL+= '(+ -infinity -infinity) '-infinity)
1155 (funcall ASSERT-EQUAL+=-nc '(+ complex-infinity -infinity) 'not-a-number)
1157 (funcall ASSERT-EQUAL+= '(+ 0 complex-infinity) 'complex-infinity)
1158 (funcall ASSERT-EQUAL+= '(+ 1 complex-infinity) 'complex-infinity)
1159 (funcall ASSERT-EQUAL+= '(+ -1 complex-infinity) 'complex-infinity)
1160 (funcall ASSERT-EQUAL+= '(+ complex-infinity 0) 'complex-infinity)
1161 (funcall ASSERT-EQUAL+= '(+ complex-infinity 1) 'complex-infinity)
1162 (funcall ASSERT-EQUAL+= '(+ complex-infinity -1) 'complex-infinity)
1163 (funcall ASSERT-EQUAL+= '(+ complex-infinity) 'complex-infinity)
1164 (funcall ASSERT-EQUAL+= '(1+ complex-infinity) 'complex-infinity)
1165 (funcall ASSERT-EQUAL+=-nc '(+ +infinity complex-infinity) 'not-a-number)
1166 (funcall ASSERT-EQUAL+=-nc '(+ -infinity complex-infinity) 'not-a-number)
1167 (funcall ASSERT-EQUAL+=
1168 '(+ complex-infinity complex-infinity) complex-infinity)
1170 (funcall ASSERT-EQUAL+=-nc '(+ 0 not-a-number) 'not-a-number)
1171 (funcall ASSERT-EQUAL+=-nc '(+ 1 not-a-number) 'not-a-number)
1172 (funcall ASSERT-EQUAL+=-nc '(+ -1 not-a-number) 'not-a-number)
1173 (funcall ASSERT-EQUAL+=-nc '(+ not-a-number 0) 'not-a-number)
1174 (funcall ASSERT-EQUAL+=-nc '(+ not-a-number 1) 'not-a-number)
1175 (funcall ASSERT-EQUAL+=-nc '(+ not-a-number -1) 'not-a-number)
1176 (funcall ASSERT-EQUAL+=-nc '(+ not-a-number) 'not-a-number)
1177 (funcall ASSERT-EQUAL+=-nc '(1+ not-a-number) 'not-a-number)
1178 (funcall ASSERT-EQUAL+=-nc '(+ not-a-number +infinity) 'not-a-number)
1179 (funcall ASSERT-EQUAL+=-nc '(+ +infinity not-a-number) 'not-a-number)
1180 (funcall ASSERT-EQUAL+=-nc '(+ not-a-number -infinity) 'not-a-number)
1181 (funcall ASSERT-EQUAL+=-nc '(+ -infinity not-a-number) 'not-a-number)
1182 (funcall ASSERT-EQUAL+=-nc
1183 '(+ not-a-number complex-infinity) 'not-a-number)
1184 (funcall ASSERT-EQUAL+=-nc
1185 '(+ complex-infinity not-a-number) 'not-a-number)
1188 (funcall ASSERT-EQUAL+= '(- 0 +infinity) '-infinity)
1189 (funcall ASSERT-EQUAL+= '(- 1 +infinity) '-infinity)
1190 (funcall ASSERT-EQUAL+= '(- -1 +infinity) '-infinity)
1191 (funcall ASSERT-EQUAL+= '(- +infinity 0) '+infinity)
1192 (funcall ASSERT-EQUAL+= '(- +infinity 1) '+infinity)
1193 (funcall ASSERT-EQUAL+= '(- +infinity -1) '+infinity)
1194 (funcall ASSERT-EQUAL+= '(- +infinity) '-infinity)
1195 (funcall ASSERT-EQUAL+= '(1- +infinity) '+infinity)
1196 (funcall ASSERT-EQUAL+=-nc '(- +infinity +infinity) 'not-a-number)
1197 (funcall ASSERT-EQUAL+= '(- -infinity +infinity) '-infinity)
1198 (funcall ASSERT-EQUAL+=-nc '(- complex-infinity +infinity) 'not-a-number)
1200 (funcall ASSERT-EQUAL+= '(- 0 -infinity) '+infinity)
1201 (funcall ASSERT-EQUAL+= '(- 1 -infinity) '+infinity)
1202 (funcall ASSERT-EQUAL+= '(- -1 -infinity) '+infinity)
1203 (funcall ASSERT-EQUAL+= '(- -infinity 0) '-infinity)
1204 (funcall ASSERT-EQUAL+= '(- -infinity 1) '-infinity)
1205 (funcall ASSERT-EQUAL+= '(- -infinity -1) '-infinity)
1206 (funcall ASSERT-EQUAL+= '(- -infinity +infinity) '-infinity)
1207 (funcall ASSERT-EQUAL+= '(- -infinity) '+infinity)
1208 (funcall ASSERT-EQUAL+= '(1- -infinity) '-infinity)
1209 (funcall ASSERT-EQUAL+= '(- +infinity -infinity) '+infinity)
1210 (funcall ASSERT-EQUAL+=-nc '(- -infinity -infinity) 'not-a-number)
1211 (funcall ASSERT-EQUAL+=-nc '(- complex-infinity -infinity) 'not-a-number)
1213 (funcall ASSERT-EQUAL+= '(- 0 complex-infinity) 'complex-infinity)
1214 (funcall ASSERT-EQUAL+= '(- 1 complex-infinity) 'complex-infinity)
1215 (funcall ASSERT-EQUAL+= '(- -1 complex-infinity) 'complex-infinity)
1216 (funcall ASSERT-EQUAL+= '(- complex-infinity 0) 'complex-infinity)
1217 (funcall ASSERT-EQUAL+= '(- complex-infinity 1) 'complex-infinity)
1218 (funcall ASSERT-EQUAL+= '(- complex-infinity -1) 'complex-infinity)
1219 (funcall ASSERT-EQUAL+= '(- complex-infinity) 'complex-infinity)
1220 (funcall ASSERT-EQUAL+= '(1- complex-infinity) 'complex-infinity)
1221 (funcall ASSERT-EQUAL+=-nc '(- +infinity complex-infinity) 'not-a-number)
1222 (funcall ASSERT-EQUAL+=-nc '(- -infinity complex-infinity) 'not-a-number)
1223 (funcall ASSERT-EQUAL+=
1224 '(- complex-infinity complex-infinity) complex-infinity)
1226 (funcall ASSERT-EQUAL+=-nc '(- 0 not-a-number) 'not-a-number)
1227 (funcall ASSERT-EQUAL+=-nc '(- 1 not-a-number) 'not-a-number)
1228 (funcall ASSERT-EQUAL+=-nc '(- -1 not-a-number) 'not-a-number)
1229 (funcall ASSERT-EQUAL+=-nc '(- not-a-number 0) 'not-a-number)
1230 (funcall ASSERT-EQUAL+=-nc '(- not-a-number 1) 'not-a-number)
1231 (funcall ASSERT-EQUAL+=-nc '(- not-a-number -1) 'not-a-number)
1232 (funcall ASSERT-EQUAL+=-nc '(- not-a-number) 'not-a-number)
1233 (funcall ASSERT-EQUAL+=-nc '(1- not-a-number) 'not-a-number)
1234 (funcall ASSERT-EQUAL+=-nc '(- not-a-number +infinity) 'not-a-number)
1235 (funcall ASSERT-EQUAL+=-nc '(- +infinity not-a-number) 'not-a-number)
1236 (funcall ASSERT-EQUAL+=-nc '(- not-a-number -infinity) 'not-a-number)
1237 (funcall ASSERT-EQUAL+=-nc '(- -infinity not-a-number) 'not-a-number)
1238 (funcall ASSERT-EQUAL+=-nc
1239 '(- not-a-number complex-infinity) 'not-a-number)
1240 (funcall ASSERT-EQUAL+=-nc
1241 '(- complex-infinity not-a-number) 'not-a-number)
1244 (funcall ASSERT-EQUAL+=-nc '(* 0 +infinity) 'not-a-number)
1245 (funcall ASSERT-EQUAL+= '(* 1 +infinity) '+infinity)
1246 (funcall ASSERT-EQUAL+= '(* -1 +infinity) '-infinity)
1247 (funcall ASSERT-EQUAL+=-nc '(* +infinity 0) 'not-a-number)
1248 (funcall ASSERT-EQUAL+= '(* +infinity 1) '+infinity)
1249 (funcall ASSERT-EQUAL+= '(* +infinity -1) '-infinity)
1250 (funcall ASSERT-EQUAL+= '(* +infinity) '+infinity)
1251 (funcall ASSERT-EQUAL+= '(* +infinity +infinity) '+infinity)
1252 (funcall ASSERT-EQUAL+= '(* -infinity +infinity) '-infinity)
1253 (funcall ASSERT-EQUAL+= '(* complex-infinity +infinity) 'complex-infinity)
1255 (funcall ASSERT-EQUAL+=-nc '(* 0 -infinity) 'not-a-number)
1256 (funcall ASSERT-EQUAL+= '(* 1 -infinity) '-infinity)
1257 (funcall ASSERT-EQUAL+= '(* -1 -infinity) '+infinity)
1258 (funcall ASSERT-EQUAL+=-nc '(* -infinity 0) 'not-a-number)
1259 (funcall ASSERT-EQUAL+= '(* -infinity 1) '-infinity)
1260 (funcall ASSERT-EQUAL+= '(* -infinity -1) '+infinity)
1261 (funcall ASSERT-EQUAL+= '(* -infinity +infinity) '-infinity)
1262 (funcall ASSERT-EQUAL+= '(* -infinity) '-infinity)
1263 (funcall ASSERT-EQUAL+= '(* +infinity -infinity) '-infinity)
1264 (funcall ASSERT-EQUAL+= '(* -infinity -infinity) '+infinity)
1265 (funcall ASSERT-EQUAL+= '(* complex-infinity -infinity) 'complex-infinity)
1267 (funcall ASSERT-EQUAL+=-nc '(* 0 complex-infinity) 'not-a-number)
1268 (funcall ASSERT-EQUAL+= '(* 1 complex-infinity) 'complex-infinity)
1269 (funcall ASSERT-EQUAL+= '(* -1 complex-infinity) 'complex-infinity)
1270 (funcall ASSERT-EQUAL+=-nc '(* complex-infinity 0) 'not-a-number)
1271 (funcall ASSERT-EQUAL+= '(* complex-infinity 1) 'complex-infinity)
1272 (funcall ASSERT-EQUAL+= '(* complex-infinity -1) 'complex-infinity)
1273 (funcall ASSERT-EQUAL+= '(* complex-infinity +infinity) 'complex-infinity)
1274 (funcall ASSERT-EQUAL+= '(* complex-infinity) 'complex-infinity)
1275 (funcall ASSERT-EQUAL+= '(* +infinity complex-infinity) 'complex-infinity)
1276 (funcall ASSERT-EQUAL+= '(* -infinity complex-infinity) 'complex-infinity)
1277 (funcall ASSERT-EQUAL+=
1278 '(* complex-infinity complex-infinity) complex-infinity)
1280 (funcall ASSERT-EQUAL+=-nc '(* 0 not-a-number) 'not-a-number)
1281 (funcall ASSERT-EQUAL+=-nc '(* 1 not-a-number) 'not-a-number)
1282 (funcall ASSERT-EQUAL+=-nc '(* -1 not-a-number) 'not-a-number)
1283 (funcall ASSERT-EQUAL+=-nc '(* not-a-number 0) 'not-a-number)
1284 (funcall ASSERT-EQUAL+=-nc '(* not-a-number 1) 'not-a-number)
1285 (funcall ASSERT-EQUAL+=-nc '(* not-a-number -1) 'not-a-number)
1286 (funcall ASSERT-EQUAL+=-nc '(* not-a-number) 'not-a-number)
1287 (funcall ASSERT-EQUAL+=-nc '(* not-a-number +infinity) 'not-a-number)
1288 (funcall ASSERT-EQUAL+=-nc '(* +infinity not-a-number) 'not-a-number)
1289 (funcall ASSERT-EQUAL+=-nc '(* not-a-number -infinity) 'not-a-number)
1290 (funcall ASSERT-EQUAL+=-nc '(* -infinity not-a-number) 'not-a-number)
1291 (funcall ASSERT-EQUAL+=-nc
1292 '(* not-a-number complex-infinity) 'not-a-number)
1293 (funcall ASSERT-EQUAL+=-nc
1294 '(* complex-infinity not-a-number) 'not-a-number)
1297 (funcall ASSERT-EQUAL+= '(/ 0 +infinity) 0)
1298 (funcall ASSERT-EQUAL+= '(/ 1 +infinity) 0)
1299 (funcall ASSERT-EQUAL+= '(/ -1 +infinity) 0)
1300 (funcall ASSERT-EQUAL+=-nc '(/ +infinity 0) 'not-a-number)
1301 (funcall ASSERT-EQUAL+= '(/ +infinity 1) '+infinity)
1302 (funcall ASSERT-EQUAL+= '(/ +infinity -1) '-infinity)
1303 (funcall ASSERT-EQUAL+= '(/ +infinity) 0)
1304 (funcall ASSERT-EQUAL+=-nc '(/ +infinity +infinity) 'not-a-number)
1305 (funcall ASSERT-EQUAL+=-nc '(/ -infinity +infinity) 'not-a-number)
1306 (funcall ASSERT-EQUAL+= '(/ complex-infinity +infinity) 'complex-infinity)
1308 (funcall ASSERT-EQUAL+= '(/ 0 -infinity) 0)
1309 (funcall ASSERT-EQUAL+= '(/ 1 -infinity) 0)
1310 (funcall ASSERT-EQUAL+= '(/ -1 -infinity) 0)
1311 (funcall ASSERT-EQUAL+=-nc '(/ -infinity 0) 'not-a-number)
1312 (funcall ASSERT-EQUAL+= '(/ -infinity 1) '-infinity)
1313 (funcall ASSERT-EQUAL+= '(/ -infinity -1) '+infinity)
1314 (funcall ASSERT-EQUAL+=-nc '(/ -infinity +infinity) 'not-a-number)
1315 (funcall ASSERT-EQUAL+= '(/ -infinity) 0)
1316 (funcall ASSERT-EQUAL+=-nc '(/ +infinity -infinity) 'not-a-number)
1317 (funcall ASSERT-EQUAL+=-nc '(/ -infinity -infinity) 'not-a-number)
1318 (funcall ASSERT-EQUAL+= '(/ complex-infinity -infinity) 'complex-infinity)
1320 (funcall ASSERT-EQUAL+= '(/ 0 complex-infinity) 'complex-infinity)
1321 (funcall ASSERT-EQUAL+= '(/ 1 complex-infinity) 'complex-infinity)
1322 (funcall ASSERT-EQUAL+= '(/ -1 complex-infinity) 'complex-infinity)
1323 (funcall ASSERT-EQUAL+=-nc '(/ complex-infinity 0) 'not-a-number)
1324 (funcall ASSERT-EQUAL+= '(/ complex-infinity 1) 'complex-infinity)
1325 (funcall ASSERT-EQUAL+= '(/ complex-infinity -1) 'complex-infinity)
1326 (funcall ASSERT-EQUAL+= '(/ complex-infinity +infinity) 'complex-infinity)
1327 (funcall ASSERT-EQUAL+= '(/ complex-infinity) 'complex-infinity)
1328 (funcall ASSERT-EQUAL+= '(/ +infinity complex-infinity) 'complex-infinity)
1329 (funcall ASSERT-EQUAL+= '(/ -infinity complex-infinity) 'complex-infinity)
1330 (funcall ASSERT-EQUAL+=
1331 '(/ complex-infinity complex-infinity) complex-infinity)
1333 (funcall ASSERT-EQUAL+=-nc '(/ 0 not-a-number) 'not-a-number)
1334 (funcall ASSERT-EQUAL+=-nc '(/ 1 not-a-number) 'not-a-number)
1335 (funcall ASSERT-EQUAL+=-nc '(/ -1 not-a-number) 'not-a-number)
1336 (funcall ASSERT-EQUAL+=-nc '(/ not-a-number 0) 'not-a-number)
1337 (funcall ASSERT-EQUAL+=-nc '(/ not-a-number 1) 'not-a-number)
1338 (funcall ASSERT-EQUAL+=-nc '(/ not-a-number -1) 'not-a-number)
1339 (funcall ASSERT-EQUAL+=-nc '(/ not-a-number) 'not-a-number)
1340 (funcall ASSERT-EQUAL+=-nc '(/ not-a-number +infinity) 'not-a-number)
1341 (funcall ASSERT-EQUAL+=-nc '(/ +infinity not-a-number) 'not-a-number)
1342 (funcall ASSERT-EQUAL+=-nc '(/ not-a-number -infinity) 'not-a-number)
1343 (funcall ASSERT-EQUAL+=-nc '(/ -infinity not-a-number) 'not-a-number)
1344 (funcall ASSERT-EQUAL+=-nc
1345 '(/ not-a-number complex-infinity) 'not-a-number)
1346 (funcall ASSERT-EQUAL+=-nc
1347 '(/ complex-infinity not-a-number) 'not-a-number)
1350 (funcall ASSERT-EQUAL+= '(// 0 +infinity) 0)
1351 (funcall ASSERT-EQUAL+= '(// 1 +infinity) 0)
1352 (funcall ASSERT-EQUAL+= '(// -1 +infinity) 0)
1353 (funcall ASSERT-EQUAL+=-nc '(// +infinity 0) 'not-a-number)
1354 (funcall ASSERT-EQUAL+= '(// +infinity 1) '+infinity)
1355 (funcall ASSERT-EQUAL+= '(// +infinity -1) '-infinity)
1356 (funcall ASSERT-EQUAL+= '(// +infinity) 0)
1357 (funcall ASSERT-EQUAL+=-nc '(// +infinity +infinity) 'not-a-number)
1358 (funcall ASSERT-EQUAL+=-nc '(// -infinity +infinity) 'not-a-number)
1359 (funcall ASSERT-EQUAL+= '(// complex-infinity +infinity) 'complex-infinity)
1361 (funcall ASSERT-EQUAL+= '(// 0 -infinity) 0)
1362 (funcall ASSERT-EQUAL+= '(// 1 -infinity) 0)
1363 (funcall ASSERT-EQUAL+= '(// -1 -infinity) 0)
1364 (funcall ASSERT-EQUAL+=-nc '(// -infinity 0) 'not-a-number)
1365 (funcall ASSERT-EQUAL+= '(// -infinity 1) '-infinity)
1366 (funcall ASSERT-EQUAL+= '(// -infinity -1) '+infinity)
1367 (funcall ASSERT-EQUAL+=-nc '(// -infinity +infinity) 'not-a-number)
1368 (funcall ASSERT-EQUAL+= '(// -infinity) 0)
1369 (funcall ASSERT-EQUAL+=-nc '(// +infinity -infinity) 'not-a-number)
1370 (funcall ASSERT-EQUAL+=-nc '(// -infinity -infinity) 'not-a-number)
1371 (funcall ASSERT-EQUAL+= '(// complex-infinity -infinity) 'complex-infinity)
1373 (funcall ASSERT-EQUAL+= '(// 0 complex-infinity) 'complex-infinity)
1374 (funcall ASSERT-EQUAL+= '(// 1 complex-infinity) 'complex-infinity)
1375 (funcall ASSERT-EQUAL+= '(// -1 complex-infinity) 'complex-infinity)
1376 (funcall ASSERT-EQUAL+=-nc '(// complex-infinity 0) 'not-a-number)
1377 (funcall ASSERT-EQUAL+= '(// complex-infinity 1) 'complex-infinity)
1378 (funcall ASSERT-EQUAL+= '(// complex-infinity -1) 'complex-infinity)
1379 (funcall ASSERT-EQUAL+= '(// complex-infinity +infinity) 'complex-infinity)
1380 (funcall ASSERT-EQUAL+= '(// complex-infinity) 'complex-infinity)
1381 (funcall ASSERT-EQUAL+= '(// +infinity complex-infinity) 'complex-infinity)
1382 (funcall ASSERT-EQUAL+= '(// -infinity complex-infinity) 'complex-infinity)
1383 (funcall ASSERT-EQUAL+=
1384 '(// complex-infinity complex-infinity) complex-infinity)
1386 (funcall ASSERT-EQUAL+=-nc '(// 0 not-a-number) 'not-a-number)
1387 (funcall ASSERT-EQUAL+=-nc '(// 1 not-a-number) 'not-a-number)
1388 (funcall ASSERT-EQUAL+=-nc '(// -1 not-a-number) 'not-a-number)
1389 (funcall ASSERT-EQUAL+=-nc '(// not-a-number 0) 'not-a-number)
1390 (funcall ASSERT-EQUAL+=-nc '(// not-a-number 1) 'not-a-number)
1391 (funcall ASSERT-EQUAL+=-nc '(// not-a-number -1) 'not-a-number)
1392 (funcall ASSERT-EQUAL+=-nc '(// not-a-number) 'not-a-number)
1393 (funcall ASSERT-EQUAL+=-nc '(// not-a-number +infinity) 'not-a-number)
1394 (funcall ASSERT-EQUAL+=-nc '(// +infinity not-a-number) 'not-a-number)
1395 (funcall ASSERT-EQUAL+=-nc '(// not-a-number -infinity) 'not-a-number)
1396 (funcall ASSERT-EQUAL+=-nc '(// -infinity not-a-number) 'not-a-number)
1397 (funcall ASSERT-EQUAL+=-nc
1398 '(// not-a-number complex-infinity) 'not-a-number)
1399 (funcall ASSERT-EQUAL+=-nc
1400 '(// complex-infinity not-a-number) 'not-a-number)
1402 ;; reduction modulo number
1403 (funcall ASSERT-EQUAL+= '(% 0 +infinity) 0)
1404 (funcall ASSERT-EQUAL+= '(% 1 +infinity) 1)
1405 (funcall ASSERT-EQUAL+= '(% -1 +infinity) -1)
1406 (funcall ASSERT-EQUAL+=-nc '(% +infinity 0) 'not-a-number)
1407 (funcall ASSERT-EQUAL+=-nc '(% +infinity 1) 'not-a-number)
1408 (funcall ASSERT-EQUAL+=-nc '(% +infinity -1) 'not-a-number)
1409 (funcall ASSERT-EQUAL+= '(% +infinity +infinity) '+infinity)
1410 (funcall ASSERT-EQUAL+= '(% -infinity +infinity) '-infinity)
1411 (funcall ASSERT-EQUAL+= '(% complex-infinity +infinity) 'complex-infinity)
1413 (funcall ASSERT-EQUAL+= '(% 0 -infinity) '0)
1414 (funcall ASSERT-EQUAL+= '(% 1 -infinity) '1)
1415 (funcall ASSERT-EQUAL+= '(% -1 -infinity) '-1)
1416 (funcall ASSERT-EQUAL+=-nc '(% -infinity 0) 'not-a-number)
1417 (funcall ASSERT-EQUAL+=-nc '(% -infinity 1) 'not-a-number)
1418 (funcall ASSERT-EQUAL+=-nc '(% -infinity -1) 'not-a-number)
1419 (funcall ASSERT-EQUAL+= '(% -infinity +infinity) '-infinity)
1420 (funcall ASSERT-EQUAL+= '(% +infinity -infinity) '-infinity)
1421 (funcall ASSERT-EQUAL+= '(% -infinity -infinity) '+infinity)
1422 (funcall ASSERT-EQUAL+= '(% complex-infinity -infinity) 'complex-infinity)
1424 (funcall ASSERT-EQUAL+= '(% 0 complex-infinity) '0)
1425 (funcall ASSERT-EQUAL+= '(% 1 complex-infinity) '1)
1426 (funcall ASSERT-EQUAL+= '(% -1 complex-infinity) '-1)
1427 (funcall ASSERT-EQUAL+=-nc '(% complex-infinity 0) 'not-a-number)
1428 (funcall ASSERT-EQUAL+=-nc '(% complex-infinity 1) 'not-a-number)
1429 (funcall ASSERT-EQUAL+=-nc '(% complex-infinity -1) 'not-a-number)
1430 (funcall ASSERT-EQUAL+= '(% complex-infinity +infinity) 'complex-infinity)
1431 (funcall ASSERT-EQUAL+= '(% +infinity complex-infinity) 'complex-infinity)
1432 (funcall ASSERT-EQUAL+= '(% -infinity complex-infinity) 'complex-infinity)
1433 (funcall ASSERT-EQUAL+=
1434 '(% complex-infinity complex-infinity) complex-infinity)
1436 (funcall ASSERT-EQUAL+=-nc '(% 0 not-a-number) 'not-a-number)
1437 (funcall ASSERT-EQUAL+=-nc '(% 1 not-a-number) 'not-a-number)
1438 (funcall ASSERT-EQUAL+=-nc '(% -1 not-a-number) 'not-a-number)
1439 (funcall ASSERT-EQUAL+=-nc '(% not-a-number 0) 'not-a-number)
1440 (funcall ASSERT-EQUAL+=-nc '(% not-a-number 1) 'not-a-number)
1441 (funcall ASSERT-EQUAL+=-nc '(% not-a-number -1) 'not-a-number)
1442 (funcall ASSERT-EQUAL+=-nc '(% not-a-number +infinity) 'not-a-number)
1443 (funcall ASSERT-EQUAL+=-nc '(% +infinity not-a-number) 'not-a-number)
1444 (funcall ASSERT-EQUAL+=-nc '(% not-a-number -infinity) 'not-a-number)
1445 (funcall ASSERT-EQUAL+=-nc '(% -infinity not-a-number) 'not-a-number)
1446 (funcall ASSERT-EQUAL+=-nc
1447 '(% not-a-number complex-infinity) 'not-a-number)
1448 (funcall ASSERT-EQUAL+=-nc
1449 '(% complex-infinity not-a-number) 'not-a-number)
1452 (funcall ASSERT-EQUAL+= '(^ 0 +infinity) 0)
1453 (funcall ASSERT-EQUAL+= '(^ 1 +infinity) 1)
1454 (funcall ASSERT-EQUAL+= '(^ 2 +infinity) +infinity)
1455 (funcall ASSERT-EQUAL+= '(2^ +infinity) +infinity)
1456 (funcall ASSERT-EQUAL+= '(^ 10 +infinity) +infinity)
1457 (funcall ASSERT-EQUAL+= '(10^ +infinity) +infinity)
1458 (funcall ASSERT-EQUAL+=-nc '(^ -1 +infinity) 'not-a-number)
1459 (funcall ASSERT-EQUAL+=-nc '(^ +infinity 0) 'not-a-number)
1460 (funcall ASSERT-EQUAL+= '(^ +infinity 1) '+infinity)
1461 (funcall ASSERT-EQUAL+= '(^ +infinity 2) '+infinity)
1462 (funcall ASSERT-EQUAL+= '(^ +infinity -1) 0)
1463 (funcall ASSERT-EQUAL+= '(^-1 +infinity) 0)
1464 (funcall ASSERT-EQUAL+= '(^ +infinity -2) 0)
1465 (funcall ASSERT-EQUAL+=-nc '(^ +infinity +infinity) 'not-a-number)
1466 (funcall ASSERT-EQUAL+=-nc '(^ -infinity +infinity) 'not-a-number)
1467 (funcall ASSERT-EQUAL+= '(^ complex-infinity +infinity) 'complex-infinity)
1469 (funcall ASSERT-EQUAL+= '(^ 0 -infinity) 0)
1470 (funcall ASSERT-EQUAL+= '(^ 1 -infinity) 1)
1471 (funcall ASSERT-EQUAL+= '(^ 2 -infinity) 0)
1472 (funcall ASSERT-EQUAL+= '(2^ -infinity) 0)
1473 (funcall ASSERT-EQUAL+= '(^ 10 -infinity) 0)
1474 (funcall ASSERT-EQUAL+= '(10^ -infinity) 0)
1475 (funcall ASSERT-EQUAL+=-nc '(^ -1 -infinity) 'not-a-number)
1476 (funcall ASSERT-EQUAL+=-nc '(^ -infinity 0) 'not-a-number)
1477 (funcall ASSERT-EQUAL+= '(^ -infinity 1) '-infinity)
1478 (funcall ASSERT-EQUAL+= '(^ -infinity 2) '+infinity)
1479 (funcall ASSERT-EQUAL+= '(^ -infinity -1) 0)
1480 (funcall ASSERT-EQUAL+= '(^-1 -infinity) 0)
1481 (funcall ASSERT-EQUAL+= '(^ -infinity -2) 0)
1482 (funcall ASSERT-EQUAL+=-nc '(^ +infinity -infinity) 'not-a-number)
1483 (funcall ASSERT-EQUAL+=-nc '(^ -infinity -infinity) 'not-a-number)
1484 (funcall ASSERT-EQUAL+= '(^ complex-infinity -infinity) 'complex-infinity)
1486 (funcall ASSERT-EQUAL+= '(^ 0 complex-infinity) 'complex-infinity)
1487 (funcall ASSERT-EQUAL+= '(^ 1 complex-infinity) 'complex-infinity)
1488 (funcall ASSERT-EQUAL+= '(^ -1 complex-infinity) 'complex-infinity)
1489 (funcall ASSERT-EQUAL+=-nc '(^ complex-infinity 0) 'not-a-number)
1490 (funcall ASSERT-EQUAL+= '(^ complex-infinity 1) 'complex-infinity)
1491 (funcall ASSERT-EQUAL+= '(^ complex-infinity -1) 'complex-infinity)
1492 (funcall ASSERT-EQUAL+= '(^ complex-infinity +infinity) 'complex-infinity)
1493 (funcall ASSERT-EQUAL+= '(^ +infinity complex-infinity) 'complex-infinity)
1494 (funcall ASSERT-EQUAL+= '(^ -infinity complex-infinity) 'complex-infinity)
1495 (funcall ASSERT-EQUAL+=
1496 '(^ complex-infinity complex-infinity) complex-infinity)
1498 (funcall ASSERT-EQUAL+=-nc '(^ 0 not-a-number) 'not-a-number)
1499 (funcall ASSERT-EQUAL+=-nc '(^ 1 not-a-number) 'not-a-number)
1500 (funcall ASSERT-EQUAL+=-nc '(^ -1 not-a-number) 'not-a-number)
1501 (funcall ASSERT-EQUAL+=-nc '(^ not-a-number 0) 'not-a-number)
1502 (funcall ASSERT-EQUAL+=-nc '(^ not-a-number 1) 'not-a-number)
1503 (funcall ASSERT-EQUAL+=-nc '(^ not-a-number -1) 'not-a-number)
1504 (funcall ASSERT-EQUAL+=-nc '(^ not-a-number +infinity) 'not-a-number)
1505 (funcall ASSERT-EQUAL+=-nc '(^ +infinity not-a-number) 'not-a-number)
1506 (funcall ASSERT-EQUAL+=-nc '(^ not-a-number -infinity) 'not-a-number)
1507 (funcall ASSERT-EQUAL+=-nc '(^ -infinity not-a-number) 'not-a-number)
1508 (funcall ASSERT-EQUAL+=-nc
1509 '(^ not-a-number complex-infinity) 'not-a-number)
1510 (funcall ASSERT-EQUAL+=-nc
1511 '(^ complex-infinity not-a-number) 'not-a-number)
1514 ;; testing order of numbers and infinities
1515 (Assert (/= -1 +infinity))
1516 (Assert (not (= -1 +infinity)))
1517 (Assert (< -1 +infinity))
1518 (Assert (not (> -1 +infinity)))
1519 (Assert (<= -1 +infinity))
1520 (Assert (not (>= -1 +infinity)))
1521 (Assert (/= +infinity -1))
1522 (Assert (not (= +infinity -1)))
1523 (Assert (not (< +infinity -1)))
1524 (Assert (> +infinity -1))
1525 (Assert (not (<= +infinity -1)))
1526 (Assert (>= +infinity -1))
1527 (Assert (< +infinity +infinity))
1528 (Assert (> +infinity +infinity))
1529 (Assert (= +infinity +infinity))
1530 (Assert (<= +infinity +infinity))
1531 (Assert (>= +infinity +infinity))
1533 (Assert (/= -1 -infinity))
1534 (Assert (not (= -1 -infinity)))
1535 (Assert (not (< -1 -infinity)))
1536 (Assert (> -1 -infinity))
1537 (Assert (not (<= -1 -infinity)))
1538 (Assert (>= -1 -infinity))
1539 (Assert (/= -infinity -1))
1540 (Assert (not (= -infinity -1)))
1541 (Assert (< -infinity -1))
1542 (Assert (not (> -infinity -1)))
1543 (Assert (<= -infinity -1))
1544 (Assert (not (>= -infinity -1)))
1545 (Assert (< -infinity -infinity))
1546 (Assert (> -infinity -infinity))
1547 (Assert (= -infinity -infinity))
1548 (Assert (<= -infinity -infinity))
1549 (Assert (>= -infinity -infinity))
1551 (Assert (/= -infinity +infinity))
1552 (Assert (not (= -infinity +infinity)))
1553 (Assert (< -infinity -1 +infinity))
1554 (Assert (not (> -infinity -1 +infinity)))
1555 (Assert (not (> -1 -infinity +infinity)))
1556 (Assert (<= -infinity -1 +infinity))
1557 (Assert (not (>= -infinity -1 +infinity)))
1558 (Assert (not (< +infinity -1 -infinity)))
1559 (Assert (> +infinity -1 -infinity))
1560 (Assert (not (<= +infinity -1 -infinity)))
1561 (Assert (>= +infinity -1 -infinity))
1562 (Assert (< -infinity -infinity -2 -1 0 +infinity +infinity))
1563 (Assert (> +infinity +infinity 2 1 0 -infinity -infinity))
1564 (Assert (<= -infinity -infinity -2 -1 0 +infinity +infinity))
1565 (Assert (>= +infinity +infinity 2 1 0 -infinity -infinity))
1567 (Check-Error relation-error (< 0 complex-infinity))
1568 (Check-Error relation-error (= 0 complex-infinity))
1569 (Check-Error relation-error (/= 0 complex-infinity))
1570 (Check-Error relation-error (> 0 complex-infinity))
1571 (Check-Error relation-error (<= 0 complex-infinity))
1572 (Check-Error relation-error (>= 0 complex-infinity))
1573 (Check-Error relation-error (< complex-infinity 0))
1574 (Check-Error relation-error (= complex-infinity 0))
1575 (Check-Error relation-error (/= complex-infinity 0))
1576 (Check-Error relation-error (> complex-infinity 0))
1577 (Check-Error relation-error (<= complex-infinity 0))
1578 (Check-Error relation-error (>= complex-infinity 0))
1580 (Check-Error relation-error (< 0 not-a-number))
1581 (Check-Error relation-error (< +infinity not-a-number))
1582 (Check-Error relation-error (< not-a-number not-a-number))
1583 (Check-Error relation-error (< complex-infinity not-a-number))
1584 (Check-Error relation-error (= 0 not-a-number))
1585 (Check-Error relation-error (= +infinity not-a-number))
1586 (Check-Error relation-error (= complex-infinity not-a-number))
1587 (Check-Error relation-error (= not-a-number not-a-number))
1588 (Check-Error relation-error (/= 0 not-a-number))
1589 (Check-Error relation-error (/= +infinity not-a-number))
1590 (Check-Error relation-error (/= complex-infinity not-a-number))
1591 (Check-Error relation-error (/= not-a-number not-a-number))
1592 (Check-Error relation-error (> 0 not-a-number))
1593 (Check-Error relation-error (> +infinity not-a-number))
1594 (Check-Error relation-error (> complex-infinity not-a-number))
1595 (Check-Error relation-error (> not-a-number not-a-number))
1596 (Check-Error relation-error (<= 0 not-a-number))
1597 (Check-Error relation-error (<= +infinity not-a-number))
1598 (Check-Error relation-error (<= complex-infinity not-a-number))
1599 (Check-Error relation-error (<= not-a-number not-a-number))
1600 (Check-Error relation-error (>= 0 not-a-number))
1601 (Check-Error relation-error (>= +infinity not-a-number))
1602 (Check-Error relation-error (>= complex-infinity not-a-number))
1603 (Check-Error relation-error (>= not-a-number not-a-number))
1604 (Check-Error relation-error (< not-a-number 0))
1605 (Check-Error relation-error (< not-a-number +infinity))
1606 (Check-Error relation-error (< not-a-number complex-infinity))
1607 (Check-Error relation-error (< not-a-number 0 not-a-number))
1608 (Check-Error relation-error (= not-a-number 0))
1609 (Check-Error relation-error (= not-a-number +infinity))
1610 (Check-Error relation-error (= not-a-number complex-infinity))
1611 (Check-Error relation-error (= not-a-number 0 not-a-number))
1612 (Check-Error relation-error (/= not-a-number 0))
1613 (Check-Error relation-error (/= not-a-number +infinity))
1614 (Check-Error relation-error (/= not-a-number complex-infinity))
1615 (Check-Error relation-error (/= not-a-number 0 not-a-number))
1616 (Check-Error relation-error (> not-a-number 0))
1617 (Check-Error relation-error (> not-a-number +infinity))
1618 (Check-Error relation-error (> not-a-number complex-infinity))
1619 (Check-Error relation-error (> not-a-number 0 not-a-number))
1620 (Check-Error relation-error (<= not-a-number 0))
1621 (Check-Error relation-error (<= not-a-number +infinity))
1622 (Check-Error relation-error (<= not-a-number complex-infinity))
1623 (Check-Error relation-error (<= not-a-number 0 not-a-number))
1624 (Check-Error relation-error (>= not-a-number 0))
1625 (Check-Error relation-error (>= not-a-number +infinity))
1626 (Check-Error relation-error (>= not-a-number complex-infinity))
1627 (Check-Error relation-error (>= not-a-number 0 not-a-number))
1630 ;; testing predicates on infinities
1631 (let ((npreds '(zerop intp bigzp integerp bigqp rationalp floatp
1632 bigfp bigfrp realp biggp bigcp
1633 consp stringp arrayp evenp oddp primep))
1634 (comp-inf-preds '(comparablep))
1635 (inf-preds '(atom numberp infinityp archimedeanp))
1637 (nvals '(+infinity -infinity complex-infinity not-a-number))
1638 (comp-inf-vals '(+infinity -infinity))
1639 (inf-vals '(+infinity -infinity complex-infinity)))
1640 (mapc #'(lambda (pred)
1642 (mapc #'(lambda (val)
1643 (eval `(Assert (not (,pred ,val)))))
1646 (mapc #'(lambda (pred)
1647 (mapc #'(lambda (val)
1648 (eval `(Assert (,pred ,val))))
1651 (mapc #'(lambda (pred)
1652 (mapc #'(lambda (val)
1653 (eval `(Assert (,pred ,val))))
1662 (coerce-number 0 type)
1664 '(int bigz integer bigq rational bigf bigfr float real
1668 (eval `(Assert (zerop (coerce-number 0 ',type))))
1669 (eval `(Assert (onep (coerce-number 1 ',type))))
1670 (eval `(Assert (zerop (coerce-number 0.0 ',type))))
1671 (eval `(Assert (onep (coerce-number 1.0 ',type))))
1673 ;; lifts are idempotent
1674 (eval `(Assert-Equal
1675 (coerce-number 0 ',type)
1676 (coerce-number (coerce-number 0 ',type) ',type)))
1677 (eval `(Assert-Equal
1678 (coerce-number 1 ',type)
1679 (coerce-number (coerce-number 1 ',type) ',type)))
1680 (eval `(Assert (= (coerce-number 0 ',type)
1681 (coerce-number (coerce-number 0 ',type) ',type))))
1682 (eval `(Assert (= (coerce-number 1 ',type)
1683 (coerce-number (coerce-number 1 ',type) ',type))))
1684 ;; lifts are homomorphic wrt negation (equal'ity needs not hold)
1685 (eval `(Assert (= (coerce-number -1 ',type)
1686 (- (coerce-number 1 ',type)))))
1689 (eval `(Assert (indefinitep (coerce-number +infinity ',type))))
1690 (eval `(Assert (indefinitep (coerce-number -infinity ',type))))
1691 (eval `(Assert (infinityp (coerce-number +infinity ',type))))
1692 (eval `(Assert (infinityp (coerce-number -infinity ',type))))
1693 (eval `(Assert (= +infinity (coerce-number +infinity ',type))))
1694 (eval `(Assert (= -infinity (coerce-number -infinity ',type))))
1695 (if (comparablep (coerce-number 0 type))
1696 (eval `(Check-Error domain-error
1697 (coerce-number complex-infinity ',type)))
1698 (eval `(Assert (infinityp
1699 (coerce-number complex-infinity ',type))))
1700 (eval `(Assert (= complex-infinity
1701 (coerce-number complex-infinity ',type)))))
1702 (eval `(Check-Error domain-error
1703 (coerce-number not-a-number ',type))))
1706 ;; testing string conversion
1707 (Assert (string= (number-to-string +infinity) "+infinity"))
1708 (Assert (string= (number-to-string -infinity) "-infinity"))
1709 (Assert (string= (number-to-string complex-infinity) "complex-infinity"))
1710 (Check-Error wrong-type-argument (number-to-string not-a-number))
1712 (when (featurep 'bigfr)
1713 ;; test computations which throw out an indefinite
1714 (Assert (indefinitep (log 0)))
1715 (Assert (infinityp (log 0)))
1716 (Assert (indefinitep (log -1)))
1717 (Assert (indefinitep (log10 0)))
1718 (Assert (infinityp (log10 0)))
1719 (Assert (indefinitep (log10 -1)))
1720 (Assert (indefinitep (log2 0)))
1721 (Assert (infinityp (log2 0)))
1722 (Assert (indefinitep (log2 -1)))
1723 (Assert (or (indefinitep (sqrt -2))
1724 (complexp (sqrt -2))))
1725 ;; especially assert that these throws are not bigfr
1726 (Assert (not (bigfrp (log 0))))
1727 (Assert (not (bigfrp (log -1))))
1728 (Assert (not (bigfrp (log10 0))))
1729 (Assert (not (bigfrp (log10 -1))))
1730 (Assert (not (bigfrp (log2 0))))
1731 (Assert (not (bigfrp (log2 -1))))
1732 (Assert (not (bigfrp (sqrt -2)))))
1734 ;; stress test for trig functions
1735 (let ((nan-funs '(acos asin atan cos sin tan sec csc cot
1736 cosh sinh tanh sech csch coth
1738 erf erfc log-gamma))
1739 (more-funs '(abs sqrt cbrt log log10 log2
1740 ceiling truncate round
1741 ffloor fceiling ftruncate fround
1743 canonical-norm conjugate real-part))
1744 (vals '(+infinity -infinity complex-infinity not-a-number)))
1745 (mapc #'(lambda (fun)
1747 (mapc #'(lambda (val)
1748 (eval `(Assert-Equal (,fun ,val) not-a-number)))
1751 (mapc #'(lambda (fun)
1753 (mapc #'(lambda (val)
1754 (eval `(Assert (indefinitep (,fun ,val)))))
1759 (when (or (featurep 'bigg)
1761 (Assert (zerop (imaginary-part +infinity)))
1762 (Assert (zerop (imaginary-part -infinity)))
1763 (Assert (infinityp (imaginary-part complex-infinity))))
1764 (Assert (zerop (exp -infinity)))
1765 ;; logb cannot handle infinity, this might change in the future
1766 ;; same for logand, logior, logxor and lognot
1767 (mapc #'(lambda (fun)
1768 (mapc #'(lambda (val)
1769 (eval `(Check-Error wrong-type-argument (,fun ,val))))
1772 logand logior logxor lognot)))
1775 (when (featurep 'bigz)
1776 ;; test remove-factor with infinities
1778 (eval `(Assert (consp (remove-factor +infinity ,i))))
1779 (if (infinityp (eval i))
1780 (eval `(Assert (infinityp (cdr (remove-factor +infinity ,i)))))
1781 (eval `(Assert (zerop (cdr (remove-factor +infinity ,i))))))
1782 (eval `(Assert (= (car (remove-factor +infinity ,i)) ,i)))
1783 (eval `(Check-Error wrong-type-argument
1784 (remove-factor -infinity ,i))))
1785 '(0 1 2 3 4 10 20 50 100 200 -200 -100 -50 -20 -10 -4 -1 +infinity))
1787 (eval `(Assert (consp (remove-factor ,i +infinity))))
1788 (eval `(Assert (infinityp (cdr (remove-factor ,i +infinity)))))
1789 (eval `(Assert (infinityp (car (remove-factor ,i +infinity)))))
1790 (eval `(Assert (consp (remove-factor ,i -infinity))))
1791 (eval `(Assert (infinityp (cdr (remove-factor ,i -infinity)))))
1792 (eval `(Assert (infinityp (car (remove-factor ,i -infinity))))))
1793 '(2 3 4 10 20 50 100 200 +infinity)))
1796 (when (featurep 'bigq)
1797 (Assert (integerp (round 10/3)))
1798 (Assert (integerp (round 11/3)))
1799 (Assert (integerp (round -10/3)))
1800 (Assert (integerp (round -11/3)))
1801 (Assert (= (round 9/3) 3))
1802 (Assert (= (round 10/3) 3))
1803 (Assert (= (round 11/3) 4))
1804 (Assert (= (round 12/3) 4))
1805 (Assert (= (round -9/3) -3))
1806 (Assert (= (round -10/3) -3))
1807 (Assert (= (round -11/3) -4))
1808 (Assert (= (round -12/3) -4)))
1811 ;;-----------------------------------------------------
1812 ;; Test zeroes and ones
1813 ;;-----------------------------------------------------
1818 (Assert (zerop zero))
1819 (Assert (zerop zerof))
1821 (Assert (onep onef))
1822 ;; these tests are useful because there are rings where one is zero
1823 (Assert (not (zerop one)))
1824 (Assert (not (zerop onef)))
1825 (Assert (not (onep zero)))
1826 (Assert (not (onep zerof)))
1827 (Assert (onep (1+ zero)))
1828 (Assert (onep (1+ zerof)))
1829 (Assert (zerop (1- one)))
1830 (Assert (zerop (1- onef)))
1832 (mapc #'(lambda (cat)
1833 (when (featurep cat)
1834 (eval `(Assert (zerop (coerce-number ,zero ',cat))))
1835 (eval `(Assert (zerop (coerce-number ,zerof ',cat))))
1836 (eval `(Assert (onep (coerce-number ,one ',cat))))
1837 (eval `(Assert (onep (coerce-number ,onef ',cat))))
1838 ;; again we test the null-ring property
1839 (eval `(Assert (not (zerop (coerce-number ,one ',cat)))))
1840 (eval `(Assert (not (zerop (coerce-number ,onef ',cat)))))
1841 (eval `(Assert (not (onep (coerce-number ,zero ',cat)))))
1842 (eval `(Assert (not (onep (coerce-number ,zerof ',cat)))))))
1843 '(bigz bigq bigf bigfr bigg bigc)))
1845 (let ((ints (list 1 4 -23 0))
1846 (bigzs (when (featurep 'bigz)
1847 (list (factorial 23) (bigz 40) -892893489238924308234 (bigz 0))))
1848 (bigqs (when (featurep 'bigq)
1849 (list 3/4 (// (factorial 42) 101) -82759873478/1231 (bigq 0))))
1850 (floats (list 1.4 22.44 -494.2 (float 0)))
1851 (bigfs (when (featurep 'bigf)
1852 (list (bigf 1.44) (bigf (factorial 20)) (bigf 0))))
1853 (bigfrs (when (featurep 'bigfr)
1854 (list (exp 1) (atan 1) (exp 0) (bigfr 0))))
1855 (biggs (when (featurep 'bigg)
1856 (list 2+3i (make-bigg (factorial 20) 213) (bigg 0))))
1857 (bigcs (when (featurep 'bigc)
1858 (list 2.3+1.22i (make-bigc (exp 1) (exp 1)) (bigc 0)))))
1859 (mapc #'(lambda (cat)
1860 (mapc #'(lambda (num)
1862 (eval `(Assert (zerop (zero ,num))))
1863 (when (comparablep num)
1864 (eval `(Assert (= (+ (zero ,num) ,num) ,num)))
1865 (eval `(Assert (= (* (zero ,num) ,num) (zero ,num)))))
1866 (unless (comparablep num)
1867 (eval `(Assert-Equal (+ (zero ,num) ,num) ,num))
1869 (equal (* (zero ,num) ,num) (zero ,num)))))
1871 (eval `(Assert (onep (one ,num))))
1872 (eval `(Assert (zerop (1- (one ,num)))))
1873 (eval `(Assert (onep (1+ (zero ,num)))))
1874 (when (comparablep num)
1875 (eval `(Assert (= (* (one ,num) ,num) ,num)))
1876 (eval `(Assert (= (zero ,num) (1- (one ,num))))))
1877 (unless (comparablep num)
1878 (eval `(Assert-Equal (* (one ,num) ,num) ,num))
1879 (eval `(Assert-Equal (zero ,num) (1- (one ,num))))))
1880 (symbol-value cat)))
1881 '(ints bigzs bigqs floats bigfs bigfrs biggs bigcs)))
1884 ;;-----------------------------------------------------
1886 ;;-----------------------------------------------------
1889 (Assert (not (unitp 0)))
1890 (Assert (not (unitp 2)))
1892 (when (featurep 'fpfloat)
1893 (Assert (unitp 0.0))
1894 (Assert (unitp 1.0))
1895 (Assert (unitp -1.0))
1896 (Assert (unitp -2.2)))
1898 (when (featurep 'bigz)
1899 (Assert (unitp (bigz 1)))
1900 (Assert (unitp (bigz -1)))
1901 (Assert (not (unitp (bigz 0))))
1902 (Assert (not (unitp (bigz -3)))))
1904 (when (featurep 'bigq)
1905 (Assert (unitp (bigq 1)))
1906 (Assert (unitp (bigq -1)))
1907 (Assert (unitp (bigq 0)))
1908 (Assert (unitp 1/2))
1909 (Assert (unitp -2/3)))
1911 (when (featurep 'bigf)
1912 (Assert (unitp (bigf 1)))
1913 (Assert (unitp (bigf 1.2)))
1914 (Assert (unitp (bigf 0)))
1915 (Assert (unitp (bigf -1.3333))))
1917 (when (featurep 'bigfr)
1918 (Assert (unitp (bigfr 0)))
1919 (Assert (unitp (bigfr 1)))
1920 (Assert (unitp (bigfr -1)))
1921 (Assert (unitp (bigfr -0.2)))
1922 (Assert (unitp (bigfr 0.2 4096))))
1924 (when (featurep 'gaussian)
1925 (Assert (unitp 1+0i))
1926 (Assert (unitp 0+i))
1927 (Assert (not (unitp 0+0i)))
1928 (Assert (unitp 1+i))
1929 (Assert (unitp -1+0i))
1930 (Assert (unitp -1-i))
1931 (Assert (unitp 0-i))
1932 (Assert (not (unitp -2+i)))
1933 (Assert (not (unitp 1+2i)))
1934 (Assert (not (unitp 1-3i))))
1936 (when (featurep 'bigc)
1937 (Assert (unitp (bigc 0)))
1938 (Assert (unitp (bigc 1)))
1939 (Assert (unitp (bigc -1)))
1940 (Assert (unitp 0.5-0.5i))
1941 (Assert (unitp -0.25+i))
1942 (Assert (unitp 0.0+2.0i))
1943 (Assert (unitp -0.1-22.1i)))
1945 (when (featurep 'quatern)
1946 (Assert (unitp 1+0i+0j+0k))
1947 (Assert (unitp 0+i+0j+0k))
1948 (Assert (unitp 0+0i+j+0k))
1949 (Assert (unitp 0+0i+0j+k))
1950 (Assert (not (unitp 0+0i+0j+0k)))
1951 (Assert (unitp 1+i+0j+0k))
1952 (Assert (unitp 1+0i+j+0k))
1953 (Assert (unitp 1+0i+0j+k))
1954 (Assert (unitp 0+i+j+0k))
1955 (Assert (unitp 0+i+0j+k))
1956 (Assert (unitp 0+0i+j+k))
1957 (Assert (unitp 0+i+j+k))
1958 (Assert (unitp 1+0i+j+k))
1959 (Assert (unitp 1+i+0j+k))
1960 (Assert (unitp 1+i+j+0k))
1961 (Assert (unitp 1+i+j+k))
1962 (Assert (unitp -1-i-j-k))
1963 (Assert (unitp 0-i-j+k))
1964 (Assert (unitp 0+i-j-k))
1965 (Assert (unitp 1+0i+j-k))
1966 (Assert (not (unitp 2+i+j+k)))
1967 (Assert (not (unitp -2+2i-j+2k))))
1970 ;;-----------------------------------------------------
1971 ;; Test miscellaneous functions
1972 ;;-----------------------------------------------------
1974 (Check-Error wrong-type-argument (random 0))
1975 (when (featurep 'bigz)
1976 (Check-Error wrong-type-argument (random (bigz 0)))
1979 (Assert (intp (random)))
1981 ;; test random function with limit
1982 (let ((limit (bigz (random))))
1983 (cond ((positivep limit)
1984 (Assert (nonnegativep (random limit))))
1986 (Check-Error wrong-type-argument (random limit)))
1988 (Check-Error wrong-type-argument (random limit)))))
1990 ;; random with limit of 1 should always return zero
1991 (Assert (zerop (random 1)))
1992 (Assert (zerop (random (bigz 1)))))
1994 ;; expect at least one bigz random number in 1000 trials
1995 (Assert (let ((some nil))
1996 (dotimes (i 1000 some)
1998 (or some (bigzp (random (factorial 20)))))))))