1 ;;;; numbers.test --- tests guile's numbers -*- scheme -*-
2 ;;;; Copyright (C) 2000, 2001, 2003, 2004, 2005, 2006, 2009, 2010, 2011 Free Software Foundation, Inc.
4 ;;;; This library is free software; you can redistribute it and/or
5 ;;;; modify it under the terms of the GNU Lesser General Public
6 ;;;; License as published by the Free Software Foundation; either
7 ;;;; version 3 of the License, or (at your option) any later version.
9 ;;;; This library is distributed in the hope that it will be useful,
10 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 ;;;; Lesser General Public License for more details.
14 ;;;; You should have received a copy of the GNU Lesser General Public
15 ;;;; License along with this library; if not, write to the Free Software
16 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
18 (define-module (test-suite test-numbers)
19 #:use-module (test-suite lib)
20 #:use-module (ice-9 documentation)
21 #:use-module (srfi srfi-1) ; list library
22 #:use-module (srfi srfi-11)) ; let-values
28 (define exception:numerical-overflow
29 (cons 'numerical-overflow "^Numerical overflow"))
31 (define (documented? object)
32 (not (not (object-documentation object))))
35 (inexact->exact (+ (/ (log (+ most-positive-fixnum 1)) (log 2)) 1)))
37 (define fixnum-min most-negative-fixnum)
38 (define fixnum-max most-positive-fixnum)
40 ;; Divine the number of bits in the mantissa of a flonum.
41 ;; We look for when 2.0^i+1.0 gets rounded, ie. the difference between that
42 ;; value and 2.0^k is not 1.0.
43 ;; Of course this assumes flonums have a fixed precision mantissa, but
44 ;; that's the case now and probably into the forseeable future.
45 ;; On an IEEE system, which means pretty much everywhere, the value here is
52 (error "Oops, cannot determine number of bits in mantissa of inexact"))
53 (let* ((sum (+ 1.0 d))
56 (more (1+ i) (* 2.0 d))
59 ;; like ash, but working on a flonum
69 ;; `quotient' but rounded towards -infinity, like `modulo' or `ash' do
70 ;; note only positive D supported (that's all that's currently required)
71 (define-public (quotient-floor n d)
73 (quotient (- n d -1) d) ;; neg/pos
74 (quotient n d))) ;; pos/pos
76 ;; return true of X is in the range LO to HI, inclusive
77 (define (within-range? lo hi x)
78 (and (>= x (min lo hi))
81 ;; return true if GOT is within +/- 0.01 of GOT
82 ;; for a complex number both real and imaginary parts must be in that range
83 (define (eqv-loosely? want got)
84 (and (within-range? (- (real-part want) 0.01)
85 (+ (real-part want) 0.01)
87 (within-range? (- (imag-part want) 0.01)
88 (+ (imag-part want) 0.01)
91 ;; return true if OBJ is negative infinity
92 (define (negative-infinity? obj)
98 ;; Tolerance used by test-eqv? for inexact numbers.
100 (define test-epsilon 1e-10)
103 ;; Like eqv?, except that inexact finite numbers need only be within
104 ;; test-epsilon (1e-10) to be considered equal. For non-real complex
105 ;; numbers, each component is tested according to these rules. The
106 ;; intent is that the known-correct value will be the first parameter.
108 (define (test-eqv? x y)
110 (and (real? y) (test-real-eqv? x y)))
113 (test-real-eqv? (real-part x) (real-part y))
114 (test-real-eqv? (imag-part x) (imag-part y))))
117 ;; Auxiliary predicate used by test-eqv?
118 (define (test-real-eqv? x y)
119 (cond ((or (exact? x) (nan? x) (inf? x))
121 (else (and (inexact? y) (> test-epsilon (abs (- x y)))))))
123 ;; return true if OBJ is a real NaN
124 (define (real-nan? obj)
128 ;; return true if OBJ is a non-real complex number
129 ;; whose real part is a nan, and whose imaginary
130 ;; part is an inexact zero.
131 (define (almost-real-nan? obj)
132 (and (not (real? obj))
133 (nan? (real-part obj))
134 (zero? (imag-part obj))))
136 ;; return true if both the real and imaginary
137 ;; parts of OBJ are NaNs
138 (define (complex-nan? obj)
139 (and (nan? (real-part obj))
140 (nan? (imag-part obj))))
142 ;; return true if the real part of OBJ is zero
143 ;; and the imaginary part is a NaN.
144 (define (imaginary-nan? obj)
145 (and (zero? (real-part obj))
146 (nan? (imag-part obj))))
148 ;; return true if OBJ is a non-real complex zero
149 (define (complex-zero? obj)
154 (define const-e 2.7182818284590452354)
155 (define const-e^2 7.3890560989306502274)
156 (define const-1/e 0.3678794411714423215)
163 (with-test-prefix/c&e "1+"
165 (pass-if "documented?"
168 (pass-if "0" (eqv? 1 (1+ 0)))
169 (pass-if "-1" (eqv? 0 (1+ -1)))
170 (pass-if "100" (eqv? 101 (1+ 100)))
171 (pass-if "-100" (eqv? -99 (1+ -100)))
173 ;; The maximum fixnum on a 32-bit architecture: 2^29 - 1.
174 (pass-if "1+ fixnum = bignum (32-bit)"
175 (eqv? 536870912 (1+ 536870911)))
177 ;; The maximum fixnum on a 64-bit architecture: 2^61 - 1.
178 (pass-if "1+ fixnum = bignum (64-bit)"
179 (eqv? 2305843009213693952 (1+ 2305843009213693951))))
185 (with-test-prefix/c&e "1-"
187 (pass-if "documented?"
190 (pass-if "0" (eqv? -1 (1- 0)))
191 (pass-if "1" (eqv? 0 (1- 1)))
192 (pass-if "100" (eqv? 99 (1- 100)))
193 (pass-if "-100" (eqv? -101 (1- -100)))
195 ;; The minimum fixnum on a 32-bit architecture: -2^29.
196 (pass-if "1- fixnum = bignum (32-bit)"
197 (eqv? -536870913 (1- -536870912)))
199 ;; The minimum fixnum on a 64-bit architecture: -2^61.
200 (pass-if "1- fixnum = bignum (64-bit)"
201 (eqv? -2305843009213693953 (1- -2305843009213693952))))
207 (with-test-prefix "ash"
209 (pass-if "documented?"
212 (pass-if (eqv? 0 (ash 0 0)))
213 (pass-if (eqv? 0 (ash 0 1)))
214 (pass-if (eqv? 0 (ash 0 1000)))
215 (pass-if (eqv? 0 (ash 0 -1)))
216 (pass-if (eqv? 0 (ash 0 -1000)))
218 (pass-if (eqv? 1 (ash 1 0)))
219 (pass-if (eqv? 2 (ash 1 1)))
220 (pass-if (eqv? 340282366920938463463374607431768211456 (ash 1 128)))
221 (pass-if (eqv? 0 (ash 1 -1)))
222 (pass-if (eqv? 0 (ash 1 -1000)))
224 (pass-if (eqv? -1 (ash -1 0)))
225 (pass-if (eqv? -2 (ash -1 1)))
226 (pass-if (eqv? -340282366920938463463374607431768211456 (ash -1 128)))
227 (pass-if (eqv? -1 (ash -1 -1)))
228 (pass-if (eqv? -1 (ash -1 -1000)))
230 (pass-if (eqv? -3 (ash -3 0)))
231 (pass-if (eqv? -6 (ash -3 1)))
232 (pass-if (eqv? -1020847100762815390390123822295304634368 (ash -3 128)))
233 (pass-if (eqv? -2 (ash -3 -1)))
234 (pass-if (eqv? -1 (ash -3 -1000)))
236 (pass-if (eqv? -6 (ash -23 -2)))
238 (pass-if (eqv? most-positive-fixnum (ash most-positive-fixnum 0)))
239 (pass-if (eqv? (* 2 most-positive-fixnum) (ash most-positive-fixnum 1)))
240 (pass-if (eqv? (* 4 most-positive-fixnum) (ash most-positive-fixnum 2)))
242 (eqv? (* most-positive-fixnum 340282366920938463463374607431768211456)
243 (ash most-positive-fixnum 128)))
244 (pass-if (eqv? (quotient most-positive-fixnum 2)
245 (ash most-positive-fixnum -1)))
246 (pass-if (eqv? 0 (ash most-positive-fixnum -1000)))
248 (let ((mpf4 (quotient most-positive-fixnum 4)))
249 (pass-if (eqv? (* 2 mpf4) (ash mpf4 1)))
250 (pass-if (eqv? (* 4 mpf4) (ash mpf4 2)))
251 (pass-if (eqv? (* 8 mpf4) (ash mpf4 3))))
253 (pass-if (eqv? most-negative-fixnum (ash most-negative-fixnum 0)))
254 (pass-if (eqv? (* 2 most-negative-fixnum) (ash most-negative-fixnum 1)))
255 (pass-if (eqv? (* 4 most-negative-fixnum) (ash most-negative-fixnum 2)))
257 (eqv? (* most-negative-fixnum 340282366920938463463374607431768211456)
258 (ash most-negative-fixnum 128)))
259 (pass-if (eqv? (quotient-floor most-negative-fixnum 2)
260 (ash most-negative-fixnum -1)))
261 (pass-if (eqv? -1 (ash most-negative-fixnum -1000)))
263 (let ((mnf4 (quotient-floor most-negative-fixnum 4)))
264 (pass-if (eqv? (* 2 mnf4) (ash mnf4 1)))
265 (pass-if (eqv? (* 4 mnf4) (ash mnf4 2)))
266 (pass-if (eqv? (* 8 mnf4) (ash mnf4 3)))))
272 (with-test-prefix "exact?"
274 (pass-if "documented?"
275 (documented? exact?))
277 (with-test-prefix "integers"
282 (pass-if "fixnum-max"
285 (pass-if "fixnum-max + 1"
286 (exact? (+ fixnum-max 1)))
288 (pass-if "fixnum-min"
291 (pass-if "fixnum-min - 1"
292 (exact? (- fixnum-min 1))))
294 (with-test-prefix "reals"
296 ;; (FIXME: need better examples.)
298 (pass-if "sqrt (fixnum-max^2 - 1)"
299 (eq? #f (exact? (sqrt (- (expt fixnum-max 2) 1)))))
301 (pass-if "sqrt ((fixnum-max+1)^2 - 1)"
302 (eq? #f (exact? (sqrt (- (expt (+ fixnum-max 1) 2) 1)))))
304 (pass-if (not (exact? +inf.0)))
305 (pass-if (not (exact? -inf.0)))
306 (pass-if (not (exact? +nan.0)))))
312 (with-test-prefix "exp"
313 (pass-if (documented? exp))
315 (pass-if-exception "no args" exception:wrong-num-args
317 (pass-if-exception "two args" exception:wrong-num-args
320 (pass-if (eqv? 0.0 (exp -inf.0)))
321 (pass-if (eqv-loosely? 1.0 (exp 0)))
322 (pass-if (eqv-loosely? 1.0 (exp 0.0)))
323 (pass-if (eqv-loosely? const-e (exp 1.0)))
324 (pass-if (eqv-loosely? const-e^2 (exp 2.0)))
325 (pass-if (eqv-loosely? const-1/e (exp -1)))
327 (pass-if "exp(pi*i) = -1"
328 (eqv-loosely? -1.0 (exp 0+3.14159i)))
329 (pass-if "exp(-pi*i) = -1"
330 (eqv-loosely? -1.0 (exp 0-3.14159i)))
331 (pass-if "exp(2*pi*i) = +1"
332 (eqv-loosely? 1.0 (exp 0+6.28318i)))
334 (pass-if "exp(2-pi*i) = -e^2"
335 (eqv-loosely? (- const-e^2) (exp 2.0-3.14159i))))
341 (with-test-prefix "odd?"
342 (pass-if (documented? odd?))
345 (pass-if (not (odd? 0)))
346 (pass-if (not (odd? 2)))
347 (pass-if (not (odd? -2)))
348 (pass-if (odd? (+ (* 2 fixnum-max) 1)))
349 (pass-if (not (odd? (* 2 fixnum-max))))
350 (pass-if (odd? (- (* 2 fixnum-min) 1)))
351 (pass-if (not (odd? (* 2 fixnum-min)))))
357 (with-test-prefix "even?"
358 (pass-if (documented? even?))
362 (pass-if (not (even? 1)))
363 (pass-if (not (even? -1)))
364 (pass-if (not (even? (+ (* 2 fixnum-max) 1))))
365 (pass-if (even? (* 2 fixnum-max)))
366 (pass-if (not (even? (- (* 2 fixnum-min) 1))))
367 (pass-if (even? (* 2 fixnum-min))))
373 (with-test-prefix "finite?"
374 (pass-if (documented? finite?))
375 (pass-if (not (finite? (inf))))
376 (pass-if (not (finite? +inf.0)))
377 (pass-if (not (finite? -inf.0)))
379 "complex numbers not in domain of finite?"
380 exception:wrong-type-arg
383 "complex numbers not in domain of finite? (2)"
384 exception:wrong-type-arg
387 "complex numbers not in domain of finite? (3)"
388 exception:wrong-type-arg
390 (pass-if (finite? 3+0i))
391 (pass-if (not (finite? (nan))))
392 (pass-if (not (finite? +nan.0)))
393 (pass-if (finite? 0))
394 (pass-if (finite? 0.0))
395 (pass-if (finite? -0.0))
396 (pass-if (finite? 42.0))
397 (pass-if (finite? 1/2))
398 (pass-if (finite? (+ fixnum-max 1)))
399 (pass-if (finite? (- fixnum-min 1))))
405 (with-test-prefix "inf?"
406 (pass-if (documented? inf?))
407 (pass-if (inf? (inf)))
408 ;; FIXME: what are the expected behaviors?
409 ;; (pass-if (inf? (/ 1.0 0.0))
410 ;; (pass-if (inf? (/ 1 0.0))
412 "complex numbers not in domain of inf?"
413 exception:wrong-type-arg
415 (pass-if (inf? +inf.0+0i))
416 (pass-if (not (inf? 0)))
417 (pass-if (not (inf? 42.0)))
418 (pass-if (not (inf? (+ fixnum-max 1))))
419 (pass-if (not (inf? (- fixnum-min 1)))))
425 (with-test-prefix "nan?"
426 (pass-if (documented? nan?))
427 (pass-if (nan? (nan)))
428 ;; FIXME: other ways we should be able to generate NaN?
429 (pass-if (not (nan? 0)))
430 (pass-if (not (nan? 42.0)))
431 (pass-if (not (nan? (+ fixnum-max 1))))
432 (pass-if (not (nan? (- fixnum-min 1)))))
438 (with-test-prefix "abs"
439 (pass-if (documented? abs))
440 (pass-if (eqv? 0 (abs 0)))
441 (pass-if (eqv? 1 (abs 1)))
442 (pass-if (eqv? 1 (abs -1)))
444 (with-test-prefix "double-negation of fixnum-min"
445 (pass-if (eqv? fixnum-min (- (abs fixnum-min)))))
447 (pass-if (eqv? (+ fixnum-max 1) (abs (+ fixnum-max 1))))
448 (pass-if (eqv? (+ (- fixnum-min) 1) (abs (- fixnum-min 1))))
450 (pass-if (eqv? 0.0 (abs 0.0)))
451 (pass-if (eqv? 0.0 (abs -0.0)))
452 (pass-if (eqv? 1.0 (abs 1.0)))
453 (pass-if (eqv? 1.0 (abs -1.0)))
454 (pass-if (real-nan? (abs +nan.0)))
455 (pass-if (eqv? +inf.0 (abs +inf.0)))
456 (pass-if (eqv? +inf.0 (abs -inf.0))))
462 (with-test-prefix "quotient"
463 (pass-if (documented? quotient))
465 (with-test-prefix "0 / n"
468 (eqv? 0 (quotient 0 1)))
471 (eqv? 0 (quotient 0 -1)))
474 (eqv? 0 (quotient 0 2)))
476 (pass-if "n = fixnum-max"
477 (eqv? 0 (quotient 0 fixnum-max)))
479 (pass-if "n = fixnum-max + 1"
480 (eqv? 0 (quotient 0 (+ fixnum-max 1))))
482 (pass-if "n = fixnum-min"
483 (eqv? 0 (quotient 0 fixnum-min)))
485 (pass-if "n = fixnum-min - 1"
486 (eqv? 0 (quotient 0 (- fixnum-min 1)))))
488 (with-test-prefix "1 / n"
491 (eqv? 1 (quotient 1 1)))
494 (eqv? -1 (quotient 1 -1)))
497 (eqv? 0 (quotient 1 2)))
499 (pass-if "n = fixnum-max"
500 (eqv? 0 (quotient 1 fixnum-max)))
502 (pass-if "n = fixnum-max + 1"
503 (eqv? 0 (quotient 1 (+ fixnum-max 1))))
505 (pass-if "n = fixnum-min"
506 (eqv? 0 (quotient 1 fixnum-min)))
508 (pass-if "n = fixnum-min - 1"
509 (eqv? 0 (quotient 1 (- fixnum-min 1)))))
511 (with-test-prefix "-1 / n"
514 (eqv? -1 (quotient -1 1)))
517 (eqv? 1 (quotient -1 -1)))
520 (eqv? 0 (quotient -1 2)))
522 (pass-if "n = fixnum-max"
523 (eqv? 0 (quotient -1 fixnum-max)))
525 (pass-if "n = fixnum-max + 1"
526 (eqv? 0 (quotient -1 (+ fixnum-max 1))))
528 (pass-if "n = fixnum-min"
529 (eqv? 0 (quotient -1 fixnum-min)))
531 (pass-if "n = fixnum-min - 1"
532 (eqv? 0 (quotient -1 (- fixnum-min 1)))))
534 (with-test-prefix "fixnum-max / n"
537 (eqv? fixnum-max (quotient fixnum-max 1)))
540 (eqv? (- fixnum-max) (quotient fixnum-max -1)))
543 (eqv? fixnum-max (+ (* (quotient fixnum-max 2) 2) 1)))
545 (pass-if "n = fixnum-max"
546 (eqv? 1 (quotient fixnum-max fixnum-max)))
548 (pass-if "n = fixnum-max + 1"
549 (eqv? 0 (quotient fixnum-max (+ fixnum-max 1))))
551 (pass-if "n = fixnum-min"
552 (eqv? 0 (quotient fixnum-max fixnum-min)))
554 (pass-if "n = fixnum-min - 1"
555 (eqv? 0 (quotient fixnum-max (- fixnum-min 1)))))
557 (with-test-prefix "(fixnum-max + 1) / n"
560 (eqv? (+ fixnum-max 1) (quotient (+ fixnum-max 1) 1)))
563 (eqv? (- (+ fixnum-max 1)) (quotient (+ fixnum-max 1) -1)))
566 (eqv? (+ fixnum-max 1) (* (quotient (+ fixnum-max 1) 2) 2)))
568 (pass-if "n = fixnum-max"
569 (eqv? 1 (quotient (+ fixnum-max 1) fixnum-max)))
571 (pass-if "n = fixnum-max + 1"
572 (eqv? 1 (quotient (+ fixnum-max 1) (+ fixnum-max 1))))
574 (pass-if "n = fixnum-min"
575 (eqv? -1 (quotient (+ fixnum-max 1) fixnum-min)))
577 (pass-if "n = fixnum-min - 1"
578 (eqv? 0 (quotient (+ fixnum-max 1) (- fixnum-min 1)))))
580 (with-test-prefix "fixnum-min / n"
583 (eqv? fixnum-min (quotient fixnum-min 1)))
586 (eqv? (- fixnum-min) (quotient fixnum-min -1)))
589 (eqv? fixnum-min (* (quotient fixnum-min 2) 2)))
591 (pass-if "n = fixnum-max"
592 (eqv? -1 (quotient fixnum-min fixnum-max)))
594 (pass-if "n = fixnum-max + 1"
595 (eqv? -1 (quotient fixnum-min (+ fixnum-max 1))))
597 (pass-if "n = fixnum-min"
598 (eqv? 1 (quotient fixnum-min fixnum-min)))
600 (pass-if "n = fixnum-min - 1"
601 (eqv? 0 (quotient fixnum-min (- fixnum-min 1))))
603 (pass-if "n = - fixnum-min - 1"
604 (eqv? -1 (quotient fixnum-min (1- (- fixnum-min)))))
606 ;; special case, normally inum/big is zero
607 (pass-if "n = - fixnum-min"
608 (eqv? -1 (quotient fixnum-min (- fixnum-min))))
610 (pass-if "n = - fixnum-min + 1"
611 (eqv? 0 (quotient fixnum-min (1+ (- fixnum-min))))))
613 (with-test-prefix "(fixnum-min - 1) / n"
616 (eqv? (- fixnum-min 1) (quotient (- fixnum-min 1) 1)))
619 (eqv? (- (- fixnum-min 1)) (quotient (- fixnum-min 1) -1)))
622 (eqv? fixnum-min (* (quotient (- fixnum-min 1) 2) 2)))
624 (pass-if "n = fixnum-max"
625 (eqv? -1 (quotient (- fixnum-min 1) fixnum-max)))
627 (pass-if "n = fixnum-max + 1"
628 (eqv? -1 (quotient (- fixnum-min 1) (+ fixnum-max 1))))
630 (pass-if "n = fixnum-min"
631 (eqv? 1 (quotient (- fixnum-min 1) fixnum-min)))
633 (pass-if "n = fixnum-min - 1"
634 (eqv? 1 (quotient (- fixnum-min 1) (- fixnum-min 1)))))
638 (pass-if (eqv? 5.0 (quotient 35.0 7.0)))
639 (pass-if (eqv? 5.0 (quotient 35 7.0)))
640 (pass-if (eqv? 5.0 (quotient 35.0 7 )))
642 ;; Positive dividend and divisor
645 (eqv? 5 (quotient 35 7)))
647 ;; Negative dividend, positive divisor
650 (eqv? -5 (quotient -35 7)))
652 ;; Positive dividend, negative divisor
655 (eqv? -5 (quotient 35 -7)))
657 ;; Negative dividend and divisor
660 (eqv? 5 (quotient -35 -7)))
662 ;; Are numerical overflows detected correctly?
664 (with-test-prefix "division by zero"
666 (pass-if-exception "(quotient 1 0)"
667 exception:numerical-overflow
670 (pass-if-exception "(quotient bignum 0)"
671 exception:numerical-overflow
672 (quotient (+ fixnum-max 1) 0)))
674 ;; Are wrong type arguments detected correctly?
682 (with-test-prefix "remainder"
683 (pass-if (documented? remainder))
685 (with-test-prefix "0 / n"
688 (eqv? 0 (remainder 0 1)))
691 (eqv? 0 (remainder 0 -1)))
693 (pass-if "n = fixnum-max"
694 (eqv? 0 (remainder 0 fixnum-max)))
696 (pass-if "n = fixnum-max + 1"
697 (eqv? 0 (remainder 0 (+ fixnum-max 1))))
699 (pass-if "n = fixnum-min"
700 (eqv? 0 (remainder 0 fixnum-min)))
702 (pass-if "n = fixnum-min - 1"
703 (eqv? 0 (remainder 0 (- fixnum-min 1)))))
705 (with-test-prefix "1 / n"
708 (eqv? 0 (remainder 1 1)))
711 (eqv? 0 (remainder 1 -1)))
713 (pass-if "n = fixnum-max"
714 (eqv? 1 (remainder 1 fixnum-max)))
716 (pass-if "n = fixnum-max + 1"
717 (eqv? 1 (remainder 1 (+ fixnum-max 1))))
719 (pass-if "n = fixnum-min"
720 (eqv? 1 (remainder 1 fixnum-min)))
722 (pass-if "n = fixnum-min - 1"
723 (eqv? 1 (remainder 1 (- fixnum-min 1)))))
725 (with-test-prefix "-1 / n"
728 (eqv? 0 (remainder -1 1)))
731 (eqv? 0 (remainder -1 -1)))
733 (pass-if "n = fixnum-max"
734 (eqv? -1 (remainder -1 fixnum-max)))
736 (pass-if "n = fixnum-max + 1"
737 (eqv? -1 (remainder -1 (+ fixnum-max 1))))
739 (pass-if "n = fixnum-min"
740 (eqv? -1 (remainder -1 fixnum-min)))
742 (pass-if "n = fixnum-min - 1"
743 (eqv? -1 (remainder -1 (- fixnum-min 1)))))
745 (with-test-prefix "fixnum-max / n"
748 (eqv? 0 (remainder fixnum-max 1)))
751 (eqv? 0 (remainder fixnum-max -1)))
753 (pass-if "n = fixnum-max"
754 (eqv? 0 (remainder fixnum-max fixnum-max)))
756 (pass-if "n = fixnum-max + 1"
757 (eqv? fixnum-max (remainder fixnum-max (+ fixnum-max 1))))
759 (pass-if "n = fixnum-min"
760 (eqv? fixnum-max (remainder fixnum-max fixnum-min)))
762 (pass-if "n = fixnum-min - 1"
763 (eqv? fixnum-max (remainder fixnum-max (- fixnum-min 1)))))
765 (with-test-prefix "(fixnum-max + 1) / n"
768 (eqv? 0 (remainder (+ fixnum-max 1) 1)))
771 (eqv? 0 (remainder (+ fixnum-max 1) -1)))
773 (pass-if "n = fixnum-max"
774 (eqv? 1 (remainder (+ fixnum-max 1) fixnum-max)))
776 (pass-if "n = fixnum-max + 1"
777 (eqv? 0 (remainder (+ fixnum-max 1) (+ fixnum-max 1))))
779 (pass-if "n = fixnum-min"
780 (eqv? 0 (remainder (+ fixnum-max 1) fixnum-min)))
782 (pass-if "n = fixnum-min - 1"
783 (eqv? (+ fixnum-max 1) (remainder (+ fixnum-max 1) (- fixnum-min 1)))))
785 (with-test-prefix "fixnum-min / n"
788 (eqv? 0 (remainder fixnum-min 1)))
791 (eqv? 0 (remainder fixnum-min -1)))
793 (pass-if "n = fixnum-max"
794 (eqv? -1 (remainder fixnum-min fixnum-max)))
796 (pass-if "n = fixnum-max + 1"
797 (eqv? 0 (remainder fixnum-min (+ fixnum-max 1))))
799 (pass-if "n = fixnum-min"
800 (eqv? 0 (remainder fixnum-min fixnum-min)))
802 (pass-if "n = fixnum-min - 1"
803 (eqv? fixnum-min (remainder fixnum-min (- fixnum-min 1))))
805 (pass-if "n = - fixnum-min - 1"
806 (eqv? -1 (remainder fixnum-min (1- (- fixnum-min)))))
808 ;; special case, normally inum%big is the inum
809 (pass-if "n = - fixnum-min"
810 (eqv? 0 (remainder fixnum-min (- fixnum-min))))
812 (pass-if "n = - fixnum-min + 1"
813 (eqv? fixnum-min (remainder fixnum-min (1+ (- fixnum-min))))))
815 (with-test-prefix "(fixnum-min - 1) / n"
818 (eqv? 0 (remainder (- fixnum-min 1) 1)))
821 (eqv? 0 (remainder (- fixnum-min 1) -1)))
823 (pass-if "n = fixnum-max"
824 (eqv? -2 (remainder (- fixnum-min 1) fixnum-max)))
826 (pass-if "n = fixnum-max + 1"
827 (eqv? -1 (remainder (- fixnum-min 1) (+ fixnum-max 1))))
829 (pass-if "n = fixnum-min"
830 (eqv? -1 (remainder (- fixnum-min 1) fixnum-min)))
832 (pass-if "n = fixnum-min - 1"
833 (eqv? 0 (remainder (- fixnum-min 1) (- fixnum-min 1)))))
837 (pass-if (eqv? 2.0 (remainder 37.0 7.0)))
838 (pass-if (eqv? 2.0 (remainder 37 7.0)))
839 (pass-if (eqv? 2.0 (remainder 37.0 7 )))
841 ;; Positive dividend and divisor
844 (eqv? 0 (remainder 35 7)))
846 ;; Negative dividend, positive divisor
849 (eqv? 0 (remainder -35 7)))
851 ;; Positive dividend, negative divisor
854 (eqv? 0 (remainder 35 -7)))
856 ;; Negative dividend and divisor
859 (eqv? 0 (remainder -35 -7)))
861 ;; Are numerical overflows detected correctly?
863 (with-test-prefix "division by zero"
865 (pass-if-exception "(remainder 1 0)"
866 exception:numerical-overflow
869 (pass-if-exception "(remainder bignum 0)"
870 exception:numerical-overflow
871 (remainder (+ fixnum-max 1) 0)))
873 ;; Are wrong type arguments detected correctly?
881 (with-test-prefix "modulo"
882 (pass-if (documented? modulo))
884 (with-test-prefix "0 % n"
887 (eqv? 0 (modulo 0 1)))
890 (eqv? 0 (modulo 0 -1)))
892 (pass-if "n = fixnum-max"
893 (eqv? 0 (modulo 0 fixnum-max)))
895 (pass-if "n = fixnum-max + 1"
896 (eqv? 0 (modulo 0 (+ fixnum-max 1))))
898 (pass-if "n = fixnum-min"
899 (eqv? 0 (modulo 0 fixnum-min)))
901 (pass-if "n = fixnum-min - 1"
902 (eqv? 0 (modulo 0 (- fixnum-min 1)))))
904 (with-test-prefix "1 % n"
907 (eqv? 0 (modulo 1 1)))
910 (eqv? 0 (modulo 1 -1)))
912 (pass-if "n = fixnum-max"
913 (eqv? 1 (modulo 1 fixnum-max)))
915 (pass-if "n = fixnum-max + 1"
916 (eqv? 1 (modulo 1 (+ fixnum-max 1))))
918 (pass-if "n = fixnum-min"
919 (eqv? (+ fixnum-min 1) (modulo 1 fixnum-min)))
921 (pass-if "n = fixnum-min - 1"
922 (eqv? fixnum-min (modulo 1 (- fixnum-min 1)))))
924 (with-test-prefix "-1 % n"
927 (eqv? 0 (modulo -1 1)))
930 (eqv? 0 (modulo -1 -1)))
932 (pass-if "n = fixnum-max"
933 (eqv? (- fixnum-max 1) (modulo -1 fixnum-max)))
935 (pass-if "n = fixnum-max + 1"
936 (eqv? fixnum-max (modulo -1 (+ fixnum-max 1))))
938 (pass-if "n = fixnum-min"
939 (eqv? -1 (modulo -1 fixnum-min)))
941 (pass-if "n = fixnum-min - 1"
942 (eqv? -1 (modulo -1 (- fixnum-min 1)))))
944 (with-test-prefix "fixnum-max % n"
947 (eqv? 0 (modulo fixnum-max 1)))
950 (eqv? 0 (modulo fixnum-max -1)))
952 (pass-if "n = fixnum-max"
953 (eqv? 0 (modulo fixnum-max fixnum-max)))
955 (pass-if "n = fixnum-max + 1"
956 (eqv? fixnum-max (modulo fixnum-max (+ fixnum-max 1))))
958 (pass-if "n = fixnum-min"
959 (eqv? -1 (modulo fixnum-max fixnum-min)))
961 (pass-if "n = fixnum-min - 1"
962 (eqv? -2 (modulo fixnum-max (- fixnum-min 1)))))
964 (with-test-prefix "(fixnum-max + 1) % n"
967 (eqv? 0 (modulo (+ fixnum-max 1) 1)))
970 (eqv? 0 (modulo (+ fixnum-max 1) -1)))
972 (pass-if "n = fixnum-max"
973 (eqv? 1 (modulo (+ fixnum-max 1) fixnum-max)))
975 (pass-if "n = fixnum-max + 1"
976 (eqv? 0 (modulo (+ fixnum-max 1) (+ fixnum-max 1))))
978 (pass-if "n = fixnum-min"
979 (eqv? 0 (modulo (+ fixnum-max 1) fixnum-min)))
981 (pass-if "n = fixnum-min - 1"
982 (eqv? -1 (modulo (+ fixnum-max 1) (- fixnum-min 1)))))
984 (with-test-prefix "fixnum-min % n"
987 (eqv? 0 (modulo fixnum-min 1)))
990 (eqv? 0 (modulo fixnum-min -1)))
992 (pass-if "n = fixnum-max"
993 (eqv? (- fixnum-max 1) (modulo fixnum-min fixnum-max)))
995 (pass-if "n = fixnum-max + 1"
996 (eqv? 0 (modulo fixnum-min (+ fixnum-max 1))))
998 (pass-if "n = fixnum-min"
999 (eqv? 0 (modulo fixnum-min fixnum-min)))
1001 (pass-if "n = fixnum-min - 1"
1002 (eqv? fixnum-min (modulo fixnum-min (- fixnum-min 1)))))
1004 (with-test-prefix "(fixnum-min - 1) % n"
1007 (eqv? 0 (modulo (- fixnum-min 1) 1)))
1010 (eqv? 0 (modulo (- fixnum-min 1) -1)))
1012 (pass-if "n = fixnum-max"
1013 (eqv? (- fixnum-max 2) (modulo (- fixnum-min 1) fixnum-max)))
1015 (pass-if "n = fixnum-max + 1"
1016 (eqv? fixnum-max (modulo (- fixnum-min 1) (+ fixnum-max 1))))
1018 (pass-if "n = fixnum-min"
1019 (eqv? -1 (modulo (- fixnum-min 1) fixnum-min)))
1021 (pass-if "n = fixnum-min - 1"
1022 (eqv? 0 (modulo (- fixnum-min 1) (- fixnum-min 1)))))
1026 (pass-if (eqv? 1.0 (modulo 13.0 4.0)))
1027 (pass-if (eqv? 1.0 (modulo 13 4.0)))
1028 (pass-if (eqv? 1.0 (modulo 13.0 4 )))
1030 ;; Positive dividend and divisor
1033 (eqv? 1 (modulo 13 4)))
1035 (pass-if "2177452800 % 86400"
1036 (eqv? 0 (modulo 2177452800 86400)))
1038 ;; Negative dividend, positive divisor
1041 (eqv? 3 (modulo -13 4)))
1043 (pass-if "-2177452800 % 86400"
1044 (eqv? 0 (modulo -2177452800 86400)))
1046 ;; Positive dividend, negative divisor
1049 (eqv? -3 (modulo 13 -4)))
1051 (pass-if "2177452800 % -86400"
1052 (eqv? 0 (modulo 2177452800 -86400)))
1054 ;; Negative dividend and divisor
1057 (eqv? -1 (modulo -13 -4)))
1059 (pass-if "-2177452800 % -86400"
1060 (eqv? 0 (modulo -2177452800 -86400)))
1062 ;; Are numerical overflows detected correctly?
1064 (with-test-prefix "division by zero"
1066 (pass-if-exception "(modulo 1 0)"
1067 exception:numerical-overflow
1070 (pass-if-exception "(modulo bignum 0)"
1071 exception:numerical-overflow
1072 (modulo (+ fixnum-max 1) 0)))
1074 ;; Are wrong type arguments detected correctly?
1082 (with-test-prefix "modulo-expt"
1083 (pass-if (= 1 (modulo-expt 17 23 47)))
1085 (pass-if (= 1 (modulo-expt 17 -23 47)))
1087 (pass-if (= 17 (modulo-expt 17 -22 47)))
1089 (pass-if (= 36 (modulo-expt 17 22 47)))
1091 (pass-if (= 183658794479969134816674175082294846241553725240 (modulo-expt 111122223333444455556666 111122223333444455556666 1153478690012629968439432872520758982731022934717)))
1094 "Proper exception with 0 modulus"
1095 exception:numerical-overflow
1096 (modulo-expt 17 23 0))
1099 "Proper exception when result not invertible"
1100 exception:numerical-overflow
1101 (modulo-expt 10 -1 48))
1104 "Proper exception with wrong type argument"
1105 exception:wrong-type-arg
1106 (modulo-expt "Sam" 23 10))
1109 "Proper exception with wrong type argument"
1110 exception:wrong-type-arg
1111 (modulo-expt 17 9.9 10))
1114 "Proper exception with wrong type argument"
1115 exception:wrong-type-arg
1116 (modulo-expt 17 23 'Ethel)))
1122 (with-test-prefix "numerator"
1124 (eqv? 0 (numerator 0)))
1126 (eqv? 1 (numerator 1)))
1128 (eqv? 2 (numerator 2)))
1130 (eqv? -1 (numerator -1)))
1132 (eqv? -2 (numerator -2)))
1135 (eqv? 0.0 (numerator 0.0)))
1137 (eqv? 1.0 (numerator 1.0)))
1139 (eqv? 2.0 (numerator 2.0)))
1141 (eqv? -1.0 (numerator -1.0)))
1143 (eqv? -2.0 (numerator -2.0)))
1146 (eqv? 1.0 (numerator 0.5)))
1148 (eqv? 1.0 (numerator 0.25)))
1150 (eqv? 3.0 (numerator 0.75))))
1156 (with-test-prefix "denominator"
1158 (eqv? 1 (denominator 0)))
1160 (eqv? 1 (denominator 1)))
1162 (eqv? 1 (denominator 2)))
1164 (eqv? 1 (denominator -1)))
1166 (eqv? 1 (denominator -2)))
1169 (eqv? 1.0 (denominator 0.0)))
1171 (eqv? 1.0 (denominator 1.0)))
1173 (eqv? 1.0 (denominator 2.0)))
1175 (eqv? 1.0 (denominator -1.0)))
1177 (eqv? 1.0 (denominator -2.0)))
1180 (eqv? 2.0 (denominator 0.5)))
1182 (eqv? 4.0 (denominator 0.25)))
1184 (eqv? 4.0 (denominator 0.75))))
1190 (with-test-prefix "gcd"
1192 (pass-if "documented?"
1195 (with-test-prefix "(n)"
1200 (with-test-prefix "(0 n)"
1209 (eqv? 1 (gcd 0 -1)))
1211 (pass-if "n = fixnum-max"
1212 (eqv? fixnum-max (gcd 0 fixnum-max)))
1214 (pass-if "n = fixnum-max + 1"
1215 (eqv? (+ fixnum-max 1) (gcd 0 (+ fixnum-max 1))))
1217 (pass-if "n = fixnum-min"
1218 (eqv? (- fixnum-min) (gcd 0 fixnum-min)))
1220 (pass-if "n = fixnum-min - 1"
1221 (eqv? (- (- fixnum-min 1)) (gcd 0 (- fixnum-min 1)))))
1223 (with-test-prefix "(n 0)"
1225 (pass-if "n = 2^128 * fixnum-max"
1226 (eqv? (ash fixnum-max 128) (gcd (ash fixnum-max 128) 0))))
1228 (with-test-prefix "(1 n)"
1237 (eqv? 1 (gcd 1 -1)))
1239 (pass-if "n = fixnum-max"
1240 (eqv? 1 (gcd 1 fixnum-max)))
1242 (pass-if "n = fixnum-max + 1"
1243 (eqv? 1 (gcd 1 (+ fixnum-max 1))))
1245 (pass-if "n = fixnum-min"
1246 (eqv? 1 (gcd 1 fixnum-min)))
1248 (pass-if "n = fixnum-min - 1"
1249 (eqv? 1 (gcd 1 (- fixnum-min 1)))))
1251 (with-test-prefix "(-1 n)"
1254 (eqv? 1 (gcd -1 0)))
1257 (eqv? 1 (gcd -1 1)))
1260 (eqv? 1 (gcd -1 -1)))
1262 (pass-if "n = fixnum-max"
1263 (eqv? 1 (gcd -1 fixnum-max)))
1265 (pass-if "n = fixnum-max + 1"
1266 (eqv? 1 (gcd -1 (+ fixnum-max 1))))
1268 (pass-if "n = fixnum-min"
1269 (eqv? 1 (gcd -1 fixnum-min)))
1271 (pass-if "n = fixnum-min - 1"
1272 (eqv? 1 (gcd -1 (- fixnum-min 1)))))
1274 (with-test-prefix "(fixnum-max n)"
1277 (eqv? fixnum-max (gcd fixnum-max 0)))
1280 (eqv? 1 (gcd fixnum-max 1)))
1283 (eqv? 1 (gcd fixnum-max -1)))
1285 (pass-if "n = fixnum-max"
1286 (eqv? fixnum-max (gcd fixnum-max fixnum-max)))
1288 (pass-if "n = fixnum-max + 1"
1289 (eqv? 1 (gcd fixnum-max (+ fixnum-max 1))))
1291 (pass-if "n = fixnum-min"
1292 (eqv? 1 (gcd fixnum-max fixnum-min)))
1294 (pass-if "n = fixnum-min - 1"
1295 (eqv? 1 (gcd fixnum-max (- fixnum-min 1)))))
1297 (with-test-prefix "((+ fixnum-max 1) n)"
1300 (eqv? (+ fixnum-max 1) (gcd (+ fixnum-max 1) 0)))
1303 (eqv? 1 (gcd (+ fixnum-max 1) 1)))
1306 (eqv? 1 (gcd (+ fixnum-max 1) -1)))
1308 (pass-if "n = fixnum-max"
1309 (eqv? 1 (gcd (+ fixnum-max 1) fixnum-max)))
1311 (pass-if "n = fixnum-max + 1"
1312 (eqv? (+ fixnum-max 1) (gcd (+ fixnum-max 1) (+ fixnum-max 1))))
1314 (pass-if "n = fixnum-min"
1315 (eqv? (+ fixnum-max 1) (gcd (+ fixnum-max 1) fixnum-min)))
1317 (pass-if "n = fixnum-min - 1"
1318 (eqv? 1 (gcd (+ fixnum-max 1) (- fixnum-min 1)))))
1320 (with-test-prefix "(fixnum-min n)"
1323 (eqv? (- fixnum-min) (gcd fixnum-min 0)))
1326 (eqv? 1 (gcd fixnum-min 1)))
1329 (eqv? 1 (gcd fixnum-min -1)))
1331 (pass-if "n = fixnum-max"
1332 (eqv? 1 (gcd fixnum-min fixnum-max)))
1334 (pass-if "n = fixnum-max + 1"
1335 (eqv? (+ fixnum-max 1) (gcd fixnum-min (+ fixnum-max 1))))
1337 (pass-if "n = fixnum-min"
1338 (eqv? (- fixnum-min) (gcd fixnum-min fixnum-min)))
1340 (pass-if "n = fixnum-min - 1"
1341 (eqv? 1 (gcd fixnum-min (- fixnum-min 1)))))
1343 (with-test-prefix "((- fixnum-min 1) n)"
1346 (eqv? (- (- fixnum-min 1)) (gcd (- fixnum-min 1) 0)))
1349 (eqv? 1 (gcd (- fixnum-min 1) 1)))
1352 (eqv? 1 (gcd (- fixnum-min 1) -1)))
1354 (pass-if "n = fixnum-max"
1355 (eqv? 1 (gcd (- fixnum-min 1) fixnum-max)))
1357 (pass-if "n = fixnum-max + 1"
1358 (eqv? 1 (gcd (- fixnum-min 1) (+ fixnum-max 1))))
1360 (pass-if "n = fixnum-min"
1361 (eqv? 1 (gcd (- fixnum-min 1) fixnum-min)))
1363 (pass-if "n = fixnum-min - 1"
1364 (eqv? (- (- fixnum-min 1)) (gcd (- fixnum-min 1) (- fixnum-min 1)))))
1366 ;; Are wrong type arguments detected correctly?
1374 (with-test-prefix "lcm"
1375 ;; FIXME: more tests?
1376 ;; (some of these are already in r4rs.test)
1377 (pass-if (documented? lcm))
1378 (pass-if (= (lcm) 1))
1379 (pass-if (= (lcm 32 -36) 288))
1380 (let ((big-n 115792089237316195423570985008687907853269984665640564039457584007913129639936) ; 2 ^ 256
1381 (lcm-of-big-n-and-11 1273712981610478149659280835095566986385969831322046204434033424087044426039296))
1382 (pass-if (= lcm-of-big-n-and-11 (lcm big-n 11)))
1383 (pass-if (= lcm-of-big-n-and-11 (lcm 11 big-n 11)))))
1388 (with-test-prefix "rationalize"
1389 (pass-if (documented? rationalize))
1390 (pass-if (eqv? 2 (rationalize 4 2 )))
1391 (pass-if (eqv? -2 (rationalize -4 2 )))
1392 (pass-if (eqv? 2.0 (rationalize 4 2.0)))
1393 (pass-if (eqv? -2.0 (rationalize -4.0 2 )))
1395 (pass-if (eqv? 0 (rationalize 4 8 )))
1396 (pass-if (eqv? 0 (rationalize -4 8 )))
1397 (pass-if (eqv? 0.0 (rationalize 4 8.0)))
1398 (pass-if (eqv? 0.0 (rationalize -4.0 8 )))
1400 (pass-if (eqv? 0.0 (rationalize 3 +inf.0)))
1401 (pass-if (eqv? 0.0 (rationalize -3 +inf.0)))
1403 (pass-if (real-nan? (rationalize +inf.0 +inf.0)))
1404 (pass-if (real-nan? (rationalize +nan.0 +inf.0)))
1405 (pass-if (real-nan? (rationalize +nan.0 4)))
1406 (pass-if (eqv? +inf.0 (rationalize +inf.0 3)))
1408 (pass-if (eqv? 3/10 (rationalize 3/10 0)))
1409 (pass-if (eqv? -3/10 (rationalize -3/10 0)))
1411 (pass-if (eqv? 1/3 (rationalize 3/10 1/10)))
1412 (pass-if (eqv? -1/3 (rationalize -3/10 1/10)))
1414 (pass-if (eqv? 1/3 (rationalize 3/10 -1/10)))
1415 (pass-if (eqv? -1/3 (rationalize -3/10 -1/10)))
1417 (pass-if (test-eqv? (/ 1.0 3) (rationalize 0.3 1/10)))
1418 (pass-if (test-eqv? (/ -1.0 3) (rationalize -0.3 1/10)))
1419 (pass-if (test-eqv? (/ 1.0 3) (rationalize 0.3 -1/10)))
1420 (pass-if (test-eqv? (/ -1.0 3) (rationalize -0.3 -1/10))))
1426 (with-test-prefix "number->string"
1427 (let ((num->str->num
1429 (string->number (number->string n radix) radix))))
1431 (pass-if (documented? number->string))
1432 (pass-if (string=? (number->string 0) "0"))
1433 (pass-if (string=? (number->string 171) "171"))
1434 (pass-if (= (+ fixnum-max 1) (num->str->num (+ fixnum-max 1) 10)))
1435 (pass-if (= (- fixnum-min 1) (num->str->num (- fixnum-min 1) 10)))
1436 (pass-if (= (inf) (num->str->num (inf) 10)))
1437 (pass-if (= 1.3 (num->str->num 1.3 10)))
1439 ;; XXX - some results depend on whether Guile is compiled optimzed
1440 ;; or not. It is clearly undesirable to have number->string to be
1441 ;; influenced by this.
1443 (pass-if (string=? (number->string 35.25 36) "z.9"))
1444 (pass-if (or (string=? (number->string 0.25 2) "0.01")
1445 (string=? (number->string 0.25 2) "0.010")))
1446 (pass-if (string=? (number->string 255.0625 16) "ff.1"))
1447 (pass-if (string=? (number->string (/ 1 3) 3) "1/10"))
1449 (pass-if (string=? (number->string 10) "10"))
1450 (pass-if (string=? (number->string 10 11) "a"))
1451 (pass-if (string=? (number->string 36 36) "10"))
1452 (pass-if (= (num->str->num 36 36) 36))
1453 (pass-if (= (string->number "z" 36) 35))
1454 (pass-if (= (string->number "Z" 36) 35))
1455 (pass-if (not (string->number "Z" 35)))
1456 (pass-if (string=? (number->string 35 36) "z"))
1457 (pass-if (= (num->str->num 35 36) 35))
1459 ;; Before Guile 2.0.1, even in the presence of a #e forced exactness
1460 ;; specifier, negative exponents were applied inexactly and then
1461 ;; later coerced to exact, yielding an incorrect fraction.
1462 (pass-if (eqv? (string->number "#e1e-10") 1/10000000000))
1464 ;; Numeric conversion from decimal is not precise, in its current
1465 ;; implementation, so 11.333... and 1.324... can't be expected to
1466 ;; reliably come out to precise values. These tests did actually work
1467 ;; for a while, but something in gcc changed, affecting the conversion
1470 ;; (pass-if (or (string=? (number->string 11.33333333333333333 12)
1472 ;; (string=? (number->string 11.33333333333333333 12)
1473 ;; "B.400000000000009")))
1474 ;; (pass-if (or (string=? (number->string 1.324e44 16)
1475 ;; "5.EFE0A14FAFEe24")
1476 ;; (string=? (number->string 1.324e44 16)
1477 ;; "5.EFE0A14FAFDF8e24")))
1484 (with-test-prefix "string->number"
1486 (pass-if "documented?"
1487 (documented? string->number))
1489 (pass-if "non number strings"
1490 (for-each (lambda (x) (if (string->number x) (throw 'fail)))
1491 '("" "q" "1q" "6+7iq" "8+9q" "10+11" "13+" "18@19q" "20@q" "23@"
1492 "+25iq" "26i" "-q" "-iq" "i" "5#.0" "8/" "10#11" ".#" "."
1493 "#o.2" "3.4q" "15.16e17q" "18.19e+q" ".q" ".17#18" "10q" "#b2"
1494 "#b3" "#b4" "#b5" "#b6" "#b7" "#b8" "#b9" "#ba" "#bb" "#bc"
1495 "#bd" "#be" "#bf" "#q" "#b#b1" "#o#o1" "#d#d1" "#x#x1" "#e#e1"
1496 "#i#i1" "12@12+0i"))
1499 (pass-if "valid number strings"
1500 (for-each (lambda (couple)
1503 (let ((xx (string->number x)))
1504 (if (or (eq? xx #f) (not (eqv? xx y)))
1510 ("#b0" 0) ("#B0" 0) ("#b1" 1) ("#B1" 1) ("#o0" 0) ("#O0" 0)
1511 ("#o1" 1) ("#O1" 1) ("#o2" 2) ("#O2" 2) ("#o3" 3) ("#O3" 3)
1512 ("#o4" 4) ("#O4" 4) ("#o5" 5) ("#O5" 5) ("#o6" 6) ("#O6" 6)
1513 ("#o7" 7) ("#O7" 7) ("#d0" 0) ("#D0" 0) ("#d1" 1) ("#D1" 1)
1514 ("#d2" 2) ("#D2" 2) ("#d3" 3) ("#D3" 3) ("#d4" 4) ("#D4" 4)
1515 ("#d5" 5) ("#D5" 5) ("#d6" 6) ("#D6" 6) ("#d7" 7) ("#D7" 7)
1516 ("#d8" 8) ("#D8" 8) ("#d9" 9) ("#D9" 9)
1517 ("#xa" 10) ("#Xa" 10) ("#xb" 11) ("#Xb" 11)
1518 ("#xc" 12) ("#Xc" 12) ("#xd" 13) ("#Xd" 13)
1519 ("#xe" 14) ("#Xe" 14) ("#xf" 15) ("#Xf" 15)
1521 ("#o12345670" 2739128)
1522 ("#d1234567890" 1234567890)
1523 ("#x1234567890abcdef" 1311768467294899695)
1525 ("#e1" 1) ("#e1.2" 12/10)
1526 ("#i1.1" 1.1) ("#i1" 1.0)
1528 ("1" ,(1+ 0)) ("23" ,(+ 9 9 5)) ("-1" ,(- 0 1))
1529 ("-45" ,(- 0 45)) ("2#" 20.0) ("2##" 200.0) ("12##" 1200.0)
1532 ("1/1" 1) ("1/2" 1/2) ("-1/2" -1/2) ("1#/1" 10.0)
1533 ("10/1#" 1.0) ("1#/1#" 1.0) ("#e9/10" 9/10) ("#e10/1#" 1)
1534 ("#i6/8" 0.75) ("#i1/1" 1.0)
1536 ;; * <uinteger 10> <suffix>
1537 ("1e2" 100.0) ("1E2" 100.0) ("1s2" 100.0) ("1S2" 100.0)
1538 ("1f2" 100.0) ("1F2" 100.0) ("1d2" 100.0) ("1D2" 100.0)
1539 ("1l2" 100.0) ("1L2" 100.0) ("1e+2" 100.0) ("1e-2" 0.01)
1540 ;; * . <digit 10>+ #* <suffix>
1541 (".1" .1) (".0123456789" 123456789e-10) (".16#" 0.16)
1542 (".0123456789e10" 123456789.0) (".16#e3" 160.0) ("#d.3" 0.3)
1543 ;; * <digit 10>+ . <digit 10>* #* <suffix>
1544 ("3." ,(exact->inexact 3)) ("3.e0" ,(exact->inexact 3))
1545 ("3.1" ,(exact->inexact 31/10)) ("3.1e0" 3.1) ("3.1#" 3.1)
1547 ;; * <digit 10>+ #+ . #* <suffix>
1548 ("3#." 30.0) ("3#.e0" 30.0) ("3#.#" 30.0) ("3#.#e0" 30.0)
1552 (pass-if "valid complex number strings"
1553 (for-each (lambda (triple)
1556 (let ((z (string->number str)))
1558 (not (and (eqv? (real-part z) re)
1559 (eqv? (imag-part z) im))))
1564 `(("1@0" 1 0) ("1@+0" 1 0) ("1@-0" 1 0) ("1/2@0" 1/2 0)
1565 ("1.0@0" 1.0 0) ("1.0@-0" 1.0 0)
1566 ("#e1@0" 1 0) ("#e1@+0" 1 0) ("#e1@-0" 1 0) ("#e0.5@0.0" 1/2 0)
1567 ("#e1.0@0" 1 0) ("#e1.0@-0" 1 0)
1568 ("#i1@0" 1.0 0.0) ("#i1@+0" 1.0 0.0) ("#i1@-0" 1.0 -0.0) ("#i1/2@0" 0.5 0.0)
1569 ("#i1.0@0" 1.0 0.0) ("#i1.0@-0" 1.0 -0.0)
1570 ("1@+0.0" 1.0 0.0) ("1.0@-0.0" 1.0 -0.0)
1571 ("2+3i" 2.0 3.0) ("4-5i" 4.0 -5.0)
1572 ("1+i" 1.0 1.0) ("1-i" 1.0 -1.0) ("+1i" 0.0 1.0) ("-1i" 0.0 -1.0)
1573 ("+i" 0.0 1.0) ("-i" 0.0 -1.0)
1574 ("1.0+.1i" 1.0 0.1) ("1.0-.1i" 1.0 -0.1)
1575 (".1+.0i" 0.1 0.0) ("1.+.0i" 1.0 0.0) (".1+.1i" 0.1 0.1)
1576 ("1e1+.1i" 10.0 0.1)
1577 ("0@+nan.0" 0 0) ("0@+inf.0" 0 0) ("0@-inf.0" 0 0)
1578 ("0.0@+nan.0" 0.0 0.0) ("0.0@+inf.0" 0.0 0.0) ("0.0@-inf.0" 0.0 0.0)
1579 ("#i0@+nan.0" 0.0 0.0) ("#i0@+inf.0" 0.0 0.0) ("#i0@-inf.0" 0.0 0.0)
1580 ("0.0@1" 0.0 0.0) ("0.0@2" -0.0 0.0) ("0.0@4" -0.0 -0.0) ("0.0@5" 0.0 -0.0)
1584 (pass-if-exception "exponent too big"
1585 exception:out-of-range
1586 (string->number "12.13e141414"))
1588 ;; in guile 1.6.7 and earlier, bad polar forms (where the conversion of
1589 ;; the angle gave #f) caused a segv
1591 (eq? #f (string->number "1@a"))))
1597 (with-test-prefix "number?"
1598 (pass-if (documented? number?))
1599 (pass-if (number? 0))
1600 (pass-if (number? 7))
1601 (pass-if (number? -7))
1602 (pass-if (number? 1.3))
1603 (pass-if (number? (+ 1 fixnum-max)))
1604 (pass-if (number? (- 1 fixnum-min)))
1605 (pass-if (number? 3+4i))
1606 (pass-if (not (number? #\a)))
1607 (pass-if (not (number? "a")))
1608 (pass-if (not (number? (make-vector 0))))
1609 (pass-if (not (number? (cons 1 2))))
1610 (pass-if (not (number? #t)))
1611 (pass-if (not (number? (lambda () #t))))
1612 (pass-if (not (number? (current-input-port)))))
1618 (with-test-prefix "complex?"
1619 (pass-if (documented? complex?))
1620 (pass-if (complex? 0))
1621 (pass-if (complex? 7))
1622 (pass-if (complex? -7))
1623 (pass-if (complex? (+ 1 fixnum-max)))
1624 (pass-if (complex? (- 1 fixnum-min)))
1625 (pass-if (complex? 1.3))
1626 (pass-if (complex? 3+4i))
1627 (pass-if (not (complex? #\a)))
1628 (pass-if (not (complex? "a")))
1629 (pass-if (not (complex? (make-vector 0))))
1630 (pass-if (not (complex? (cons 1 2))))
1631 (pass-if (not (complex? #t)))
1632 (pass-if (not (complex? (lambda () #t))))
1633 (pass-if (not (complex? (current-input-port)))))
1639 (with-test-prefix "real?"
1640 (pass-if (documented? real?))
1643 (pass-if (real? -7))
1644 (pass-if (real? (+ 1 fixnum-max)))
1645 (pass-if (real? (- 1 fixnum-min)))
1646 (pass-if (real? 1.3))
1647 (pass-if (real? +inf.0))
1648 (pass-if (real? -inf.0))
1649 (pass-if (real? +nan.0))
1650 (pass-if (not (real? +inf.0-inf.0i)))
1651 (pass-if (not (real? +nan.0+nan.0i)))
1652 (pass-if (not (real? 3+4i)))
1653 (pass-if (not (real? #\a)))
1654 (pass-if (not (real? "a")))
1655 (pass-if (not (real? (make-vector 0))))
1656 (pass-if (not (real? (cons 1 2))))
1657 (pass-if (not (real? #t)))
1658 (pass-if (not (real? (lambda () #t))))
1659 (pass-if (not (real? (current-input-port)))))
1665 (with-test-prefix "rational?"
1666 (pass-if (documented? rational?))
1667 (pass-if (rational? 0))
1668 (pass-if (rational? 7))
1669 (pass-if (rational? -7))
1670 (pass-if (rational? (+ 1 fixnum-max)))
1671 (pass-if (rational? (- 1 fixnum-min)))
1672 (pass-if (rational? 1.3))
1673 (pass-if (not (rational? +inf.0)))
1674 (pass-if (not (rational? -inf.0)))
1675 (pass-if (not (rational? +nan.0)))
1676 (pass-if (not (rational? +inf.0-inf.0i)))
1677 (pass-if (not (rational? +nan.0+nan.0i)))
1678 (pass-if (not (rational? 3+4i)))
1679 (pass-if (not (rational? #\a)))
1680 (pass-if (not (rational? "a")))
1681 (pass-if (not (rational? (make-vector 0))))
1682 (pass-if (not (rational? (cons 1 2))))
1683 (pass-if (not (rational? #t)))
1684 (pass-if (not (rational? (lambda () #t))))
1685 (pass-if (not (rational? (current-input-port)))))
1691 (with-test-prefix "integer?"
1692 (pass-if (documented? integer?))
1693 (pass-if (integer? 0))
1694 (pass-if (integer? 7))
1695 (pass-if (integer? -7))
1696 (pass-if (integer? (+ 1 fixnum-max)))
1697 (pass-if (integer? (- 1 fixnum-min)))
1698 (pass-if (and (= 3+0i (round 3+0i)) (integer? 3+0i)))
1699 (pass-if (and (= 1.0 (round 1.0)) (integer? 1.0)))
1700 (pass-if (not (integer? 1.3)))
1701 (pass-if (not (integer? +inf.0)))
1702 (pass-if (not (integer? -inf.0)))
1703 (pass-if (not (integer? +nan.0)))
1704 (pass-if (not (integer? +inf.0-inf.0i)))
1705 (pass-if (not (integer? +nan.0+nan.0i)))
1706 (pass-if (not (integer? 3+4i)))
1707 (pass-if (not (integer? #\a)))
1708 (pass-if (not (integer? "a")))
1709 (pass-if (not (integer? (make-vector 0))))
1710 (pass-if (not (integer? (cons 1 2))))
1711 (pass-if (not (integer? #t)))
1712 (pass-if (not (integer? (lambda () #t))))
1713 (pass-if (not (integer? (current-input-port)))))
1719 (with-test-prefix "inexact?"
1720 (pass-if (documented? inexact?))
1721 (pass-if (not (inexact? 0)))
1722 (pass-if (not (inexact? 7)))
1723 (pass-if (not (inexact? -7)))
1724 (pass-if (not (inexact? (+ 1 fixnum-max))))
1725 (pass-if (not (inexact? (- 1 fixnum-min))))
1726 (pass-if (inexact? 1.3))
1727 (pass-if (inexact? 3.1+4.2i))
1728 (pass-if (inexact? +inf.0))
1729 (pass-if (inexact? -inf.0))
1730 (pass-if (inexact? +nan.0))
1731 (pass-if-exception "char"
1732 exception:wrong-type-arg
1733 (not (inexact? #\a)))
1734 (pass-if-exception "string"
1735 exception:wrong-type-arg
1736 (not (inexact? "a")))
1737 (pass-if-exception "vector"
1738 exception:wrong-type-arg
1739 (not (inexact? (make-vector 0))))
1740 (pass-if-exception "cons"
1741 exception:wrong-type-arg
1742 (not (inexact? (cons 1 2))))
1743 (pass-if-exception "bool"
1744 exception:wrong-type-arg
1745 (not (inexact? #t)))
1746 (pass-if-exception "procedure"
1747 exception:wrong-type-arg
1748 (not (inexact? (lambda () #t))))
1749 (pass-if-exception "port"
1750 exception:wrong-type-arg
1751 (not (inexact? (current-input-port)))))
1757 (with-test-prefix "equal?"
1758 (pass-if (documented? equal?))
1760 ;; The following test will fail on platforms
1761 ;; without distinct signed zeroes 0.0 and -0.0.
1762 (pass-if (not (equal? 0.0 -0.0)))
1764 (pass-if (equal? 0 0))
1765 (pass-if (equal? 7 7))
1766 (pass-if (equal? -7 -7))
1767 (pass-if (equal? (+ 1 fixnum-max) (+ 1 fixnum-max)))
1768 (pass-if (equal? (- fixnum-min 1) (- fixnum-min 1)))
1769 (pass-if (equal? 0.0 0.0))
1770 (pass-if (equal? -0.0 -0.0))
1771 (pass-if (equal? 0.0+0.0i 0.0+0.0i))
1772 (pass-if (equal? 0.0-0.0i 0.0-0.0i))
1773 (pass-if (equal? -0.0+0.0i -0.0+0.0i))
1774 (pass-if (not (equal? 0 1)))
1775 (pass-if (not (equal? 0 0.0)))
1776 (pass-if (not (equal? 1 1.0)))
1777 (pass-if (not (equal? 0.0 0)))
1778 (pass-if (not (equal? 1.0 1)))
1779 (pass-if (not (equal? -1.0 -1)))
1780 (pass-if (not (equal? 1.0 1.0+0.0i)))
1781 (pass-if (not (equal? 0.0 0.0+0.0i)))
1782 (pass-if (not (equal? 0.0+0.0i 0.0-0.0i)))
1783 (pass-if (not (equal? 0.0+0.0i -0.0+0.0i)))
1784 (pass-if (not (equal? fixnum-max (+ 1 fixnum-max))))
1785 (pass-if (not (equal? (+ 1 fixnum-max) fixnum-max)))
1786 (pass-if (not (equal? (+ 1 fixnum-max) (+ 2 fixnum-max))))
1787 (pass-if (not (equal? fixnum-min (- fixnum-min 1))))
1788 (pass-if (not (equal? (- fixnum-min 1) fixnum-min)))
1789 (pass-if (not (equal? (- fixnum-min 1) (- fixnum-min 2))))
1790 (pass-if (not (equal? (+ fixnum-max 1) (- fixnum-min 1))))
1792 (pass-if (not (equal? (ash 1 256) +inf.0)))
1793 (pass-if (not (equal? +inf.0 (ash 1 256))))
1794 (pass-if (not (equal? (ash 1 256) -inf.0)))
1795 (pass-if (not (equal? -inf.0 (ash 1 256))))
1797 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
1798 ;; sure we've avoided that
1799 (pass-if (not (equal? (ash 1 1024) +inf.0)))
1800 (pass-if (not (equal? +inf.0 (ash 1 1024))))
1801 (pass-if (not (equal? (- (ash 1 1024)) -inf.0)))
1802 (pass-if (not (equal? -inf.0 (- (ash 1 1024)))))
1804 (pass-if (equal? +nan.0 +nan.0))
1805 (pass-if (equal? +nan.0 +nan.0))
1806 (pass-if (not (equal? +nan.0 0.0+nan.0i)))
1808 (pass-if (not (equal? 0 +nan.0)))
1809 (pass-if (not (equal? +nan.0 0)))
1810 (pass-if (not (equal? 1 +nan.0)))
1811 (pass-if (not (equal? +nan.0 1)))
1812 (pass-if (not (equal? -1 +nan.0)))
1813 (pass-if (not (equal? +nan.0 -1)))
1815 (pass-if (not (equal? (ash 1 256) +nan.0)))
1816 (pass-if (not (equal? +nan.0 (ash 1 256))))
1817 (pass-if (not (equal? (- (ash 1 256)) +nan.0)))
1818 (pass-if (not (equal? +nan.0 (- (ash 1 256)))))
1820 (pass-if (not (equal? (ash 1 8192) +nan.0)))
1821 (pass-if (not (equal? +nan.0 (ash 1 8192))))
1822 (pass-if (not (equal? (- (ash 1 8192)) +nan.0)))
1823 (pass-if (not (equal? +nan.0 (- (ash 1 8192)))))
1825 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
1826 ;; sure we've avoided that
1827 (pass-if (not (equal? (ash 3 1023) +nan.0)))
1828 (pass-if (not (equal? +nan.0 (ash 3 1023)))))
1834 (with-test-prefix "eqv?"
1835 (pass-if (documented? eqv?))
1837 ;; The following test will fail on platforms
1838 ;; without distinct signed zeroes 0.0 and -0.0.
1839 (pass-if (not (eqv? 0.0 -0.0)))
1841 (pass-if (eqv? 0 0))
1842 (pass-if (eqv? 7 7))
1843 (pass-if (eqv? -7 -7))
1844 (pass-if (eqv? (+ 1 fixnum-max) (+ 1 fixnum-max)))
1845 (pass-if (eqv? (- fixnum-min 1) (- fixnum-min 1)))
1846 (pass-if (eqv? 0.0 0.0))
1847 (pass-if (eqv? -0.0 -0.0))
1848 (pass-if (eqv? 0.0+0.0i 0.0+0.0i))
1849 (pass-if (eqv? 0.0-0.0i 0.0-0.0i))
1850 (pass-if (eqv? -0.0+0.0i -0.0+0.0i))
1851 (pass-if (not (eqv? 0.0 -0.0)))
1852 (pass-if (not (eqv? 0.0 0.0+0.0i)))
1853 (pass-if (not (eqv? 0.0+0.0i 0.0-0.0i)))
1854 (pass-if (not (eqv? 0.0+0.0i -0.0+0.0i)))
1855 (pass-if (not (eqv? 0 1)))
1856 (pass-if (not (eqv? 0 0.0)))
1857 (pass-if (not (eqv? 1 1.0)))
1858 (pass-if (not (eqv? 0.0 0)))
1859 (pass-if (not (eqv? 1.0 1)))
1860 (pass-if (not (eqv? -1.0 -1)))
1861 (pass-if (not (eqv? 1.0 1.0+0.0i)))
1862 (pass-if (not (eqv? 0.0 0.0+0.0i)))
1863 (pass-if (not (eqv? fixnum-max (+ 1 fixnum-max))))
1864 (pass-if (not (eqv? (+ 1 fixnum-max) fixnum-max)))
1865 (pass-if (not (eqv? (+ 1 fixnum-max) (+ 2 fixnum-max))))
1866 (pass-if (not (eqv? fixnum-min (- fixnum-min 1))))
1867 (pass-if (not (eqv? (- fixnum-min 1) fixnum-min)))
1868 (pass-if (not (eqv? (- fixnum-min 1) (- fixnum-min 2))))
1869 (pass-if (not (eqv? (+ fixnum-max 1) (- fixnum-min 1))))
1871 (pass-if (not (eqv? (ash 1 256) +inf.0)))
1872 (pass-if (not (eqv? +inf.0 (ash 1 256))))
1873 (pass-if (not (eqv? (ash 1 256) -inf.0)))
1874 (pass-if (not (eqv? -inf.0 (ash 1 256))))
1876 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
1877 ;; sure we've avoided that
1878 (pass-if (not (eqv? (ash 1 1024) +inf.0)))
1879 (pass-if (not (eqv? +inf.0 (ash 1 1024))))
1880 (pass-if (not (eqv? (- (ash 1 1024)) -inf.0)))
1881 (pass-if (not (eqv? -inf.0 (- (ash 1 1024)))))
1883 (pass-if (eqv? +nan.0 +nan.0))
1884 (pass-if (not (eqv? +nan.0 0.0+nan.0i)))
1886 (pass-if (not (eqv? 0 +nan.0)))
1887 (pass-if (not (eqv? +nan.0 0)))
1888 (pass-if (not (eqv? 1 +nan.0)))
1889 (pass-if (not (eqv? +nan.0 1)))
1890 (pass-if (not (eqv? -1 +nan.0)))
1891 (pass-if (not (eqv? +nan.0 -1)))
1893 (pass-if (not (eqv? (ash 1 256) +nan.0)))
1894 (pass-if (not (eqv? +nan.0 (ash 1 256))))
1895 (pass-if (not (eqv? (- (ash 1 256)) +nan.0)))
1896 (pass-if (not (eqv? +nan.0 (- (ash 1 256)))))
1898 (pass-if (not (eqv? (ash 1 8192) +nan.0)))
1899 (pass-if (not (eqv? +nan.0 (ash 1 8192))))
1900 (pass-if (not (eqv? (- (ash 1 8192)) +nan.0)))
1901 (pass-if (not (eqv? +nan.0 (- (ash 1 8192)))))
1903 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
1904 ;; sure we've avoided that
1905 (pass-if (not (eqv? (ash 3 1023) +nan.0)))
1906 (pass-if (not (eqv? +nan.0 (ash 3 1023)))))
1912 (with-test-prefix "="
1913 (pass-if (documented? =))
1918 (pass-if (= -1 -1.0))
1919 (pass-if (= 0.0 0.0))
1920 (pass-if (= 0.0 -0.0))
1921 (pass-if (= 1 1.0+0.0i))
1925 (pass-if (= 0 -0.0))
1926 (pass-if (= 0 0.0+0.0i))
1927 (pass-if (= 0 0.0-0.0i))
1928 (pass-if (= 0 0.0+0.0i))
1929 (pass-if (= 0 -0.0-0.0i))
1933 (pass-if (= -0.0 0))
1934 (pass-if (= 0.0+0.0i 0))
1935 (pass-if (= 0.0-0.0i 0))
1936 (pass-if (= 0.0+0.0i 0))
1937 (pass-if (= -0.0-0.0i 0))
1939 (pass-if (= 0.0+0.0i 0.0-0.0i))
1940 (pass-if (= 0.0+0.0i -0.0+0.0i))
1942 (pass-if (= (+ 1 fixnum-max) (+ 1 fixnum-max)))
1943 (pass-if (= (- fixnum-min 1) (- fixnum-min 1)))
1944 (pass-if (not (= 0 1)))
1945 (pass-if (not (= fixnum-max (+ 1 fixnum-max))))
1946 (pass-if (not (= (+ 1 fixnum-max) fixnum-max)))
1947 (pass-if (not (= (+ 1 fixnum-max) (+ 2 fixnum-max))))
1948 (pass-if (not (= fixnum-min (- fixnum-min 1))))
1949 (pass-if (not (= (- fixnum-min 1) fixnum-min)))
1950 (pass-if (not (= (- fixnum-min 1) (- fixnum-min 2))))
1951 (pass-if (not (= (+ fixnum-max 1) (- fixnum-min 1))))
1953 (pass-if (not (= (ash 1 256) +inf.0)))
1954 (pass-if (not (= +inf.0 (ash 1 256))))
1955 (pass-if (not (= (ash 1 256) -inf.0)))
1956 (pass-if (not (= -inf.0 (ash 1 256))))
1958 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
1959 ;; sure we've avoided that
1960 (pass-if (not (= (ash 1 1024) +inf.0)))
1961 (pass-if (not (= +inf.0 (ash 1 1024))))
1962 (pass-if (not (= (- (ash 1 1024)) -inf.0)))
1963 (pass-if (not (= -inf.0 (- (ash 1 1024)))))
1965 (pass-if (not (= +nan.0 +nan.0)))
1966 (pass-if (not (= 0 +nan.0)))
1967 (pass-if (not (= +nan.0 0)))
1968 (pass-if (not (= 1 +nan.0)))
1969 (pass-if (not (= +nan.0 1)))
1970 (pass-if (not (= -1 +nan.0)))
1971 (pass-if (not (= +nan.0 -1)))
1973 (pass-if (not (= (ash 1 256) +nan.0)))
1974 (pass-if (not (= +nan.0 (ash 1 256))))
1975 (pass-if (not (= (- (ash 1 256)) +nan.0)))
1976 (pass-if (not (= +nan.0 (- (ash 1 256)))))
1978 (pass-if (not (= (ash 1 8192) +nan.0)))
1979 (pass-if (not (= +nan.0 (ash 1 8192))))
1980 (pass-if (not (= (- (ash 1 8192)) +nan.0)))
1981 (pass-if (not (= +nan.0 (- (ash 1 8192)))))
1983 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
1984 ;; sure we've avoided that
1985 (pass-if (not (= (ash 3 1023) +nan.0)))
1986 (pass-if (not (= +nan.0 (ash 3 1023))))
1988 (pass-if (= 1/2 0.5))
1989 (pass-if (not (= 1/3 0.333333333333333333333333333333333)))
1990 (pass-if (not (= 2/3 0.5)))
1991 (pass-if (not (= 0.5 (+ 1/2 (/ 1 (ash 1 1000))))))
1993 (pass-if (= 1/2 0.5+0i))
1994 (pass-if (not (= 0.333333333333333333333333333333333 1/3)))
1995 (pass-if (not (= 2/3 0.5+0i)))
1996 (pass-if (not (= 1/2 0+0.5i)))
1998 (pass-if (= 0.5 1/2))
1999 (pass-if (not (= 0.5 2/3)))
2000 (pass-if (not (= (+ 1/2 (/ 1 (ash 1 1000))) 0.5)))
2002 (pass-if (= 0.5+0i 1/2))
2003 (pass-if (not (= 0.5+0i 2/3)))
2004 (pass-if (not (= 0+0.5i 1/2)))
2006 ;; prior to guile 1.8, inum/flonum comparisons were done just by
2007 ;; converting the inum to a double, which on a 64-bit would round making
2008 ;; say inexact 2^58 appear equal to exact 2^58+1
2009 (pass-if (= (ash-flo 1.0 58) (ash 1 58)))
2010 (pass-if (not (= (ash-flo 1.0 58) (1+ (ash 1 58)))))
2011 (pass-if (not (= (ash-flo 1.0 58) (1- (ash 1 58)))))
2012 (pass-if (= (ash 1 58) (ash-flo 1.0 58)))
2013 (pass-if (not (= (1+ (ash 1 58)) (ash-flo 1.0 58))))
2014 (pass-if (not (= (1- (ash 1 58)) (ash-flo 1.0 58)))))
2020 (with-test-prefix "<"
2022 (pass-if "documented?"
2025 (with-test-prefix "(< 0 n)"
2045 (pass-if "n = fixnum-max"
2048 (pass-if "n = fixnum-max + 1"
2049 (< 0 (+ fixnum-max 1)))
2051 (pass-if "n = fixnum-min"
2052 (not (< 0 fixnum-min)))
2054 (pass-if "n = fixnum-min - 1"
2055 (not (< 0 (- fixnum-min 1)))))
2057 (with-test-prefix "(< 0.0 n)"
2077 (pass-if "n = fixnum-max"
2080 (pass-if "n = fixnum-max + 1"
2081 (< 0.0 (+ fixnum-max 1)))
2083 (pass-if "n = fixnum-min"
2084 (not (< 0.0 fixnum-min)))
2086 (pass-if "n = fixnum-min - 1"
2087 (not (< 0.0 (- fixnum-min 1)))))
2089 (with-test-prefix "(< 1 n)"
2109 (pass-if "n = fixnum-max"
2112 (pass-if "n = fixnum-max + 1"
2113 (< 1 (+ fixnum-max 1)))
2115 (pass-if "n = fixnum-min"
2116 (not (< 1 fixnum-min)))
2118 (pass-if "n = fixnum-min - 1"
2119 (not (< 1 (- fixnum-min 1)))))
2121 (with-test-prefix "(< 1.0 n)"
2141 (pass-if "n = fixnum-max"
2144 (pass-if "n = fixnum-max + 1"
2145 (< 1.0 (+ fixnum-max 1)))
2147 (pass-if "n = fixnum-min"
2148 (not (< 1.0 fixnum-min)))
2150 (pass-if "n = fixnum-min - 1"
2151 (not (< 1.0 (- fixnum-min 1)))))
2153 (with-test-prefix "(< -1 n)"
2173 (pass-if "n = fixnum-max"
2176 (pass-if "n = fixnum-max + 1"
2177 (< -1 (+ fixnum-max 1)))
2179 (pass-if "n = fixnum-min"
2180 (not (< -1 fixnum-min)))
2182 (pass-if "n = fixnum-min - 1"
2183 (not (< -1 (- fixnum-min 1)))))
2185 (with-test-prefix "(< -1.0 n)"
2203 (not (< -1.0 -1.0)))
2205 (pass-if "n = fixnum-max"
2206 (< -1.0 fixnum-max))
2208 (pass-if "n = fixnum-max + 1"
2209 (< -1.0 (+ fixnum-max 1)))
2211 (pass-if "n = fixnum-min"
2212 (not (< -1.0 fixnum-min)))
2214 (pass-if "n = fixnum-min - 1"
2215 (not (< -1.0 (- fixnum-min 1)))))
2217 (with-test-prefix "(< fixnum-max n)"
2220 (not (< fixnum-max 0)))
2223 (not (< fixnum-max 0.0)))
2226 (not (< fixnum-max 1)))
2229 (not (< fixnum-max 1.0)))
2232 (not (< fixnum-max -1)))
2235 (not (< fixnum-max -1.0)))
2237 (pass-if "n = fixnum-max"
2238 (not (< fixnum-max fixnum-max)))
2240 (pass-if "n = fixnum-max + 1"
2241 (< fixnum-max (+ fixnum-max 1)))
2243 (pass-if "n = fixnum-min"
2244 (not (< fixnum-max fixnum-min)))
2246 (pass-if "n = fixnum-min - 1"
2247 (not (< fixnum-max (- fixnum-min 1)))))
2249 (with-test-prefix "(< (+ fixnum-max 1) n)"
2252 (not (< (+ fixnum-max 1) 0)))
2255 (not (< (+ fixnum-max 1) 0.0)))
2258 (not (< (+ fixnum-max 1) 1)))
2261 (not (< (+ fixnum-max 1) 1.0)))
2264 (not (< (+ fixnum-max 1) -1)))
2267 (not (< (+ fixnum-max 1) -1.0)))
2269 (pass-if "n = fixnum-max"
2270 (not (< (+ fixnum-max 1) fixnum-max)))
2272 (pass-if "n = fixnum-max + 1"
2273 (not (< (+ fixnum-max 1) (+ fixnum-max 1))))
2275 (pass-if "n = fixnum-min"
2276 (not (< (+ fixnum-max 1) fixnum-min)))
2278 (pass-if "n = fixnum-min - 1"
2279 (not (< (+ fixnum-max 1) (- fixnum-min 1)))))
2281 (with-test-prefix "(< fixnum-min n)"
2299 (< fixnum-min -1.0))
2301 (pass-if "n = fixnum-max"
2302 (< fixnum-min fixnum-max))
2304 (pass-if "n = fixnum-max + 1"
2305 (< fixnum-min (+ fixnum-max 1)))
2307 (pass-if "n = fixnum-min"
2308 (not (< fixnum-min fixnum-min)))
2310 (pass-if "n = fixnum-min - 1"
2311 (not (< fixnum-min (- fixnum-min 1)))))
2313 (with-test-prefix "(< (- fixnum-min 1) n)"
2316 (< (- fixnum-min 1) 0))
2319 (< (- fixnum-min 1) 0.0))
2322 (< (- fixnum-min 1) 1))
2325 (< (- fixnum-min 1) 1.0))
2328 (< (- fixnum-min 1) -1))
2331 (< (- fixnum-min 1) -1.0))
2333 (pass-if "n = fixnum-max"
2334 (< (- fixnum-min 1) fixnum-max))
2336 (pass-if "n = fixnum-max + 1"
2337 (< (- fixnum-min 1) (+ fixnum-max 1)))
2339 (pass-if "n = fixnum-min"
2340 (< (- fixnum-min 1) fixnum-min))
2342 (pass-if "n = fixnum-min - 1"
2343 (not (< (- fixnum-min 1) (- fixnum-min 1)))))
2345 (pass-if (< (ash 1 256) +inf.0))
2346 (pass-if (not (< +inf.0 (ash 1 256))))
2347 (pass-if (not (< (ash 1 256) -inf.0)))
2348 (pass-if (< -inf.0 (ash 1 256)))
2350 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
2351 ;; sure we've avoided that
2352 (pass-if (< (1- (ash 1 1024)) +inf.0))
2353 (pass-if (< (ash 1 1024) +inf.0))
2354 (pass-if (< (1+ (ash 1 1024)) +inf.0))
2355 (pass-if (not (< +inf.0 (1- (ash 1 1024)))))
2356 (pass-if (not (< +inf.0 (ash 1 1024))))
2357 (pass-if (not (< +inf.0 (1+ (ash 1 1024)))))
2358 (pass-if (< -inf.0 (- (1- (ash 1 1024)))))
2359 (pass-if (< -inf.0 (- (ash 1 1024))))
2360 (pass-if (< -inf.0 (- (1+ (ash 1 1024)))))
2361 (pass-if (not (< (- (1- (ash 1 1024))) -inf.0)))
2362 (pass-if (not (< (- (ash 1 1024)) -inf.0)))
2363 (pass-if (not (< (- (1+ (ash 1 1024))) -inf.0)))
2365 (pass-if (not (< +nan.0 +nan.0)))
2366 (pass-if (not (< 0 +nan.0)))
2367 (pass-if (not (< +nan.0 0)))
2368 (pass-if (not (< 1 +nan.0)))
2369 (pass-if (not (< +nan.0 1)))
2370 (pass-if (not (< -1 +nan.0)))
2371 (pass-if (not (< +nan.0 -1)))
2373 (pass-if (not (< (ash 1 256) +nan.0)))
2374 (pass-if (not (< +nan.0 (ash 1 256))))
2375 (pass-if (not (< (- (ash 1 256)) +nan.0)))
2376 (pass-if (not (< +nan.0 (- (ash 1 256)))))
2378 (pass-if (not (< (ash 1 8192) +nan.0)))
2379 (pass-if (not (< +nan.0 (ash 1 8192))))
2380 (pass-if (not (< (- (ash 1 8192)) +nan.0)))
2381 (pass-if (not (< +nan.0 (- (ash 1 8192)))))
2383 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
2384 ;; sure we've avoided that
2385 (pass-if (not (< (ash 3 1023) +nan.0)))
2386 (pass-if (not (< (1+ (ash 3 1023)) +nan.0)))
2387 (pass-if (not (< (1- (ash 3 1023)) +nan.0)))
2388 (pass-if (not (< +nan.0 (ash 3 1023))))
2389 (pass-if (not (< +nan.0 (1+ (ash 3 1023)))))
2390 (pass-if (not (< +nan.0 (1- (ash 3 1023)))))
2392 (with-test-prefix "inum/frac"
2394 (pass-if (< -2 9/4))
2395 (pass-if (< -2 7/4))
2396 (pass-if (< -2 -7/4))
2397 (pass-if (eq? #f (< 2 7/4)))
2398 (pass-if (eq? #f (< 2 -7/4)))
2399 (pass-if (eq? #f (< 2 -9/4)))
2400 (pass-if (eq? #f (< -2 -9/4))))
2402 (with-test-prefix "bignum/frac"
2403 (let ((x (ash 1 2048)))
2404 (pass-if (< x (* 4/3 x)))
2405 (pass-if (< (- x) (* 4/3 x)))
2406 (pass-if (< (- x) (* 2/3 x)))
2407 (pass-if (< (- x) (* -2/3 x)))
2408 (pass-if (eq? #f (< x (* 2/3 x))))
2409 (pass-if (eq? #f (< x (* -2/3 x))))
2410 (pass-if (eq? #f (< x (* -4/3 x))))
2411 (pass-if (eq? #f (< (- x) (* -4/3 x))))))
2413 (with-test-prefix "flonum/frac"
2414 (pass-if (< 0.75 4/3))
2415 (pass-if (< -0.75 4/3))
2416 (pass-if (< -0.75 2/3))
2417 (pass-if (< -0.75 -2/3))
2418 (pass-if (eq? #f (< 0.75 2/3)))
2419 (pass-if (eq? #f (< 0.75 -2/3)))
2420 (pass-if (eq? #f (< 0.75 -4/3)))
2421 (pass-if (eq? #f (< -0.75 -4/3)))
2423 (pass-if (< -inf.0 4/3))
2424 (pass-if (< -inf.0 -4/3))
2425 (pass-if (eq? #f (< +inf.0 4/3)))
2426 (pass-if (eq? #f (< +inf.0 -4/3)))
2428 (pass-if (eq? #f (< +nan.0 4/3)))
2429 (pass-if (eq? #f (< +nan.0 -4/3))))
2431 (with-test-prefix "frac/inum"
2433 (pass-if (< -7/4 2))
2434 (pass-if (< -9/4 2))
2435 (pass-if (< -9/4 -2))
2436 (pass-if (eq? #f (< 9/4 2)))
2437 (pass-if (eq? #f (< 9/4 -2)))
2438 (pass-if (eq? #f (< 7/4 -2)))
2439 (pass-if (eq? #f (< -7/4 -2))))
2441 (with-test-prefix "frac/bignum"
2442 (let ((x (ash 1 2048)))
2443 (pass-if (< (* 2/3 x) x))
2444 (pass-if (< (* -2/3 x) x))
2445 (pass-if (< (* -4/3 x) x))
2446 (pass-if (< (* -4/3 x) (- x)))
2447 (pass-if (eq? #f (< (* 4/3 x) x)))
2448 (pass-if (eq? #f (< (* 4/3 x) (- x))))
2449 (pass-if (eq? #f (< (* 2/3 x) (- x))))
2450 (pass-if (eq? #f (< (* -2/3 x) (- x))))))
2452 (with-test-prefix "frac/flonum"
2453 (pass-if (< 2/3 0.75))
2454 (pass-if (< -2/3 0.75))
2455 (pass-if (< -4/3 0.75))
2456 (pass-if (< -4/3 -0.75))
2457 (pass-if (eq? #f (< 4/3 0.75)))
2458 (pass-if (eq? #f (< 4/3 -0.75)))
2459 (pass-if (eq? #f (< 2/3 -0.75)))
2460 (pass-if (eq? #f (< -2/3 -0.75)))
2462 (pass-if (< 4/3 +inf.0))
2463 (pass-if (< -4/3 +inf.0))
2464 (pass-if (eq? #f (< 4/3 -inf.0)))
2465 (pass-if (eq? #f (< -4/3 -inf.0)))
2467 (pass-if (eq? #f (< 4/3 +nan.0)))
2468 (pass-if (eq? #f (< -4/3 +nan.0))))
2470 (with-test-prefix "frac/frac"
2471 (pass-if (< 2/3 6/7))
2472 (pass-if (< -2/3 6/7))
2473 (pass-if (< -4/3 6/7))
2474 (pass-if (< -4/3 -6/7))
2475 (pass-if (eq? #f (< 4/3 6/7)))
2476 (pass-if (eq? #f (< 4/3 -6/7)))
2477 (pass-if (eq? #f (< 2/3 -6/7)))
2478 (pass-if (eq? #f (< -2/3 -6/7)))))
2484 ;; currently not tested -- implementation is trivial
2485 ;; (> x y) is implemented as (< y x)
2486 ;; FIXME: tests should probably be added in case we change implementation.
2492 ;; currently not tested -- implementation is trivial
2493 ;; (<= x y) is implemented as (not (< y x))
2494 ;; FIXME: tests should probably be added in case we change implementation.
2500 ;; currently not tested -- implementation is trivial
2501 ;; (>= x y) is implemented as (not (< x y))
2502 ;; FIXME: tests should probably be added in case we change implementation.
2508 (with-test-prefix "zero?"
2509 (pass-if (documented? zero?))
2512 (pass-if (zero? 0.0))
2513 (pass-if (zero? -0.0))
2515 (pass-if (zero? 0.0+0.0i))
2516 (pass-if (zero? 0.0-0.0i))
2517 (pass-if (zero? 0.0+0.0i))
2518 (pass-if (zero? -0.0-0.0i))
2520 (pass-if (not (zero? 7)))
2521 (pass-if (not (zero? -7)))
2522 (pass-if (not (zero? 1/7)))
2523 (pass-if (not (zero? -inf.0)))
2524 (pass-if (not (zero? +inf.0)))
2525 (pass-if (not (zero? +nan.0)))
2526 (pass-if (not (zero? (+ 1 fixnum-max))))
2527 (pass-if (not (zero? (- 1 fixnum-min))))
2528 (pass-if (not (zero? 1.3)))
2529 (pass-if (not (zero? 3.1+4.2i)))
2530 (pass-if (not (zero? 1.0+0.0i)))
2531 (pass-if (not (zero? 0.0-1.0i))))
2537 (with-test-prefix "positive?"
2538 (pass-if (documented? positive?))
2539 (pass-if (positive? 1))
2540 (pass-if (positive? (+ fixnum-max 1)))
2541 (pass-if (positive? 1.3))
2542 (pass-if (not (positive? 0)))
2543 (pass-if (not (positive? -1)))
2544 (pass-if (not (positive? (- fixnum-min 1))))
2545 (pass-if (not (positive? -1.3))))
2551 (with-test-prefix "negative?"
2552 (pass-if (documented? negative?))
2553 (pass-if (not (negative? 1)))
2554 (pass-if (not (negative? (+ fixnum-max 1))))
2555 (pass-if (not (negative? 1.3)))
2556 (pass-if (not (negative? 0)))
2557 (pass-if (negative? -1))
2558 (pass-if (negative? (- fixnum-min 1)))
2559 (pass-if (negative? -1.3)))
2565 (with-test-prefix "max"
2566 (pass-if-exception "no args" exception:wrong-num-args
2569 (pass-if-exception "one complex" exception:wrong-type-arg
2572 (pass-if-exception "inum/complex" exception:wrong-type-arg
2574 (pass-if-exception "big/complex" exception:wrong-type-arg
2575 (max 9999999999999999999999999999999999999999 1+i))
2576 (pass-if-exception "real/complex" exception:wrong-type-arg
2578 (pass-if-exception "frac/complex" exception:wrong-type-arg
2581 (pass-if-exception "complex/inum" exception:wrong-type-arg
2583 (pass-if-exception "complex/big" exception:wrong-type-arg
2584 (max 1+i 9999999999999999999999999999999999999999))
2585 (pass-if-exception "complex/real" exception:wrong-type-arg
2587 (pass-if-exception "complex/frac" exception:wrong-type-arg
2590 (let ((big*2 (* fixnum-max 2))
2591 (big*3 (* fixnum-max 3))
2592 (big*4 (* fixnum-max 4))
2593 (big*5 (* fixnum-max 5)))
2595 (with-test-prefix "inum / frac"
2596 (pass-if (eqv? 3 (max 3 5/2)))
2597 (pass-if (eqv? 5/2 (max 2 5/2))))
2599 (with-test-prefix "frac / inum"
2600 (pass-if (eqv? 3 (max 5/2 3)))
2601 (pass-if (eqv? 5/2 (max 5/2 2))))
2603 (with-test-prefix "infinities and NaNs"
2604 ;; +inf.0 beats everything else, including NaNs
2605 (pass-if (eqv? +inf.0 (max +inf.0 123 )))
2606 (pass-if (eqv? +inf.0 (max 123 +inf.0 )))
2607 (pass-if (eqv? +inf.0 (max +inf.0 -123.3 )))
2608 (pass-if (eqv? +inf.0 (max -123.3 +inf.0 )))
2609 (pass-if (eqv? +inf.0 (max +inf.0 -7/2 )))
2610 (pass-if (eqv? +inf.0 (max -7/2 +inf.0 )))
2611 (pass-if (eqv? +inf.0 (max +inf.0 -1e20 )))
2612 (pass-if (eqv? +inf.0 (max -1e20 +inf.0 )))
2613 (pass-if (eqv? +inf.0 (max +inf.0 (- big*2))))
2614 (pass-if (eqv? +inf.0 (max (- big*2) +inf.0 )))
2615 (pass-if (eqv? +inf.0 (max +inf.0 +inf.0 )))
2616 (pass-if (eqv? +inf.0 (max +inf.0 +inf.0 )))
2617 (pass-if (eqv? +inf.0 (max +inf.0 +nan.0 )))
2618 (pass-if (eqv? +inf.0 (max +nan.0 +inf.0 )))
2619 (pass-if (eqv? +inf.0 (max +inf.0 +inf.0 )))
2621 ;; NaNs beat everything except +inf.0
2622 (pass-if (real-nan? (max +nan.0 123 )))
2623 (pass-if (real-nan? (max 123 +nan.0 )))
2624 (pass-if (real-nan? (max +nan.0 123.3 )))
2625 (pass-if (real-nan? (max 123.3 +nan.0 )))
2626 (pass-if (real-nan? (max +nan.0 -7/2 )))
2627 (pass-if (real-nan? (max -7/2 +nan.0 )))
2628 (pass-if (real-nan? (max +nan.0 -1e20 )))
2629 (pass-if (real-nan? (max -1e20 +nan.0 )))
2630 (pass-if (real-nan? (max +nan.0 (- big*2))))
2631 (pass-if (real-nan? (max (- big*2) +nan.0 )))
2632 (pass-if (real-nan? (max +nan.0 -inf.0 )))
2633 (pass-if (real-nan? (max -inf.0 +nan.0 )))
2634 (pass-if (real-nan? (max +nan.0 +nan.0 )))
2636 ;; -inf.0 always loses, except against itself
2637 (pass-if (eqv? -inf.0 (max -inf.0 -inf.0 )))
2638 (pass-if (eqv? -123.0 (max -inf.0 -123 )))
2639 (pass-if (eqv? -123.0 (max -123 -inf.0 )))
2640 (pass-if (eqv? -123.3 (max -inf.0 -123.3 )))
2641 (pass-if (eqv? -123.3 (max -123.3 -inf.0 )))
2642 (pass-if (eqv? -3.5 (max -inf.0 -7/2 )))
2643 (pass-if (eqv? -3.5 (max -7/2 -inf.0 )))
2644 (pass-if (eqv? -1.0e20 (max -inf.0 -1e20 )))
2645 (pass-if (eqv? -1.0e20 (max -1e20 -inf.0 )))
2646 (pass-if (eqv? (exact->inexact (- big*2))
2647 (max -inf.0 (- big*2))))
2648 (pass-if (eqv? (exact->inexact (- big*2))
2649 (max (- big*2) -inf.0 ))))
2651 (with-test-prefix "signed zeroes"
2652 (pass-if (eqv? 0.0 (max 0.0 0.0)))
2653 (pass-if (eqv? 0.0 (max 0.0 -0.0)))
2654 (pass-if (eqv? 0.0 (max -0.0 0.0)))
2655 (pass-if (eqv? -0.0 (max -0.0 -0.0)))
2656 (pass-if (eqv? 0.0 (max -0.0 0 )))
2657 (pass-if (eqv? 0.0 (max 0.0 0 )))
2658 (pass-if (eqv? 0.0 (max 0 -0.0)))
2659 (pass-if (eqv? 0.0 (max 0 0.0)))
2660 (pass-if (eqv? 0 (min 0 0 ))))
2662 (with-test-prefix "big / frac"
2663 (pass-if (eqv? big*2 (max big*2 5/2)))
2664 (pass-if (eqv? 5/2 (max (- big*2) 5/2))))
2666 (with-test-prefix "frac / big"
2667 (pass-if (eqv? big*2 (max 5/2 big*2)))
2668 (pass-if (eqv? 5/2 (max 5/2 (- big*2)))))
2670 (with-test-prefix "big / real"
2671 (pass-if (real-nan? (max big*5 +nan.0)))
2672 (pass-if (eqv? (exact->inexact big*5) (max big*5 -inf.0)))
2673 (pass-if (eqv? (exact->inexact big*5) (max big*5 1.0)))
2674 (pass-if (eqv? +inf.0 (max big*5 +inf.0)))
2675 (pass-if (eqv? 1.0 (max (- big*5) 1.0))))
2677 (with-test-prefix "real / big"
2678 (pass-if (real-nan? (max +nan.0 big*5)))
2679 (pass-if (eqv? (exact->inexact big*5) (max -inf.0 big*5)))
2680 (pass-if (eqv? (exact->inexact big*5) (max 1.0 big*5)))
2681 (pass-if (eqv? +inf.0 (max +inf.0 big*5)))
2682 (pass-if (eqv? 1.0 (max 1.0 (- big*5)))))
2684 (with-test-prefix "frac / frac"
2685 (pass-if (eqv? 2/3 (max 1/2 2/3)))
2686 (pass-if (eqv? 2/3 (max 2/3 1/2)))
2687 (pass-if (eqv? -1/2 (max -1/2 -2/3)))
2688 (pass-if (eqv? -1/2 (max -2/3 -1/2))))
2690 (with-test-prefix "real / real"
2691 (pass-if (real-nan? (max 123.0 +nan.0)))
2692 (pass-if (real-nan? (max +nan.0 123.0)))
2693 (pass-if (real-nan? (max +nan.0 +nan.0)))
2694 (pass-if (eqv? 456.0 (max 123.0 456.0)))
2695 (pass-if (eqv? 456.0 (max 456.0 123.0)))))
2697 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
2698 ;; sure we've avoided that
2699 (for-each (lambda (b)
2700 (pass-if (list b +inf.0)
2701 (eqv? +inf.0 (max b +inf.0)))
2702 (pass-if (list +inf.0 b)
2703 (eqv? +inf.0 (max b +inf.0)))
2704 (pass-if (list b -inf.0)
2705 (eqv? (exact->inexact b) (max b -inf.0)))
2706 (pass-if (list -inf.0 b)
2707 (eqv? (exact->inexact b) (max b -inf.0))))
2708 (list (1- (ash 1 1024))
2711 (- (1- (ash 1 1024)))
2713 (- (1+ (ash 1 1024)))))
2715 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
2716 ;; sure we've avoided that
2717 (pass-if (real-nan? (max (ash 1 2048) +nan.0)))
2718 (pass-if (real-nan? (max +nan.0 (ash 1 2048)))))
2724 ;; FIXME: unfinished...
2726 (with-test-prefix "min"
2727 (pass-if-exception "no args" exception:wrong-num-args
2730 (pass-if-exception "one complex" exception:wrong-type-arg
2733 (pass-if-exception "inum/complex" exception:wrong-type-arg
2735 (pass-if-exception "big/complex" exception:wrong-type-arg
2736 (min 9999999999999999999999999999999999999999 1+i))
2737 (pass-if-exception "real/complex" exception:wrong-type-arg
2739 (pass-if-exception "frac/complex" exception:wrong-type-arg
2742 (pass-if-exception "complex/inum" exception:wrong-type-arg
2744 (pass-if-exception "complex/big" exception:wrong-type-arg
2745 (min 1+i 9999999999999999999999999999999999999999))
2746 (pass-if-exception "complex/real" exception:wrong-type-arg
2748 (pass-if-exception "complex/frac" exception:wrong-type-arg
2751 (let ((big*2 (* fixnum-max 2))
2752 (big*3 (* fixnum-max 3))
2753 (big*4 (* fixnum-max 4))
2754 (big*5 (* fixnum-max 5)))
2756 (pass-if (documented? min))
2757 (pass-if (eqv? 1 (min 7 3 1 5)))
2758 (pass-if (eqv? 1 (min 1 7 3 5)))
2759 (pass-if (eqv? 1 (min 7 3 5 1)))
2760 (pass-if (eqv? -7 (min 2 3 4 -2 5 -7 1 -1 4 2)))
2761 (pass-if (eqv? -7 (min -7 2 3 4 -2 5 1 -1 4 2)))
2762 (pass-if (eqv? -7 (min 2 3 4 -2 5 1 -1 4 2 -7)))
2763 (pass-if (eqv? big*2 (min big*3 big*5 big*2 big*4)))
2764 (pass-if (eqv? big*2 (min big*2 big*3 big*5 big*4)))
2765 (pass-if (eqv? big*2 (min big*3 big*5 big*4 big*2)))
2767 (eqv? (- fixnum-min 1) (min 2 4 (- fixnum-min 1) 3 (* 2 fixnum-max))))
2769 (eqv? (- fixnum-min 1) (min (- fixnum-min 1) 2 4 3 (* 2 fixnum-max))))
2771 (eqv? (- fixnum-min 1) (min 2 4 3 (* 2 fixnum-max) (- fixnum-min 1))))
2773 (with-test-prefix "inum / frac"
2774 (pass-if (eqv? 5/2 (min 3 5/2)))
2775 (pass-if (eqv? 2 (min 2 5/2))))
2777 (with-test-prefix "frac / inum"
2778 (pass-if (eqv? 5/2 (min 5/2 3)))
2779 (pass-if (eqv? 2 (min 5/2 2))))
2781 (with-test-prefix "infinities and NaNs"
2782 ;; -inf.0 beats everything else, including NaNs
2783 (pass-if (eqv? -inf.0 (min -inf.0 123 )))
2784 (pass-if (eqv? -inf.0 (min 123 -inf.0 )))
2785 (pass-if (eqv? -inf.0 (min -inf.0 -123.3 )))
2786 (pass-if (eqv? -inf.0 (min -123.3 -inf.0 )))
2787 (pass-if (eqv? -inf.0 (min -inf.0 -7/2 )))
2788 (pass-if (eqv? -inf.0 (min -7/2 -inf.0 )))
2789 (pass-if (eqv? -inf.0 (min -inf.0 -1e20 )))
2790 (pass-if (eqv? -inf.0 (min -1e20 -inf.0 )))
2791 (pass-if (eqv? -inf.0 (min -inf.0 (- big*2))))
2792 (pass-if (eqv? -inf.0 (min (- big*2) -inf.0 )))
2793 (pass-if (eqv? -inf.0 (min -inf.0 +inf.0 )))
2794 (pass-if (eqv? -inf.0 (min +inf.0 -inf.0 )))
2795 (pass-if (eqv? -inf.0 (min -inf.0 +nan.0 )))
2796 (pass-if (eqv? -inf.0 (min +nan.0 -inf.0 )))
2797 (pass-if (eqv? -inf.0 (min -inf.0 -inf.0 )))
2799 ;; NaNs beat everything except -inf.0
2800 (pass-if (real-nan? (min +nan.0 123 )))
2801 (pass-if (real-nan? (min 123 +nan.0 )))
2802 (pass-if (real-nan? (min +nan.0 123.3 )))
2803 (pass-if (real-nan? (min 123.3 +nan.0 )))
2804 (pass-if (real-nan? (min +nan.0 -7/2 )))
2805 (pass-if (real-nan? (min -7/2 +nan.0 )))
2806 (pass-if (real-nan? (min +nan.0 -1e20 )))
2807 (pass-if (real-nan? (min -1e20 +nan.0 )))
2808 (pass-if (real-nan? (min +nan.0 (- big*2))))
2809 (pass-if (real-nan? (min (- big*2) +nan.0 )))
2810 (pass-if (real-nan? (min +nan.0 +inf.0 )))
2811 (pass-if (real-nan? (min +inf.0 +nan.0 )))
2812 (pass-if (real-nan? (min +nan.0 +nan.0 )))
2814 ;; +inf.0 always loses, except against itself
2815 (pass-if (eqv? +inf.0 (min +inf.0 +inf.0 )))
2816 (pass-if (eqv? -123.0 (min +inf.0 -123 )))
2817 (pass-if (eqv? -123.0 (min -123 +inf.0 )))
2818 (pass-if (eqv? -123.3 (min +inf.0 -123.3 )))
2819 (pass-if (eqv? -123.3 (min -123.3 +inf.0 )))
2820 (pass-if (eqv? -3.5 (min +inf.0 -7/2 )))
2821 (pass-if (eqv? -3.5 (min -7/2 +inf.0 )))
2822 (pass-if (eqv? -1.0e20 (min +inf.0 -1e20 )))
2823 (pass-if (eqv? -1.0e20 (min -1e20 +inf.0 )))
2824 (pass-if (eqv? (exact->inexact (- big*2))
2825 (min +inf.0 (- big*2))))
2826 (pass-if (eqv? (exact->inexact (- big*2))
2827 (min (- big*2) +inf.0 ))))
2829 (with-test-prefix "signed zeroes"
2830 (pass-if (eqv? 0.0 (min 0.0 0.0)))
2831 (pass-if (eqv? -0.0 (min 0.0 -0.0)))
2832 (pass-if (eqv? -0.0 (min -0.0 0.0)))
2833 (pass-if (eqv? -0.0 (min -0.0 -0.0)))
2834 (pass-if (eqv? -0.0 (min -0.0 0 )))
2835 (pass-if (eqv? 0.0 (min 0.0 0 )))
2836 (pass-if (eqv? -0.0 (min 0 -0.0)))
2837 (pass-if (eqv? 0.0 (min 0 0.0)))
2838 (pass-if (eqv? 0 (min 0 0 ))))
2840 (with-test-prefix "big / frac"
2841 (pass-if (eqv? 5/2 (min big*2 5/2)))
2842 (pass-if (eqv? (- big*2) (min (- big*2) 5/2))))
2844 (with-test-prefix "frac / big"
2845 (pass-if (eqv? 5/2 (min 5/2 big*2)))
2846 (pass-if (eqv? (- big*2) (min 5/2 (- big*2)))))
2848 (with-test-prefix "big / real"
2849 (pass-if (real-nan? (min big*5 +nan.0)))
2850 (pass-if (eqv? (exact->inexact big*5) (min big*5 +inf.0)))
2851 (pass-if (eqv? -inf.0 (min big*5 -inf.0)))
2852 (pass-if (eqv? 1.0 (min big*5 1.0)))
2853 (pass-if (eqv? (exact->inexact (- big*5)) (min (- big*5) 1.0))))
2855 (with-test-prefix "real / big"
2856 (pass-if (real-nan? (min +nan.0 big*5)))
2857 (pass-if (eqv? (exact->inexact big*5) (min +inf.0 big*5)))
2858 (pass-if (eqv? -inf.0 (min -inf.0 big*5)))
2859 (pass-if (eqv? 1.0 (min 1.0 big*5)))
2860 (pass-if (eqv? (exact->inexact (- big*5)) (min 1.0 (- big*5)))))
2862 (with-test-prefix "frac / frac"
2863 (pass-if (eqv? 1/2 (min 1/2 2/3)))
2864 (pass-if (eqv? 1/2 (min 2/3 1/2)))
2865 (pass-if (eqv? -2/3 (min -1/2 -2/3)))
2866 (pass-if (eqv? -2/3 (min -2/3 -1/2))))
2868 (with-test-prefix "real / real"
2869 (pass-if (real-nan? (min 123.0 +nan.0)))
2870 (pass-if (real-nan? (min +nan.0 123.0)))
2871 (pass-if (real-nan? (min +nan.0 +nan.0)))
2872 (pass-if (eqv? 123.0 (min 123.0 456.0)))
2873 (pass-if (eqv? 123.0 (min 456.0 123.0)))))
2876 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
2877 ;; sure we've avoided that
2878 (for-each (lambda (b)
2879 (pass-if (list b +inf.0)
2880 (eqv? (exact->inexact b) (min b +inf.0)))
2881 (pass-if (list +inf.0 b)
2882 (eqv? (exact->inexact b) (min b +inf.0)))
2883 (pass-if (list b -inf.0)
2884 (eqv? -inf.0 (min b -inf.0)))
2885 (pass-if (list -inf.0 b)
2886 (eqv? -inf.0 (min b -inf.0))))
2887 (list (1- (ash 1 1024))
2890 (- (1- (ash 1 1024)))
2892 (- (1+ (ash 1 1024)))))
2894 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
2895 ;; sure we've avoided that
2896 (pass-if (real-nan? (min (- (ash 1 2048)) (- +nan.0))))
2897 (pass-if (real-nan? (min (- +nan.0) (- (ash 1 2048))))))
2903 (with-test-prefix/c&e "+"
2905 (pass-if "documented?"
2909 (and (eqv? 7 (+ 3 4))
2913 (pass-if "exactness propagation"
2914 (and (eqv? 8 (+ 3 5))
2915 (eqv? 8.0 (+ 3 5.0))
2916 (eqv? 8.0 (+ 3.0 5))
2917 (eqv? 8.0 (+ 3.0 5.0))
2919 (eqv? 5/6 (+ 1/2 1/3))
2920 (eqv? 5.5 (+ 1/2 5.0))
2921 (eqv? 3.25 (+ 3.0 1/4))))
2923 (pass-if "signed zeroes"
2924 (and (eqv? 0.0 (+ 0.0))
2925 (eqv? -0.0 (+ -0.0))
2926 (eqv? 0.0 (+ 0.0 0.0))
2927 (eqv? 0.0 (+ 0.0 -0.0))
2928 (eqv? 0.0 (+ -0.0 0.0))
2929 (eqv? -0.0 (+ -0.0 -0.0))))
2932 (and (real-nan? (+ +nan.0 +nan.0))
2933 (real-nan? (+ 0 +nan.0))
2934 (real-nan? (+ +nan.0 0))
2935 (real-nan? (+ 1 +nan.0))
2936 (real-nan? (+ +nan.0 1))
2937 (real-nan? (+ -1 +nan.0))
2938 (real-nan? (+ +nan.0 -1))
2939 (real-nan? (+ -7/2 +nan.0))
2940 (real-nan? (+ +nan.0 -7/2))
2941 (real-nan? (+ 1e20 +nan.0))
2942 (real-nan? (+ +nan.0 1e20))
2943 (real-nan? (+ +inf.0 +nan.0))
2944 (real-nan? (+ +nan.0 +inf.0))
2945 (real-nan? (+ -inf.0 +nan.0))
2946 (real-nan? (+ +nan.0 -inf.0))
2947 (real-nan? (+ (* fixnum-max 2) +nan.0))
2948 (real-nan? (+ +nan.0 (* fixnum-max 2)))))
2950 (pass-if "infinities"
2951 (and (eqv? +inf.0 (+ +inf.0 +inf.0))
2952 (eqv? -inf.0 (+ -inf.0 -inf.0))
2953 (real-nan? (+ +inf.0 -inf.0))
2954 (real-nan? (+ -inf.0 +inf.0))))
2956 ;; The maximum fixnum on a 32-bit architecture: 2^29 - 1.
2957 (pass-if "fixnum + fixnum = bignum (32-bit)"
2958 (eqv? 536870912 (+ 536870910 2)))
2960 ;; The maximum fixnum on a 64-bit architecture: 2^61 - 1.
2961 (pass-if "fixnum + fixnum = bignum (64-bit)"
2962 (eqv? 2305843009213693952 (+ 2305843009213693950 2)))
2964 (pass-if "bignum + fixnum = fixnum"
2965 (eqv? 0 (+ (1+ most-positive-fixnum) most-negative-fixnum))))
2971 (with-test-prefix/c&e "-"
2973 (pass-if "double-negation of fixnum-min: ="
2974 (= fixnum-min (- (- fixnum-min))))
2975 (pass-if "double-negation of fixnum-min: eqv?"
2976 (eqv? fixnum-min (- (- fixnum-min))))
2977 (pass-if "double-negation of fixnum-min: equal?"
2978 (equal? fixnum-min (- (- fixnum-min))))
2980 (pass-if "binary double-negation of fixnum-min: ="
2981 (= fixnum-min (- 0 (- 0 fixnum-min))))
2982 (pass-if "binary double-negation of fixnum-min: eqv?"
2983 (eqv? fixnum-min (- 0 (- 0 fixnum-min))))
2984 (pass-if "binary double-negation of fixnum-min: equal?"
2985 (equal? fixnum-min (- 0 (- 0 fixnum-min))))
2987 (pass-if "signed zeroes"
2988 (and (eqv? +0.0 (- -0.0))
2989 (eqv? -0.0 (- +0.0))
2990 (eqv? 0.0 (- 0.0 0.0))
2991 (eqv? 0.0 (- 0.0 -0.0))
2992 (eqv? 0.0 (- -0.0 -0.0))
2993 (eqv? -0.0 (- -0.0 0.0))))
2995 (pass-if "exactness propagation"
2996 (and (eqv? 3 (- 8 5))
2997 (eqv? 3.0 (- 8 5.0))
2998 (eqv? 3.0 (- 8.0 5))
2999 (eqv? 3.0 (- 8.0 5.0))
3000 (eqv? -1/6 (- 1/3 1/2))
3001 (eqv? -4.5 (- 1/2 5.0))
3002 (eqv? 2.75 (- 3.0 1/4))))
3004 (pass-if "infinities"
3005 (and (eqv? +inf.0 (- +inf.0 -inf.0))
3006 (eqv? -inf.0 (- -inf.0 +inf.0))
3007 (real-nan? (- +inf.0 +inf.0))
3008 (real-nan? (- -inf.0 -inf.0))))
3011 (and (real-nan? (- +nan.0 +nan.0))
3012 (real-nan? (- 0 +nan.0))
3013 (real-nan? (- +nan.0 0))
3014 (real-nan? (- 1 +nan.0))
3015 (real-nan? (- +nan.0 1))
3016 (real-nan? (- -1 +nan.0))
3017 (real-nan? (- +nan.0 -1))
3018 (real-nan? (- -7/2 +nan.0))
3019 (real-nan? (- +nan.0 -7/2))
3020 (real-nan? (- 1e20 +nan.0))
3021 (real-nan? (- +nan.0 1e20))
3022 (real-nan? (- +inf.0 +nan.0))
3023 (real-nan? (- +nan.0 +inf.0))
3024 (real-nan? (- -inf.0 +nan.0))
3025 (real-nan? (- +nan.0 -inf.0))
3026 (real-nan? (- (* fixnum-max 2) +nan.0))
3027 (real-nan? (- +nan.0 (* fixnum-max 2)))))
3029 (pass-if "(eqv? fixnum-min (- (- fixnum-min)))"
3030 (eqv? fixnum-min (- (- fixnum-min))))
3031 (pass-if "(eqv? fixnum-min (- 0 (- 0 fixnum-min)))"
3032 (eqv? fixnum-min (- 0 (- 0 fixnum-min))))
3033 (pass-if "(eqv? fixnum-num (apply - (list (apply - (list fixnum-min)))))"
3034 (eqv? fixnum-min (apply - (list (apply - (list fixnum-min))))))
3036 (pass-if "-inum - +bignum"
3037 (= #x-100000000000000000000000000000001
3038 (- -1 #x100000000000000000000000000000000)))
3040 (pass-if "big - inum"
3041 (= #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
3042 (- #x100000000000000000000000000000000 1)))
3044 (pass-if "big - -inum"
3045 (= #x100000000000000000000000000000001
3046 (- #x100000000000000000000000000000000 -1)))
3048 ;; The mininum fixnum on a 32-bit architecture: -2^29.
3049 (pass-if "fixnum - fixnum = bignum (32-bit)"
3050 (eqv? -536870912 (- -536870910 2)))
3052 ;; The minimum fixnum on a 64-bit architecture: -2^61.
3053 (pass-if "fixnum - fixnum = bignum (64-bit)"
3054 (eqv? -2305843009213693952 (- -2305843009213693950 2)))
3056 (pass-if "bignum - fixnum = fixnum"
3057 (eqv? most-positive-fixnum (- (1+ most-positive-fixnum) 1))))
3063 (with-test-prefix "*"
3065 (with-test-prefix "double-negation of fixnum-min"
3066 (pass-if (= fixnum-min (* -1 (* -1 fixnum-min))))
3067 (pass-if (eqv? fixnum-min (* -1 (* -1 fixnum-min))))
3068 (pass-if (equal? fixnum-min (* -1 (* -1 fixnum-min))))
3069 (pass-if (= fixnum-min (* (* fixnum-min -1) -1)))
3070 (pass-if (eqv? fixnum-min (* (* fixnum-min -1) -1)))
3071 (pass-if (equal? fixnum-min (* (* fixnum-min -1) -1))))
3073 (with-test-prefix "signed zeroes"
3074 (pass-if (eqv? +0.0 (* +0.0 +0.0)))
3075 (pass-if (eqv? -0.0 (* -0.0 +0.0)))
3076 (pass-if (eqv? +0.0 (* -0.0 -0.0)))
3077 (pass-if (eqv? -0.0 (* +0.0 -0.0)))
3078 (pass-if (eqv? +0.0+0.0i (* +i +0.0)))
3079 (pass-if (eqv? +0.0-0.0i (* -i +0.0)))
3080 (pass-if (eqv? -0.0-0.0i (* +i -0.0)))
3081 (pass-if (eqv? -0.0+0.0i (* -i -0.0))))
3083 (with-test-prefix "exactness propagation"
3084 (pass-if (eqv? -0.0 (* 0 -1.0 )))
3085 (pass-if (eqv? 0.0 (* 0 1.0 )))
3086 (pass-if (eqv? -0.0 (* -1.0 0 )))
3087 (pass-if (eqv? 0.0 (* 1.0 0 )))
3088 (pass-if (eqv? 0 (* 0 1/2 )))
3089 (pass-if (eqv? 0 (* 1/2 0 )))
3090 (pass-if (eqv? 0.0+0.0i (* 0 1+i )))
3091 (pass-if (eqv? 0.0+0.0i (* 1+i 0 )))
3092 (pass-if (eqv? -1.0 (* 1 -1.0 )))
3093 (pass-if (eqv? 1.0 (* 1 1.0 )))
3094 (pass-if (eqv? -1.0 (* -1.0 1 )))
3095 (pass-if (eqv? 1.0 (* 1.0 1 )))
3096 (pass-if (eqv? 1/2 (* 1 1/2 )))
3097 (pass-if (eqv? 1/2 (* 1/2 1 )))
3098 (pass-if (eqv? 1+i (* 1 1+i )))
3099 (pass-if (eqv? 1+i (* 1+i 1 ))))
3101 (with-test-prefix "propagation of NaNs"
3102 (pass-if (real-nan? (* +nan.0 +nan.0)))
3103 (pass-if (real-nan? (* +nan.0 1 )))
3104 (pass-if (real-nan? (* +nan.0 -1 )))
3105 (pass-if (real-nan? (* +nan.0 -7/2 )))
3106 (pass-if (real-nan? (* +nan.0 1e20 )))
3107 (pass-if (real-nan? (* 1 +nan.0)))
3108 (pass-if (real-nan? (* -1 +nan.0)))
3109 (pass-if (real-nan? (* -7/2 +nan.0)))
3110 (pass-if (real-nan? (* 1e20 +nan.0)))
3111 (pass-if (real-nan? (* +inf.0 +nan.0)))
3112 (pass-if (real-nan? (* +nan.0 +inf.0)))
3113 (pass-if (real-nan? (* -inf.0 +nan.0)))
3114 (pass-if (real-nan? (* +nan.0 -inf.0)))
3115 (pass-if (real-nan? (* (* fixnum-max 2) +nan.0)))
3116 (pass-if (real-nan? (* +nan.0 (* fixnum-max 2))))
3118 (pass-if (real-nan? (* 0 +nan.0 )))
3119 (pass-if (real-nan? (* +nan.0 0 )))
3120 (pass-if (almost-real-nan? (* 0 +nan.0+i)))
3121 (pass-if (almost-real-nan? (* +nan.0+i 0 )))
3123 (pass-if (imaginary-nan? (* 0 +nan.0i )))
3124 (pass-if (imaginary-nan? (* +nan.0i 0 )))
3125 (pass-if (imaginary-nan? (* 0 1+nan.0i )))
3126 (pass-if (imaginary-nan? (* 1+nan.0i 0 )))
3128 (pass-if (complex-nan? (* 0 +nan.0+nan.0i )))
3129 (pass-if (complex-nan? (* +nan.0+nan.0i 0 ))))
3131 (with-test-prefix "infinities"
3132 (pass-if (eqv? +inf.0 (* +inf.0 5 )))
3133 (pass-if (eqv? -inf.0 (* +inf.0 -5 )))
3134 (pass-if (eqv? +inf.0 (* +inf.0 73.1)))
3135 (pass-if (eqv? -inf.0 (* +inf.0 -9.2)))
3136 (pass-if (eqv? +inf.0 (* +inf.0 5/2)))
3137 (pass-if (eqv? -inf.0 (* +inf.0 -5/2)))
3138 (pass-if (eqv? -inf.0 (* -5 +inf.0)))
3139 (pass-if (eqv? +inf.0 (* 73.1 +inf.0)))
3140 (pass-if (eqv? -inf.0 (* -9.2 +inf.0)))
3141 (pass-if (eqv? +inf.0 (* 5/2 +inf.0)))
3142 (pass-if (eqv? -inf.0 (* -5/2 +inf.0)))
3144 (pass-if (eqv? -inf.0 (* -inf.0 5 )))
3145 (pass-if (eqv? +inf.0 (* -inf.0 -5 )))
3146 (pass-if (eqv? -inf.0 (* -inf.0 73.1)))
3147 (pass-if (eqv? +inf.0 (* -inf.0 -9.2)))
3148 (pass-if (eqv? -inf.0 (* -inf.0 5/2)))
3149 (pass-if (eqv? +inf.0 (* -inf.0 -5/2)))
3150 (pass-if (eqv? +inf.0 (* -5 -inf.0)))
3151 (pass-if (eqv? -inf.0 (* 73.1 -inf.0)))
3152 (pass-if (eqv? +inf.0 (* -9.2 -inf.0)))
3153 (pass-if (eqv? -inf.0 (* 5/2 -inf.0)))
3154 (pass-if (eqv? +inf.0 (* -5/2 -inf.0)))
3156 (pass-if (real-nan? (* 0.0 +inf.0)))
3157 (pass-if (real-nan? (* -0.0 +inf.0)))
3158 (pass-if (real-nan? (* +inf.0 0.0)))
3159 (pass-if (real-nan? (* +inf.0 -0.0)))
3161 (pass-if (real-nan? (* 0.0 -inf.0)))
3162 (pass-if (real-nan? (* -0.0 -inf.0)))
3163 (pass-if (real-nan? (* -inf.0 0.0)))
3164 (pass-if (real-nan? (* -inf.0 -0.0)))
3166 (pass-if (real-nan? (* 0 +inf.0 )))
3167 (pass-if (real-nan? (* +inf.0 0 )))
3168 (pass-if (real-nan? (* 0 -inf.0 )))
3169 (pass-if (real-nan? (* -inf.0 0 )))
3171 (pass-if (almost-real-nan? (* 0 +inf.0+i)))
3172 (pass-if (almost-real-nan? (* +inf.0+i 0 )))
3173 (pass-if (almost-real-nan? (* 0 -inf.0+i)))
3174 (pass-if (almost-real-nan? (* -inf.0+i 0 )))
3176 (pass-if (imaginary-nan? (* 0 +inf.0i )))
3177 (pass-if (imaginary-nan? (* +inf.0i 0 )))
3178 (pass-if (imaginary-nan? (* 0 1+inf.0i )))
3179 (pass-if (imaginary-nan? (* 1+inf.0i 0 )))
3181 (pass-if (imaginary-nan? (* 0 -inf.0i )))
3182 (pass-if (imaginary-nan? (* -inf.0i 0 )))
3183 (pass-if (imaginary-nan? (* 0 1-inf.0i )))
3184 (pass-if (imaginary-nan? (* 1-inf.0i 0 )))
3186 (pass-if (complex-nan? (* 0 +inf.0+inf.0i )))
3187 (pass-if (complex-nan? (* +inf.0+inf.0i 0 )))
3189 (pass-if (complex-nan? (* 0 +inf.0-inf.0i )))
3190 (pass-if (complex-nan? (* -inf.0+inf.0i 0 ))))
3192 (with-test-prefix "inum * bignum"
3194 (pass-if "0 * 2^256 = 0"
3195 (eqv? 0 (* 0 (ash 1 256)))))
3197 (with-test-prefix "inum * flonum"
3199 (pass-if "0 * 1.0 = 0.0"
3200 (eqv? 0.0 (* 0 1.0))))
3202 (with-test-prefix "inum * complex"
3204 (pass-if "0 * 1+1i = 0.0+0.0i"
3205 (eqv? 0.0+0.0i (* 0 1+1i))))
3207 (with-test-prefix "inum * frac"
3209 (pass-if "0 * 2/3 = 0"
3210 (eqv? 0 (* 0 2/3))))
3212 (with-test-prefix "bignum * inum"
3214 (pass-if "2^256 * 0 = 0"
3215 (eqv? 0 (* (ash 1 256) 0))))
3217 (with-test-prefix "flonum * inum"
3218 (pass-if "1.0 * 0 = 0.0"
3219 (eqv? 0.0 (* 1.0 0))))
3221 (with-test-prefix "complex * inum"
3222 (pass-if "1+1i * 0 = 0.0+0.0i"
3223 (eqv? 0.0+0.0i (* 1+1i 0))))
3225 (pass-if "complex * bignum"
3226 (let ((big (ash 1 90)))
3227 (= (make-rectangular big big)
3230 (with-test-prefix "frac * inum"
3232 (pass-if "2/3 * 0 = 0"
3233 (eqv? 0 (* 2/3 0)))))
3239 (with-test-prefix "/"
3241 (with-test-prefix "double-negation of fixnum-min"
3242 (pass-if (= fixnum-min (/ (/ fixnum-min -1) -1)))
3243 (pass-if (eqv? fixnum-min (/ (/ fixnum-min -1) -1)))
3244 (pass-if (equal? fixnum-min (/ (/ fixnum-min -1) -1))))
3246 (pass-if "documented?"
3249 (with-test-prefix "division by zero"
3251 (pass-if-exception "(/ 0)"
3252 exception:numerical-overflow
3258 (pass-if-exception "(/ 1 0)"
3259 exception:numerical-overflow
3262 (pass-if "(/ 1 0.0)"
3263 (= +inf.0 (/ 1 0.0)))
3265 (pass-if-exception "(/ bignum 0)"
3266 exception:numerical-overflow
3267 (/ (+ fixnum-max 1) 0))
3269 (pass-if "(/ bignum 0.0)"
3270 (= +inf.0 (/ (+ fixnum-max 1) 0.0)))
3272 (pass-if-exception "(/ 1.0 0)"
3273 exception:numerical-overflow
3276 (pass-if "(/ 1.0 0.0)"
3277 (= +inf.0 (/ 1.0 0.0)))
3279 (pass-if-exception "(/ +i 0)"
3280 exception:numerical-overflow
3283 (pass-if "(/ +i 0.0)"
3284 (= +inf.0 (imag-part (/ +i 0.0)))))
3286 (with-test-prefix "1/complex"
3289 (eqv? 0-1i (/ 0+1i)))
3291 ;; in guile 1.6 through 1.6.7 this incorrectly resulted in nans
3293 (eqv? 0+1i (/ 0-1i)))
3296 (eqv? 0.5-0.5i (/ 1+1i)))
3299 (eqv? 0.5+0.5i (/ 1-1i)))
3302 (eqv? -0.5-0.5i (/ -1+1i)))
3305 (eqv? -0.5+0.5i (/ -1-1i)))
3308 (= (/ 3+4i) 0.12-0.16i))
3311 (= (/ 4+3i) 0.16-0.12i))
3313 (pass-if "(/ 1e200+1e200i)"
3314 (= (/ 1e200+1e200i) 5.0e-201-5.0e-201i)))
3316 (with-test-prefix "inum/complex"
3318 (pass-if "(/ 25 3+4i)"
3319 (= (/ 25 3+4i) 3.0-4.0i))
3321 (pass-if "(/ 25 4+3i)"
3322 (= (/ 25 4+3i) 4.0-3.0i)))
3324 (with-test-prefix "complex/complex"
3326 (pass-if "(/ 25+125i 3+4i)"
3327 (= (/ 25+125i 3+4i) 23.0+11.0i))
3329 (pass-if "(/ 25+125i 4+3i)"
3330 (= (/ 25+125i 4+3i) 19.0+17.0i))))
3336 (with-test-prefix "floor"
3337 (pass-if (= 1 (floor 1.75)))
3338 (pass-if (= 1 (floor 1.5)))
3339 (pass-if (= 1 (floor 1.25)))
3340 (pass-if (= 0 (floor 0.75)))
3341 (pass-if (= 0 (floor 0.5)))
3342 (pass-if (= 0 (floor 0.0)))
3343 (pass-if (= -1 (floor -0.5)))
3344 (pass-if (= -2 (floor -1.25)))
3345 (pass-if (= -2 (floor -1.5)))
3347 (with-test-prefix "inum"
3349 (and (= 0 (floor 0))
3350 (exact? (floor 0))))
3353 (and (= 1 (floor 1))
3354 (exact? (floor 1))))
3357 (and (= -1 (floor -1))
3358 (exact? (floor -1)))))
3360 (with-test-prefix "bignum"
3361 (let ((x (1+ most-positive-fixnum)))
3362 (pass-if "(1+ most-positive-fixnum)"
3363 (and (= x (floor x))
3364 (exact? (floor x)))))
3366 (let ((x (1- most-negative-fixnum)))
3367 (pass-if "(1- most-negative-fixnum)"
3368 (and (= x (floor x))
3369 (exact? (floor x))))))
3371 (with-test-prefix "frac"
3372 (define (=exact x y)
3376 (pass-if (=exact -3 (floor -7/3)))
3377 (pass-if (=exact -2 (floor -5/3)))
3378 (pass-if (=exact -2 (floor -4/3)))
3379 (pass-if (=exact -1 (floor -2/3)))
3380 (pass-if (=exact -1 (floor -1/3)))
3381 (pass-if (=exact 0 (floor 1/3)))
3382 (pass-if (=exact 0 (floor 2/3)))
3383 (pass-if (=exact 1 (floor 4/3)))
3384 (pass-if (=exact 1 (floor 5/3)))
3385 (pass-if (=exact 2 (floor 7/3)))
3387 (pass-if (=exact -3 (floor -17/6)))
3388 (pass-if (=exact -3 (floor -16/6)))
3389 (pass-if (=exact -3 (floor -15/6)))
3390 (pass-if (=exact -3 (floor -14/6)))
3391 (pass-if (=exact -3 (floor -13/6)))
3392 (pass-if (=exact -2 (floor -11/6)))
3393 (pass-if (=exact -2 (floor -10/6)))
3394 (pass-if (=exact -2 (floor -9/6)))
3395 (pass-if (=exact -2 (floor -8/6)))
3396 (pass-if (=exact -2 (floor -7/6)))
3397 (pass-if (=exact -1 (floor -5/6)))
3398 (pass-if (=exact -1 (floor -4/6)))
3399 (pass-if (=exact -1 (floor -3/6)))
3400 (pass-if (=exact -1 (floor -2/6)))
3401 (pass-if (=exact -1 (floor -1/6)))
3402 (pass-if (=exact 0 (floor 1/6)))
3403 (pass-if (=exact 0 (floor 2/6)))
3404 (pass-if (=exact 0 (floor 3/6)))
3405 (pass-if (=exact 0 (floor 4/6)))
3406 (pass-if (=exact 0 (floor 5/6)))
3407 (pass-if (=exact 1 (floor 7/6)))
3408 (pass-if (=exact 1 (floor 8/6)))
3409 (pass-if (=exact 1 (floor 9/6)))
3410 (pass-if (=exact 1 (floor 10/6)))
3411 (pass-if (=exact 1 (floor 11/6)))
3412 (pass-if (=exact 2 (floor 13/6)))
3413 (pass-if (=exact 2 (floor 14/6)))
3414 (pass-if (=exact 2 (floor 15/6)))
3415 (pass-if (=exact 2 (floor 16/6)))
3416 (pass-if (=exact 2 (floor 17/6))))
3418 (with-test-prefix "real"
3420 (and (= 0.0 (floor 0.0))
3421 (inexact? (floor 0.0))))
3424 (and (= 1.0 (floor 1.0))
3425 (inexact? (floor 1.0))))
3428 (and (= -1.0 (floor -1.0))
3429 (inexact? (floor -1.0))))
3432 (and (= -4.0 (floor -3.1))
3433 (inexact? (floor -3.1))))
3436 (and (= 3.0 (floor 3.1))
3437 (inexact? (floor 3.1))))
3440 (and (= 3.0 (floor 3.9))
3441 (inexact? (floor 3.9))))
3444 (and (= -4.0 (floor -3.9))
3445 (inexact? (floor -3.9))))
3448 (and (= 1.0 (floor 1.5))
3449 (inexact? (floor 1.5))))
3452 (and (= 2.0 (floor 2.5))
3453 (inexact? (floor 2.5))))
3456 (and (= 3.0 (floor 3.5))
3457 (inexact? (floor 3.5))))
3460 (and (= -2.0 (floor -1.5))
3461 (inexact? (floor -1.5))))
3464 (and (= -3.0 (floor -2.5))
3465 (inexact? (floor -2.5))))
3468 (and (= -4.0 (floor -3.5))
3469 (inexact? (floor -3.5))))))
3475 (with-test-prefix "ceiling"
3476 (pass-if (= 2 (ceiling 1.75)))
3477 (pass-if (= 2 (ceiling 1.5)))
3478 (pass-if (= 2 (ceiling 1.25)))
3479 (pass-if (= 1 (ceiling 0.75)))
3480 (pass-if (= 1 (ceiling 0.5)))
3481 (pass-if (= 0 (ceiling 0.0)))
3482 (pass-if (= 0 (ceiling -0.5)))
3483 (pass-if (= -1 (ceiling -1.25)))
3484 (pass-if (= -1 (ceiling -1.5)))
3486 (with-test-prefix "inum"
3488 (and (= 0 (ceiling 0))
3489 (exact? (ceiling 0))))
3492 (and (= 1 (ceiling 1))
3493 (exact? (ceiling 1))))
3496 (and (= -1 (ceiling -1))
3497 (exact? (ceiling -1)))))
3499 (with-test-prefix "bignum"
3500 (let ((x (1+ most-positive-fixnum)))
3501 (pass-if "(1+ most-positive-fixnum)"
3502 (and (= x (ceiling x))
3503 (exact? (ceiling x)))))
3505 (let ((x (1- most-negative-fixnum)))
3506 (pass-if "(1- most-negative-fixnum)"
3507 (and (= x (ceiling x))
3508 (exact? (ceiling x))))))
3510 (with-test-prefix "frac"
3511 (define (=exact x y)
3515 (pass-if (=exact -2 (ceiling -7/3)))
3516 (pass-if (=exact -1 (ceiling -5/3)))
3517 (pass-if (=exact -1 (ceiling -4/3)))
3518 (pass-if (=exact 0 (ceiling -2/3)))
3519 (pass-if (=exact 0 (ceiling -1/3)))
3520 (pass-if (=exact 1 (ceiling 1/3)))
3521 (pass-if (=exact 1 (ceiling 2/3)))
3522 (pass-if (=exact 2 (ceiling 4/3)))
3523 (pass-if (=exact 2 (ceiling 5/3)))
3524 (pass-if (=exact 3 (ceiling 7/3)))
3526 (pass-if (=exact -2 (ceiling -17/6)))
3527 (pass-if (=exact -2 (ceiling -16/6)))
3528 (pass-if (=exact -2 (ceiling -15/6)))
3529 (pass-if (=exact -2 (ceiling -14/6)))
3530 (pass-if (=exact -2 (ceiling -13/6)))
3531 (pass-if (=exact -1 (ceiling -11/6)))
3532 (pass-if (=exact -1 (ceiling -10/6)))
3533 (pass-if (=exact -1 (ceiling -9/6)))
3534 (pass-if (=exact -1 (ceiling -8/6)))
3535 (pass-if (=exact -1 (ceiling -7/6)))
3536 (pass-if (=exact 0 (ceiling -5/6)))
3537 (pass-if (=exact 0 (ceiling -4/6)))
3538 (pass-if (=exact 0 (ceiling -3/6)))
3539 (pass-if (=exact 0 (ceiling -2/6)))
3540 (pass-if (=exact 0 (ceiling -1/6)))
3541 (pass-if (=exact 1 (ceiling 1/6)))
3542 (pass-if (=exact 1 (ceiling 2/6)))
3543 (pass-if (=exact 1 (ceiling 3/6)))
3544 (pass-if (=exact 1 (ceiling 4/6)))
3545 (pass-if (=exact 1 (ceiling 5/6)))
3546 (pass-if (=exact 2 (ceiling 7/6)))
3547 (pass-if (=exact 2 (ceiling 8/6)))
3548 (pass-if (=exact 2 (ceiling 9/6)))
3549 (pass-if (=exact 2 (ceiling 10/6)))
3550 (pass-if (=exact 2 (ceiling 11/6)))
3551 (pass-if (=exact 3 (ceiling 13/6)))
3552 (pass-if (=exact 3 (ceiling 14/6)))
3553 (pass-if (=exact 3 (ceiling 15/6)))
3554 (pass-if (=exact 3 (ceiling 16/6)))
3555 (pass-if (=exact 3 (ceiling 17/6))))
3557 (with-test-prefix "real"
3559 (and (= 0.0 (ceiling 0.0))
3560 (inexact? (ceiling 0.0))))
3563 (and (= 1.0 (ceiling 1.0))
3564 (inexact? (ceiling 1.0))))
3567 (and (= -1.0 (ceiling -1.0))
3568 (inexact? (ceiling -1.0))))
3571 (and (= -3.0 (ceiling -3.1))
3572 (inexact? (ceiling -3.1))))
3575 (and (= 4.0 (ceiling 3.1))
3576 (inexact? (ceiling 3.1))))
3579 (and (= 4.0 (ceiling 3.9))
3580 (inexact? (ceiling 3.9))))
3583 (and (= -3.0 (ceiling -3.9))
3584 (inexact? (ceiling -3.9))))
3587 (and (= 2.0 (ceiling 1.5))
3588 (inexact? (ceiling 1.5))))
3591 (and (= 3.0 (ceiling 2.5))
3592 (inexact? (ceiling 2.5))))
3595 (and (= 4.0 (ceiling 3.5))
3596 (inexact? (ceiling 3.5))))
3599 (and (= -1.0 (ceiling -1.5))
3600 (inexact? (ceiling -1.5))))
3603 (and (= -2.0 (ceiling -2.5))
3604 (inexact? (ceiling -2.5))))
3607 (and (= -3.0 (ceiling -3.5))
3608 (inexact? (ceiling -3.5))))))
3614 (with-test-prefix "truncate"
3615 (pass-if (= 1 (truncate 1.75)))
3616 (pass-if (= 1 (truncate 1.5)))
3617 (pass-if (= 1 (truncate 1.25)))
3618 (pass-if (= 0 (truncate 0.75)))
3619 (pass-if (= 0 (truncate 0.5)))
3620 (pass-if (= 0 (truncate 0.0)))
3621 (pass-if (= 0 (truncate -0.5)))
3622 (pass-if (= -1 (truncate -1.25)))
3623 (pass-if (= -1 (truncate -1.5)))
3625 (with-test-prefix "inum"
3627 (and (= 0 (truncate 0))
3628 (exact? (truncate 0))))
3631 (and (= 1 (truncate 1))
3632 (exact? (truncate 1))))
3635 (and (= -1 (truncate -1))
3636 (exact? (truncate -1)))))
3638 (with-test-prefix "bignum"
3639 (let ((x (1+ most-positive-fixnum)))
3640 (pass-if "(1+ most-positive-fixnum)"
3641 (and (= x (truncate x))
3642 (exact? (truncate x)))))
3644 (let ((x (1- most-negative-fixnum)))
3645 (pass-if "(1- most-negative-fixnum)"
3646 (and (= x (truncate x))
3647 (exact? (truncate x))))))
3649 (with-test-prefix "frac"
3650 (define (=exact x y)
3654 (pass-if (=exact -2 (truncate -7/3)))
3655 (pass-if (=exact -1 (truncate -5/3)))
3656 (pass-if (=exact -1 (truncate -4/3)))
3657 (pass-if (=exact 0 (truncate -2/3)))
3658 (pass-if (=exact 0 (truncate -1/3)))
3659 (pass-if (=exact 0 (truncate 1/3)))
3660 (pass-if (=exact 0 (truncate 2/3)))
3661 (pass-if (=exact 1 (truncate 4/3)))
3662 (pass-if (=exact 1 (truncate 5/3)))
3663 (pass-if (=exact 2 (truncate 7/3)))
3665 (pass-if (=exact -2 (truncate -17/6)))
3666 (pass-if (=exact -2 (truncate -16/6)))
3667 (pass-if (=exact -2 (truncate -15/6)))
3668 (pass-if (=exact -2 (truncate -14/6)))
3669 (pass-if (=exact -2 (truncate -13/6)))
3670 (pass-if (=exact -1 (truncate -11/6)))
3671 (pass-if (=exact -1 (truncate -10/6)))
3672 (pass-if (=exact -1 (truncate -9/6)))
3673 (pass-if (=exact -1 (truncate -8/6)))
3674 (pass-if (=exact -1 (truncate -7/6)))
3675 (pass-if (=exact 0 (truncate -5/6)))
3676 (pass-if (=exact 0 (truncate -4/6)))
3677 (pass-if (=exact 0 (truncate -3/6)))
3678 (pass-if (=exact 0 (truncate -2/6)))
3679 (pass-if (=exact 0 (truncate -1/6)))
3680 (pass-if (=exact 0 (truncate 1/6)))
3681 (pass-if (=exact 0 (truncate 2/6)))
3682 (pass-if (=exact 0 (truncate 3/6)))
3683 (pass-if (=exact 0 (truncate 4/6)))
3684 (pass-if (=exact 0 (truncate 5/6)))
3685 (pass-if (=exact 1 (truncate 7/6)))
3686 (pass-if (=exact 1 (truncate 8/6)))
3687 (pass-if (=exact 1 (truncate 9/6)))
3688 (pass-if (=exact 1 (truncate 10/6)))
3689 (pass-if (=exact 1 (truncate 11/6)))
3690 (pass-if (=exact 2 (truncate 13/6)))
3691 (pass-if (=exact 2 (truncate 14/6)))
3692 (pass-if (=exact 2 (truncate 15/6)))
3693 (pass-if (=exact 2 (truncate 16/6)))
3694 (pass-if (=exact 2 (truncate 17/6))))
3696 (with-test-prefix "real"
3698 (and (= 0.0 (truncate 0.0))
3699 (inexact? (truncate 0.0))))
3702 (and (= 1.0 (truncate 1.0))
3703 (inexact? (truncate 1.0))))
3706 (and (= -1.0 (truncate -1.0))
3707 (inexact? (truncate -1.0))))
3710 (and (= -3.0 (truncate -3.1))
3711 (inexact? (truncate -3.1))))
3714 (and (= 3.0 (truncate 3.1))
3715 (inexact? (truncate 3.1))))
3718 (and (= 3.0 (truncate 3.9))
3719 (inexact? (truncate 3.9))))
3722 (and (= -3.0 (truncate -3.9))
3723 (inexact? (truncate -3.9))))
3726 (and (= 1.0 (truncate 1.5))
3727 (inexact? (truncate 1.5))))
3730 (and (= 2.0 (truncate 2.5))
3731 (inexact? (truncate 2.5))))
3734 (and (= 3.0 (truncate 3.5))
3735 (inexact? (truncate 3.5))))
3738 (and (= -1.0 (truncate -1.5))
3739 (inexact? (truncate -1.5))))
3742 (and (= -2.0 (truncate -2.5))
3743 (inexact? (truncate -2.5))))
3746 (and (= -3.0 (truncate -3.5))
3747 (inexact? (truncate -3.5))))))
3753 (with-test-prefix "round"
3754 (pass-if (= 2 (round 1.75)))
3755 (pass-if (= 2 (round 1.5)))
3756 (pass-if (= 1 (round 1.25)))
3757 (pass-if (= 1 (round 0.75)))
3758 (pass-if (= 0 (round 0.5)))
3759 (pass-if (= 0 (round 0.0)))
3760 (pass-if (= 0 (round -0.5)))
3761 (pass-if (= -1 (round -1.25)))
3762 (pass-if (= -2 (round -1.5)))
3764 (with-test-prefix "inum"
3766 (and (= 0 (round 0))
3767 (exact? (round 0))))
3770 (and (= 1 (round 1))
3771 (exact? (round 1))))
3774 (and (= -1 (round -1))
3775 (exact? (round -1)))))
3777 (with-test-prefix "bignum"
3778 (let ((x (1+ most-positive-fixnum)))
3779 (pass-if "(1+ most-positive-fixnum)"
3780 (and (= x (round x))
3781 (exact? (round x)))))
3783 (let ((x (1- most-negative-fixnum)))
3784 (pass-if "(1- most-negative-fixnum)"
3785 (and (= x (round x))
3786 (exact? (round x))))))
3788 (with-test-prefix "frac"
3789 (define (=exact x y)
3793 (pass-if (=exact -2 (round -7/3)))
3794 (pass-if (=exact -2 (round -5/3)))
3795 (pass-if (=exact -1 (round -4/3)))
3796 (pass-if (=exact -1 (round -2/3)))
3797 (pass-if (=exact 0 (round -1/3)))
3798 (pass-if (=exact 0 (round 1/3)))
3799 (pass-if (=exact 1 (round 2/3)))
3800 (pass-if (=exact 1 (round 4/3)))
3801 (pass-if (=exact 2 (round 5/3)))
3802 (pass-if (=exact 2 (round 7/3)))
3804 (pass-if (=exact -3 (round -17/6)))
3805 (pass-if (=exact -3 (round -16/6)))
3806 (pass-if (=exact -2 (round -15/6)))
3807 (pass-if (=exact -2 (round -14/6)))
3808 (pass-if (=exact -2 (round -13/6)))
3809 (pass-if (=exact -2 (round -11/6)))
3810 (pass-if (=exact -2 (round -10/6)))
3811 (pass-if (=exact -2 (round -9/6)))
3812 (pass-if (=exact -1 (round -8/6)))
3813 (pass-if (=exact -1 (round -7/6)))
3814 (pass-if (=exact -1 (round -5/6)))
3815 (pass-if (=exact -1 (round -4/6)))
3816 (pass-if (=exact 0 (round -3/6)))
3817 (pass-if (=exact 0 (round -2/6)))
3818 (pass-if (=exact 0 (round -1/6)))
3819 (pass-if (=exact 0 (round 1/6)))
3820 (pass-if (=exact 0 (round 2/6)))
3821 (pass-if (=exact 0 (round 3/6)))
3822 (pass-if (=exact 1 (round 4/6)))
3823 (pass-if (=exact 1 (round 5/6)))
3824 (pass-if (=exact 1 (round 7/6)))
3825 (pass-if (=exact 1 (round 8/6)))
3826 (pass-if (=exact 2 (round 9/6)))
3827 (pass-if (=exact 2 (round 10/6)))
3828 (pass-if (=exact 2 (round 11/6)))
3829 (pass-if (=exact 2 (round 13/6)))
3830 (pass-if (=exact 2 (round 14/6)))
3831 (pass-if (=exact 2 (round 15/6)))
3832 (pass-if (=exact 3 (round 16/6)))
3833 (pass-if (=exact 3 (round 17/6))))
3835 (with-test-prefix "real"
3837 (and (= 0.0 (round 0.0))
3838 (inexact? (round 0.0))))
3841 (and (= 1.0 (round 1.0))
3842 (inexact? (round 1.0))))
3845 (and (= -1.0 (round -1.0))
3846 (inexact? (round -1.0))))
3849 (and (= -3.0 (round -3.1))
3850 (inexact? (round -3.1))))
3853 (and (= 3.0 (round 3.1))
3854 (inexact? (round 3.1))))
3857 (and (= 4.0 (round 3.9))
3858 (inexact? (round 3.9))))
3861 (and (= -4.0 (round -3.9))
3862 (inexact? (round -3.9))))
3865 (and (= 2.0 (round 1.5))
3866 (inexact? (round 1.5))))
3869 (and (= 2.0 (round 2.5))
3870 (inexact? (round 2.5))))
3873 (and (= 4.0 (round 3.5))
3874 (inexact? (round 3.5))))
3877 (and (= -2.0 (round -1.5))
3878 (inexact? (round -1.5))))
3881 (and (= -2.0 (round -2.5))
3882 (inexact? (round -2.5))))
3885 (and (= -4.0 (round -3.5))
3886 (inexact? (round -3.5))))
3888 ;; prior to guile 1.6.5, on an IEEE system an inexact 2^53-1 (ie. a
3889 ;; float with mantissa all ones) came out as 2^53 from `round' (except
3890 ;; on i386 and m68k systems using the coprocessor and optimizing, where
3891 ;; extra precision hid the problem)
3893 (let ((x (exact->inexact (1- (ash 1 53)))))
3894 (and (= x (round x))
3895 (inexact? (round x)))))
3896 (pass-if "-(2^53-1)"
3897 (let ((x (exact->inexact (- (1- (ash 1 53))))))
3898 (and (= x (round x))
3899 (inexact? (round x)))))))
3905 (with-test-prefix "exact->inexact"
3907 ;; Test "(exact->inexact n)", expect "want".
3908 ;; "i" is a index, for diagnostic purposes.
3909 (define (try-i i n want)
3910 (with-test-prefix (list i n want)
3911 (with-test-prefix "pos"
3912 (let ((got (exact->inexact n)))
3913 (pass-if "inexact?" (inexact? got))
3914 (pass-if (list "=" got) (= want got))))
3916 (set! want (- want))
3917 (with-test-prefix "neg"
3918 (let ((got (exact->inexact n)))
3919 (pass-if "inexact?" (inexact? got))
3920 (pass-if (list "=" got) (= want got))))))
3922 (with-test-prefix "2^i, no round"
3925 (want 1.0 (* 2.0 want)))
3929 (with-test-prefix "2^i+1, no round"
3932 (want 3.0 (- (* 2.0 want) 1.0)))
3933 ((>= i dbl-mant-dig))
3936 (with-test-prefix "(2^i+1)*2^100, no round"
3939 (want 3.0 (- (* 2.0 want) 1.0)))
3940 ((>= i dbl-mant-dig))
3941 (try-i i (ash n 100) (ash-flo want 100))))
3943 ;; bit pattern: 1111....11100.00
3946 (with-test-prefix "mantdig ones then zeros, no rounding"
3948 (n (- (ash 1 dbl-mant-dig) 1) (* 2 n))
3949 (want (- (ash-flo 1.0 dbl-mant-dig) 1.0) (* 2.0 want)))
3953 ;; bit pattern: 1111....111011..1
3954 ;; <-mantdig-> <-i->
3955 ;; This sort of value was incorrectly rounded upwards in Guile 1.6.4 when
3956 ;; i >= 11 (that's when the total is 65 or more bits).
3958 (with-test-prefix "mantdig ones then 011..11, round down"
3960 (n (- (ash 1 (+ 1 dbl-mant-dig)) 2) (+ 1 (* 2 n)))
3961 (want (- (ash-flo 1.0 (+ 1 dbl-mant-dig)) 2.0) (* 2.0 want)))
3965 ;; bit pattern: 1111....111100..001
3966 ;; <-mantdig-> <--i->
3968 (with-test-prefix "mantdig ones then 100..001, round up"
3970 (n (- (ash 1 (+ 2 dbl-mant-dig)) 1) (1- (* 2 n)))
3971 (want (ash-flo 1.0 (+ 2 dbl-mant-dig)) (* 2.0 want)))
3975 ;; bit pattern: 1000....000100..001
3976 ;; <-mantdig-> <--i->
3978 (with-test-prefix "2^mantdig then 100..001, round up"
3980 (n (- (ash 1 (+ 2 dbl-mant-dig)) 1) (1- (* 2 n)))
3981 (want (+ (ash-flo 1.0 (+ 2 dbl-mant-dig)) 4.0) (* 2.0 want)))
3985 (pass-if "frac big/big"
3986 (let ((big (ash 1 256)))
3987 (= 1.0 (exact->inexact (/ (1+ big) big)))))
3989 ;; In guile 1.8.0 this failed, giving back "nan" because it tried to
3990 ;; convert the num and den to doubles, resulting in infs.
3991 (pass-if "frac big/big, exceeding double"
3992 (let ((big (ash 1 4096)))
3993 (= 1.0 (exact->inexact (/ (1+ big) big))))))
3999 (with-test-prefix "expt"
4000 (pass-if (documented? expt))
4003 ;; expt no longer requires its first argument to be a scheme number,
4004 ;; for the sake of extensibility, and expt calls integer-expt for
4005 ;; integer powers. To raise to a positive power, all that is required
4006 ;; is that it can be multiplied using `*'. For negative powers we
4007 ;; must also be able to find the reciprocal. If we try to raise #t to
4008 ;; any power other than 0 or 1 it may throw an exception, depending on
4009 ;; whether * has been defined for #t. However, when raising to the 0
4010 ;; or 1 power, the first argument is not manipulated at all.
4012 ;; (pass-if-exception "non-numeric base" exception:wrong-type-arg
4016 (pass-if (eqv? 1 (expt 0 0)))
4017 (pass-if (eqv? 1 (expt 0.0 0)))
4018 (pass-if (eqv? 1.0 (expt 0 0.0)))
4019 (pass-if (eqv? 1.0 (expt 0.0 0.0)))
4020 (pass-if (real-nan? (expt 0 -1)))
4021 (pass-if (real-nan? (expt 0 -1.0)))
4022 (pass-if (real-nan? (expt 0.0 -1)))
4023 (pass-if (real-nan? (expt 0.0 -1.0)))
4024 (pass-if (eqv? 0 (expt 0 3)))
4025 (pass-if (= 0 (expt 0 4.0)))
4026 (pass-if (eqv? 0.0 (expt 0.0 5)))
4027 (pass-if (eqv? 0.0 (expt 0.0 6.0)))
4028 (pass-if (eqv? -2742638075.5 (expt -2742638075.5 1)))
4029 (pass-if (eqv? (* -2742638075.5 -2742638075.5)
4030 (expt -2742638075.5 2)))
4031 (pass-if (eqv? 4.0 (expt -2.0 2.0)))
4032 (pass-if (eqv? -1/8 (expt -2 -3)))
4033 (pass-if (eqv? -0.125 (expt -2.0 -3)))
4034 (pass-if (eqv? -0.125 (expt -2 -3.0)))
4035 (pass-if (eqv? -0.125 (expt -2.0 -3.0)))
4036 (pass-if (eqv? 0.25 (expt 2.0 -2.0)))
4037 (pass-if (test-eqv? (* -1.0+0.0i 12398 12398) (expt +12398i 2.0)))
4038 (pass-if (eqv-loosely? +i (expt -1 0.5)))
4039 (pass-if (eqv-loosely? +i (expt -1 1/2)))
4040 (pass-if (eqv-loosely? 1.0+1.7320508075688i (expt -8 1/3)))
4041 (pass-if (eqv? +inf.0 (expt 2 +inf.0)))
4042 (pass-if (eqv? +inf.0 (expt 2.0 +inf.0)))
4043 (pass-if (eqv? 0.0 (expt 2 -inf.0)))
4044 (pass-if (eqv? 0.0 (expt 2.0 -inf.0))))
4051 (with-test-prefix "sin"
4052 (pass-if (eqv? 0 (sin 0)))
4053 (pass-if (eqv? 0.0 (sin 0.0)))
4054 (pass-if (eqv-loosely? 1.0 (sin 1.57)))
4055 (pass-if (eqv-loosely? +1.175i (sin +i)))
4056 (pass-if (real-nan? (sin +nan.0)))
4057 (pass-if (real-nan? (sin +inf.0)))
4058 (pass-if (real-nan? (sin -inf.0))))
4064 (with-test-prefix "cos"
4065 (pass-if (eqv? 1 (cos 0)))
4066 (pass-if (eqv? 1.0 (cos 0.0)))
4067 (pass-if (eqv-loosely? 0.0 (cos 1.57)))
4068 (pass-if (eqv-loosely? 1.543 (cos +i)))
4069 (pass-if (real-nan? (cos +nan.0)))
4070 (pass-if (real-nan? (cos +inf.0)))
4071 (pass-if (real-nan? (cos -inf.0))))
4077 (with-test-prefix "tan"
4078 (pass-if (eqv? 0 (tan 0)))
4079 (pass-if (eqv? 0.0 (tan 0.0)))
4080 (pass-if (eqv-loosely? 1.0 (tan 0.785)))
4081 (pass-if (eqv-loosely? +0.76i (tan +i)))
4082 (pass-if (real-nan? (tan +nan.0)))
4083 (pass-if (real-nan? (tan +inf.0)))
4084 (pass-if (real-nan? (tan -inf.0))))
4090 (with-test-prefix "asin"
4091 (pass-if (complex-nan? (asin +nan.0)))
4092 (pass-if (eqv? 0 (asin 0)))
4093 (pass-if (eqv? 0.0 (asin 0.0))))
4099 (with-test-prefix "acos"
4100 (pass-if (complex-nan? (acos +nan.0)))
4101 (pass-if (eqv? 0 (acos 1)))
4102 (pass-if (eqv? 0.0 (acos 1.0))))
4107 ;;; FIXME: add tests for two-argument atan
4109 (with-test-prefix "atan"
4110 (pass-if (real-nan? (atan +nan.0)))
4111 (pass-if (eqv? 0 (atan 0)))
4112 (pass-if (eqv? 0.0 (atan 0.0)))
4113 (pass-if (eqv-loosely? 1.57 (atan +inf.0)))
4114 (pass-if (eqv-loosely? -1.57 (atan -inf.0))))
4120 (with-test-prefix "sinh"
4121 (pass-if (= 0 (sinh 0)))
4122 (pass-if (= 0.0 (sinh 0.0))))
4128 (with-test-prefix "cosh"
4129 (pass-if (= 1 (cosh 0)))
4130 (pass-if (= 1.0 (cosh 0.0))))
4136 (with-test-prefix "tanh"
4137 (pass-if (= 0 (tanh 0)))
4138 (pass-if (= 0.0 (tanh 0.0))))
4144 (with-test-prefix "asinh"
4145 (pass-if (= 0 (asinh 0)))
4146 (pass-if (= 0.0 (asinh 0.0))))
4152 (with-test-prefix "acosh"
4153 (pass-if (= 0 (acosh 1)))
4154 (pass-if (= 0.0 (acosh 1.0))))
4160 (with-test-prefix "atanh"
4161 (pass-if (= 0 (atanh 0)))
4162 (pass-if (= 0.0 (atanh 0.0))))
4165 ;;; make-rectangular
4168 (with-test-prefix "make-rectangular"
4169 (pass-if (real? (make-rectangular 5.0 0 )))
4170 (pass-if (not (real? (make-rectangular 5.0 0.0))))
4171 (pass-if (not (real? (make-rectangular 5.0 -0.0)))))
4177 (with-test-prefix "make-polar"
4178 (define pi 3.14159265358979323846)
4179 (define (almost= x y)
4180 (> 0.01 (magnitude (- x y))))
4182 (pass-if (real? (make-polar 0 1.0)))
4183 (pass-if (real? (make-polar 5.0 0 )))
4184 (pass-if (not (real? (make-polar 5.0 0.0))))
4185 (pass-if (not (real? (make-polar 5.0 -0.0))))
4187 (pass-if (eqv? 0 (make-polar 0 0)))
4188 (pass-if (eqv? 0 (make-polar 0 123.456)))
4189 (pass-if (eqv? 1 (make-polar 1 0)))
4190 (pass-if (eqv? -1 (make-polar -1 0)))
4192 (pass-if (almost= 0+i (make-polar 1 (* 0.5 pi))))
4193 (pass-if (almost= -1 (make-polar 1 (* 1.0 pi))))
4194 (pass-if (almost= 0-i (make-polar 1 (* 1.5 pi))))
4195 (pass-if (almost= 1 (make-polar 1 (* 2.0 pi)))))
4201 (with-test-prefix "real-part"
4202 (pass-if (documented? real-part))
4203 (pass-if (eqv? 5.0 (real-part 5.0)))
4204 (pass-if (eqv? 0.0 (real-part +5.0i)))
4205 (pass-if (eqv? 5 (real-part 5)))
4206 (pass-if (eqv? 1/5 (real-part 1/5)))
4207 (pass-if (eqv? (1+ fixnum-max) (real-part (1+ fixnum-max)))))
4213 (with-test-prefix "imag-part"
4214 (pass-if (documented? imag-part))
4215 (pass-if (eqv? 0 (imag-part 5.0)))
4216 (pass-if (eqv? 5.0 (imag-part +5.0i)))
4217 (pass-if (eqv? 0 (imag-part 5)))
4218 (pass-if (eqv? 0 (imag-part 1/5)))
4219 (pass-if (eqv? 0 (imag-part (1+ fixnum-max)))))
4225 (with-test-prefix "magnitude"
4226 (pass-if (documented? magnitude))
4227 (pass-if (= 0 (magnitude 0)))
4228 (pass-if (= 1 (magnitude 1)))
4229 (pass-if (= 1 (magnitude -1)))
4230 (pass-if (= 1 (magnitude 0+i)))
4231 (pass-if (= 1 (magnitude 0-i)))
4232 (pass-if (= 5 (magnitude 3+4i)))
4233 (pass-if (= 5 (magnitude 3-4i)))
4234 (pass-if (= 5 (magnitude -3+4i)))
4235 (pass-if (= 5 (magnitude -3-4i))))
4241 (with-test-prefix "angle"
4242 (define pi 3.14159265358979323846)
4243 (define (almost= x y)
4244 (> 0.01 (magnitude (- x y))))
4246 (pass-if (documented? angle))
4248 (pass-if "inum +ve" (= 0 (angle 1)))
4249 (pass-if "inum -ve" (almost= pi (angle -1)))
4251 (pass-if "bignum +ve" (= 0 (angle (1+ fixnum-max))))
4252 (pass-if "bignum -ve" (almost= pi (angle (1- fixnum-min))))
4254 (pass-if "flonum +ve" (= 0 (angle 1.5)))
4255 (pass-if "flonum -ve" (almost= pi (angle -1.5))))
4261 (with-test-prefix "inexact->exact"
4262 (pass-if (documented? inexact->exact))
4264 (pass-if-exception "+inf" exception:out-of-range
4265 (inexact->exact +inf.0))
4267 (pass-if-exception "-inf" exception:out-of-range
4268 (inexact->exact -inf.0))
4270 (pass-if-exception "nan" exception:out-of-range
4271 (inexact->exact +nan.0))
4273 (with-test-prefix "2.0**i to exact and back"
4278 (= n (inexact->exact (exact->inexact n)))))))
4284 (with-test-prefix "integer-expt"
4285 (pass-if (documented? integer-expt))
4287 (pass-if-exception "2^+inf" exception:wrong-type-arg
4288 (integer-expt 2 +inf.0))
4289 (pass-if-exception "2^-inf" exception:wrong-type-arg
4290 (integer-expt 2 -inf.0))
4291 (pass-if-exception "2^nan" exception:wrong-type-arg
4292 (integer-expt 2 +nan.0))
4294 (pass-if (eqv? 1 (integer-expt 0 0)))
4295 (pass-if (eqv? 1 (integer-expt 0.0 0)))
4296 (pass-if (real-nan? (integer-expt 0 -1)))
4297 (pass-if (real-nan? (integer-expt 0.0 -1)))
4298 (pass-if (eqv? 0 (integer-expt 0 3)))
4299 (pass-if (eqv? 0.0 (integer-expt 0.0 5)))
4300 (pass-if (eqv? -2742638075.5 (integer-expt -2742638075.5 1)))
4301 (pass-if (eqv? (* -2742638075.5 -2742638075.5)
4302 (integer-expt -2742638075.5 2)))
4303 (pass-if (eqv? 4.0 (integer-expt -2.0 2)))
4304 (pass-if (eqv? -1/8 (integer-expt -2 -3)))
4305 (pass-if (eqv? -0.125 (integer-expt -2.0 -3)))
4306 (pass-if (eqv? 0.25 (integer-expt 2.0 -2)))
4307 (pass-if (test-eqv? (* -1.0+0.0i 12398 12398) (integer-expt +12398.0i 2))))
4314 (with-test-prefix "integer-length"
4315 (pass-if (documented? integer-length))
4317 (with-test-prefix "-2^i, ...11100..00"
4318 (do ((n -1 (ash n 1))
4321 (pass-if (list n "expect" i)
4322 (= i (integer-length n)))))
4324 (with-test-prefix "-2^i+1 ...11100..01"
4325 (do ((n -3 (logxor 3 (ash n 1)))
4329 (= i (integer-length n)))))
4331 (with-test-prefix "-2^i-1 ...111011..11"
4332 (do ((n -2 (1+ (ash n 1)))
4336 (= i (integer-length n))))))
4342 (with-test-prefix "log"
4343 (pass-if (documented? log))
4345 (pass-if-exception "no args" exception:wrong-num-args
4347 (pass-if-exception "two args" exception:wrong-num-args
4349 (pass-if-exception "(log 0)" exception:numerical-overflow
4352 (pass-if (test-eqv? -inf.0 (log 0.0)))
4353 (pass-if (test-eqv? +inf.0 (log +inf.0)))
4354 (pass-if (test-eqv? -inf.0+3.14159265358979i (log -0.0)))
4355 (pass-if (test-eqv? +inf.0+3.14159265358979i (log -inf.0)))
4356 (pass-if (test-eqv? 0.0 (log 1 )))
4357 (pass-if (test-eqv? 0.0 (log 1.0)))
4358 (pass-if (test-eqv? 1.0 (log const-e)))
4359 (pass-if (test-eqv? 2.0 (log const-e^2)))
4360 (pass-if (test-eqv? -1.0 (log const-1/e)))
4361 (pass-if (test-eqv? -1.0+3.14159265358979i (log (- const-1/e))))
4362 (pass-if (test-eqv? 2.30258509299405 (log 10)))
4363 (pass-if (test-eqv? 2.30258509299405+3.14159265358979i (log -10)))
4365 (pass-if (test-eqv? 1.0+0.0i (log (+ const-e +0.0i))))
4366 (pass-if (test-eqv? 1.0-0.0i (log (+ const-e -0.0i))))
4368 (pass-if (eqv-loosely? 230258.509299405 (log (expt 10 100000))))
4369 (pass-if (eqv-loosely? -230258.509299405 (log (expt 10 -100000))))
4370 (pass-if (eqv-loosely? 230257.410687116 (log (/ (expt 10 100000) 3))))
4371 (pass-if (eqv-loosely? 230258.509299405+3.14159265358979i
4372 (log (- (expt 10 100000)))))
4373 (pass-if (eqv-loosely? -230258.509299405+3.14159265358979i
4374 (log (- (expt 10 -100000)))))
4375 (pass-if (eqv-loosely? 230257.410687116+3.14159265358979i
4376 (log (- (/ (expt 10 100000) 3)))))
4377 (pass-if (test-eqv? 3.05493636349961e-151
4378 (log (/ (1+ (expt 2 500)) (expt 2 500)))))
4380 (pass-if (eqv-loosely? 1.0+1.57079i (log 0+2.71828i)))
4381 (pass-if (eqv-loosely? 1.0-1.57079i (log 0-2.71828i)))
4383 (pass-if (eqv-loosely? 0.0+3.14159i (log -1.0)))
4384 (pass-if (eqv-loosely? 1.0+3.14159i (log -2.71828)))
4385 (pass-if (eqv-loosely? 2.0+3.14159i (log (* -2.71828 2.71828)))))
4391 (with-test-prefix "log10"
4392 (pass-if (documented? log10))
4394 (pass-if-exception "no args" exception:wrong-num-args
4396 (pass-if-exception "two args" exception:wrong-num-args
4398 (pass-if-exception "(log10 0)" exception:numerical-overflow
4401 (pass-if (test-eqv? -inf.0 (log10 0.0)))
4402 (pass-if (test-eqv? +inf.0 (log10 +inf.0)))
4403 (pass-if (test-eqv? -inf.0+1.36437635384184i (log10 -0.0)))
4404 (pass-if (test-eqv? +inf.0+1.36437635384184i (log10 -inf.0)))
4405 (pass-if (test-eqv? 0.0 (log10 1 )))
4406 (pass-if (test-eqv? 0.0 (log10 1.0)))
4407 (pass-if (test-eqv? 1.0 (log10 10 )))
4408 (pass-if (test-eqv? 1.0 (log10 10.0)))
4409 (pass-if (test-eqv? 2.0 (log10 100.0)))
4410 (pass-if (test-eqv? -1.0 (log10 0.1)))
4411 (pass-if (test-eqv? -1.0+1.36437635384184i (log10 -0.1)))
4412 (pass-if (test-eqv? 1.0+1.36437635384184i (log10 -10 )))
4414 (pass-if (test-eqv? 1.0+0.0i (log10 10.0+0.0i)))
4415 (pass-if (test-eqv? 1.0-0.0i (log10 10.0-0.0i)))
4417 (pass-if (eqv-loosely? 100000.0 (log10 (expt 10 100000))))
4418 (pass-if (eqv-loosely? -100000.0 (log10 (expt 10 -100000))))
4419 (pass-if (eqv-loosely? 99999.5228787453 (log10 (/ (expt 10 100000) 3))))
4420 (pass-if (eqv-loosely? 100000.0+1.36437635384184i
4421 (log10 (- (expt 10 100000)))))
4422 (pass-if (eqv-loosely? -100000.0+1.36437635384184i
4423 (log10 (- (expt 10 -100000)))))
4424 (pass-if (eqv-loosely? 99999.5228787453+1.36437635384184i
4425 (log10 (- (/ (expt 10 100000) 3)))))
4426 (pass-if (test-eqv? 1.32674200523347e-151
4427 (log10 (/ (1+ (expt 2 500)) (expt 2 500)))))
4429 (pass-if (eqv-loosely? 1.0+0.68218i (log10 0+10.0i)))
4430 (pass-if (eqv-loosely? 1.0-0.68218i (log10 0-10.0i)))
4432 (pass-if (eqv-loosely? 0.0+1.36437i (log10 -1)))
4433 (pass-if (eqv-loosely? 1.0+1.36437i (log10 -10)))
4434 (pass-if (eqv-loosely? 2.0+1.36437i (log10 -100))))
4440 (with-test-prefix "logbit?"
4441 (pass-if (documented? logbit?))
4443 (pass-if (eq? #f (logbit? 0 0)))
4444 (pass-if (eq? #f (logbit? 1 0)))
4445 (pass-if (eq? #f (logbit? 31 0)))
4446 (pass-if (eq? #f (logbit? 32 0)))
4447 (pass-if (eq? #f (logbit? 33 0)))
4448 (pass-if (eq? #f (logbit? 63 0)))
4449 (pass-if (eq? #f (logbit? 64 0)))
4450 (pass-if (eq? #f (logbit? 65 0)))
4452 ;; prior to guile 1.6.5, testing bit 32, 64 etc of value 1 would wrap
4453 ;; around and return #t where it ought to be #f
4454 (pass-if (eq? #t (logbit? 0 1)))
4455 (pass-if (eq? #f (logbit? 1 1)))
4456 (pass-if (eq? #f (logbit? 31 1)))
4457 (pass-if (eq? #f (logbit? 32 1)))
4458 (pass-if (eq? #f (logbit? 33 1)))
4459 (pass-if (eq? #f (logbit? 63 1)))
4460 (pass-if (eq? #f (logbit? 64 1)))
4461 (pass-if (eq? #f (logbit? 65 1)))
4462 (pass-if (eq? #f (logbit? 128 1)))
4464 (pass-if (eq? #t (logbit? 0 -1)))
4465 (pass-if (eq? #t (logbit? 1 -1)))
4466 (pass-if (eq? #t (logbit? 31 -1)))
4467 (pass-if (eq? #t (logbit? 32 -1)))
4468 (pass-if (eq? #t (logbit? 33 -1)))
4469 (pass-if (eq? #t (logbit? 63 -1)))
4470 (pass-if (eq? #t (logbit? 64 -1)))
4471 (pass-if (eq? #t (logbit? 65 -1))))
4477 (with-test-prefix "logcount"
4478 (pass-if (documented? logcount))
4480 (with-test-prefix "-2^i, meaning ...11100..00"
4481 (do ((n -1 (ash n 1))
4485 (= i (logcount n)))))
4487 (with-test-prefix "2^i"
4488 (do ((n 1 (ash n 1))
4492 (= 1 (logcount n)))))
4494 (with-test-prefix "2^i-1"
4495 (do ((n 0 (1+ (ash n 1)))
4499 (= i (logcount n))))))
4505 (with-test-prefix "logior"
4506 (pass-if (documented? logior))
4508 (pass-if (eqv? -1 (logior (ash -1 1) 1)))
4510 ;; check that bignum or bignum+inum args will reduce to an inum
4513 (pass-if (list x y '=> -1)
4514 (eqv? -1 (logior x y)))
4515 (pass-if (list y x '=> -1)
4516 (eqv? -1 (logior y x))))
4517 (test (ash -1 8) #xFF)
4518 (test (ash -1 28) #x0FFFFFFF)
4519 (test (ash -1 29) #x1FFFFFFF)
4520 (test (ash -1 30) #x3FFFFFFF)
4521 (test (ash -1 31) #x7FFFFFFF)
4522 (test (ash -1 32) #xFFFFFFFF)
4523 (test (ash -1 33) #x1FFFFFFFF)
4524 (test (ash -1 60) #x0FFFFFFFFFFFFFFF)
4525 (test (ash -1 61) #x1FFFFFFFFFFFFFFF)
4526 (test (ash -1 62) #x3FFFFFFFFFFFFFFF)
4527 (test (ash -1 63) #x7FFFFFFFFFFFFFFF)
4528 (test (ash -1 64) #xFFFFFFFFFFFFFFFF)
4529 (test (ash -1 65) #x1FFFFFFFFFFFFFFFF)
4530 (test (ash -1 128) #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)))
4536 (with-test-prefix "lognot"
4537 (pass-if (documented? lognot))
4539 (pass-if (= -1 (lognot 0)))
4540 (pass-if (= 0 (lognot -1)))
4541 (pass-if (= -2 (lognot 1)))
4542 (pass-if (= 1 (lognot -2)))
4544 (pass-if (= #x-100000000000000000000000000000000
4545 (lognot #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)))
4546 (pass-if (= #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
4547 (lognot #x-100000000000000000000000000000000))))
4550 ;;; exact-integer-sqrt
4553 (with-test-prefix "exact-integer-sqrt"
4554 (define (non-negative-exact-integer? k)
4555 (and (integer? k) (exact? k) (>= k 0)))
4558 (pass-if k (let-values (((s r) (exact-integer-sqrt k)))
4559 (and (non-negative-exact-integer? s)
4560 (non-negative-exact-integer? r)
4562 (< k (* (1+ s) (1+ s)))))))
4564 (define (test-wrong-type-arg k)
4565 (pass-if-exception k exception:wrong-type-arg
4566 (let-values (((s r) (exact-integer-sqrt k)))
4569 (pass-if (documented? exact-integer-sqrt))
4571 (pass-if-exception "no args" exception:wrong-num-args
4572 (exact-integer-sqrt))
4573 (pass-if-exception "two args" exception:wrong-num-args
4574 (exact-integer-sqrt 123 456))
4581 (test (1+ fixnum-max))
4582 (test (* fixnum-max fixnum-max))
4583 (test (+ 1 (* fixnum-max fixnum-max)))
4584 (test (expt 10 100))
4585 (test (+ 3 (expt 10 100)))
4587 (test-wrong-type-arg -1)
4588 (test-wrong-type-arg 1/9)
4589 (test-wrong-type-arg fixnum-min)
4590 (test-wrong-type-arg (1- fixnum-min))
4591 (test-wrong-type-arg 1.0)
4592 (test-wrong-type-arg 1.5)
4593 (test-wrong-type-arg "foo")
4594 (test-wrong-type-arg 'foo))
4601 (with-test-prefix "sqrt"
4602 (pass-if (documented? sqrt))
4604 (pass-if-exception "no args" exception:wrong-num-args
4606 (pass-if-exception "two args" exception:wrong-num-args
4609 (pass-if (eqv? 0.0 (sqrt 0)))
4610 (pass-if (eqv? 0.0 (sqrt 0.0)))
4611 (pass-if (eqv? 1.0 (sqrt 1.0)))
4612 (pass-if (eqv-loosely? 2.0 (sqrt 4.0)))
4613 (pass-if (eqv-loosely? 31.62 (sqrt 1000.0)))
4615 (pass-if (eqv? +1.0i (sqrt -1.0)))
4616 (pass-if (eqv-loosely? +2.0i (sqrt -4.0)))
4617 (pass-if (eqv-loosely? +31.62i (sqrt -1000.0)))
4619 (pass-if "+i swings back to 45deg angle"
4620 (eqv-loosely? +0.7071+0.7071i (sqrt +1.0i)))
4622 ;; Note: glibc 2.3 csqrt() had a bug affecting this test case, so if it
4623 ;; fails check whether that's the cause (there's a configure test to
4624 ;; reject it, but when cross-compiling we assume the C library is ok).
4625 (pass-if "-100i swings back to 45deg down"
4626 (eqv-loosely? +7.071-7.071i (sqrt -100.0i))))
4630 ;;; Tests for number-theoretic division operators:
4633 ;;; euclidean-quotient
4634 ;;; euclidean-remainder
4639 ;;; ceiling-quotient
4640 ;;; ceiling-remainder
4642 ;;; truncate-quotient
4643 ;;; truncate-remainder
4645 ;;; centered-quotient
4646 ;;; centered-remainder
4652 (with-test-prefix "Number-theoretic division"
4654 ;; Tests that (lo <1 x <2 hi),
4655 ;; but allowing for imprecision
4657 (define (test-within-range? lo <1 x <2 hi)
4659 (and (<1 lo x) (<2 x hi))
4660 (let ((lo (- lo test-epsilon))
4661 (hi (+ hi test-epsilon)))
4664 (define (valid-euclidean-answer? x y q r)
4665 (and (eq? (exact? q)
4667 (and (exact? x) (exact? y)))
4668 (test-eqv? r (- x (* q y)))
4669 (if (and (finite? x) (finite? y))
4671 (test-within-range? 0 <= r < (abs y)))
4672 (test-eqv? q (/ x y)))))
4674 (define (valid-floor-answer? x y q r)
4675 (and (eq? (exact? q)
4677 (and (exact? x) (exact? y)))
4678 (test-eqv? r (- x (* q y)))
4679 (if (and (finite? x) (finite? y))
4682 (test-within-range? 0 <= r < y)
4683 (test-within-range? y < r <= 0)))
4684 (test-eqv? q (/ x y)))))
4686 (define (valid-ceiling-answer? x y q r)
4687 (and (eq? (exact? q)
4689 (and (exact? x) (exact? y)))
4690 (test-eqv? r (- x (* q y)))
4691 (if (and (finite? x) (finite? y))
4694 (test-within-range? (- y) < r <= 0)
4695 (test-within-range? 0 <= r < (- y))))
4696 (test-eqv? q (/ x y)))))
4698 (define (valid-truncate-answer? x y q r)
4699 (and (eq? (exact? q)
4701 (and (exact? x) (exact? y)))
4702 (test-eqv? r (- x (* q y)))
4703 (if (and (finite? x) (finite? y))
4706 (test-within-range? 0 <= r < (abs y))
4707 (test-within-range? (- (abs y)) < r <= 0)))
4708 (test-eqv? q (/ x y)))))
4710 (define (valid-centered-answer? x y q r)
4711 (and (eq? (exact? q)
4713 (and (exact? x) (exact? y)))
4714 (test-eqv? r (- x (* q y)))
4715 (if (and (finite? x) (finite? y))
4718 (* -1/2 (abs y)) <= r < (* +1/2 (abs y))))
4719 (test-eqv? q (/ x y)))))
4721 (define (valid-round-answer? x y q r)
4722 (and (eq? (exact? q)
4724 (and (exact? x) (exact? y)))
4725 (test-eqv? r (- x (* q y)))
4726 (if (and (finite? x) (finite? y))
4728 (let ((ay/2 (/ (abs y) 2)))
4730 (test-within-range? (- ay/2) <= r <= ay/2)
4731 (test-within-range? (- ay/2) < r < ay/2))))
4732 (test-eqv? q (/ x y)))))
4734 (define (for lsts f) (apply for-each f lsts))
4736 (define big (expt 10 (1+ (inexact->exact (ceiling (log10 fixnum-max))))))
4738 (define (run-division-tests quo+rem quo rem valid-answer?)
4740 (run-test (list n d) #t
4742 (let-values (((q r) (quo+rem n d)))
4743 (and (test-eqv? q (quo n d))
4744 (test-eqv? r (rem n d))
4745 (valid-answer? n d q r))))))
4746 (define (test+/- n d)
4749 (cond ((not (zero? n))
4751 (test (- n) (- d)))))
4753 (define (test-for-exception n d exception)
4754 (let ((name (list n d)))
4755 (pass-if-exception name exception (quo+rem n d))
4756 (pass-if-exception name exception (quo n d))
4757 (pass-if-exception name exception (rem n d))))
4759 (run-test "documented?" #t
4761 (and (documented? quo+rem)
4763 (documented? rem))))
4765 (with-test-prefix "inum / inum"
4766 (with-test-prefix "fixnum-min / -1"
4767 (test fixnum-min -1))
4768 (for '((1 2 5 10)) ;; denominators
4770 (for '((0 1 2 5 10)) ;; multiples
4772 (for '((-2 -1 0 1 2 3 4 5 7 10
4773 12 15 16 19 20)) ;; offsets
4775 (test+/- (+ b (* m d))
4778 (with-test-prefix "inum / big"
4779 (with-test-prefix "fixnum-min / -fixnum-min"
4780 (test fixnum-min (- fixnum-min)))
4781 (with-test-prefix "fixnum-max / (2*fixnum-max)"
4782 (test+/- fixnum-max (* 2 fixnum-max)))
4783 (for `((0 1 2 10 ,(1- fixnum-max) ,fixnum-max))
4785 (test n (1+ fixnum-max))
4786 (test (- n) (1+ fixnum-max))
4787 (test n (1- fixnum-min))
4788 (test (- n) (1- fixnum-min)))))
4790 (with-test-prefix "big / inum"
4791 (with-test-prefix "-fixnum-min / fixnum-min"
4792 (test (- fixnum-min) fixnum-min))
4793 (for '((1 4 5 10)) ;; denominators
4795 (for `((1 2 5 ,@(if (even? d)
4799 (for '((-2 -1 0 1 2)) ;; offsets
4801 (test+/- (+ b (* m d big))
4804 (with-test-prefix "big / big"
4805 (for `((,big ,(1+ big))) ;; denominators
4807 (for `((1 2 5 ,@(if (even? d)
4811 (for '((-2 -1 0 1 2)) ;; offsets
4813 (test+/- (+ b (* m d))
4816 (with-test-prefix "inexact"
4817 (for '((0.5 1.5 2.25 5.75)) ;; denominators
4819 (for '((0 1 2 5 1/2 3/2 5/2)) ;; multiples
4821 (for '((-2 -1 0 1 2)) ;; offsets
4823 (test+/- (+ b (* m d))
4826 (with-test-prefix "fractions"
4827 (for '((1/10 16/3 10/7)) ;; denominators
4829 (for '((0 1 2 5 1/2 3/2 5/2)) ;; multiples
4831 (for '((-2/9 -1/11 0 1/3 2/3)) ;; offsets
4833 (test+/- (+ b (* m d))
4836 (with-test-prefix "mixed types"
4837 (for `((10 ,big 12.0 10/7 +inf.0 -inf.0 +nan.0)) ;; denominators
4839 (for `((25 ,(* 3/2 big) 130.0 15/7
4840 0 0.0 -0.0 +inf.0 -inf.0 +nan.0)) ;; numerators
4844 (with-test-prefix "divide by zero"
4845 (for `((0 0.0 +0.0)) ;; denominators
4847 (for `((15 ,(* 3/2 big) 18.0 33/7
4848 0 0.0 -0.0 +inf.0 -inf.0 +nan.0)) ;; numerators
4851 n d exception:numerical-overflow)))))))
4853 (with-test-prefix "euclidean/"
4854 (run-division-tests euclidean/
4857 valid-euclidean-answer?))
4859 (with-test-prefix "floor/"
4860 (run-division-tests floor/
4863 valid-floor-answer?))
4865 (with-test-prefix "ceiling/"
4866 (run-division-tests ceiling/
4869 valid-ceiling-answer?))
4871 (with-test-prefix "truncate/"
4872 (run-division-tests truncate/
4875 valid-truncate-answer?))
4877 (with-test-prefix "centered/"
4878 (run-division-tests centered/
4881 valid-centered-answer?))
4883 (with-test-prefix "round/"
4884 (run-division-tests round/
4887 valid-round-answer?)))