Use the `with-test-prefix/c&e' for the `1+' and `1-' tests.
[bpt/guile.git] / test-suite / tests / numbers.test
CommitLineData
de142bea 1;;;; numbers.test --- tests guile's numbers -*- scheme -*-
cedf24d8 2;;;; Copyright (C) 2000, 2001, 2003, 2004, 2005, 2006, 2009, 2010 Free Software Foundation, Inc.
de142bea 3;;;;
73be1d9e
MV
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
53befeb7 7;;;; version 3 of the License, or (at your option) any later version.
73be1d9e
MV
8;;;;
9;;;; This library is distributed in the hope that it will be useful,
de142bea 10;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
73be1d9e
MV
11;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12;;;; Lesser General Public License for more details.
13;;;;
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
92205699 16;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
de142bea 17
a1fb3b1c
KR
18(define-module (test-suite test-numbers)
19 #:use-module (test-suite lib)
20 #:use-module (ice-9 documentation))
de142bea 21
de142bea
DH
22;;;
23;;; miscellaneous
24;;;
25
1b3a7932
DH
26(define exception:numerical-overflow
27 (cons 'numerical-overflow "^Numerical overflow"))
28
cb18f2a8 29(define (documented? object)
5c96bc39 30 (not (not (object-documentation object))))
de142bea 31
8b7838b5
RB
32(define fixnum-bit
33 (inexact->exact (+ (/ (log (+ most-positive-fixnum 1)) (log 2)) 1)))
34
21e39e8f
DH
35(define fixnum-min most-negative-fixnum)
36(define fixnum-max most-positive-fixnum)
de142bea 37
a1fb3b1c
KR
38;; Divine the number of bits in the mantissa of a flonum.
39;; We look for when 2.0^i+1.0 gets rounded, ie. the difference between that
40;; value and 2.0^k is not 1.0.
41;; Of course this assumes flonums have a fixed precision mantissa, but
42;; that's the case now and probably into the forseeable future.
43;; On an IEEE system, which means pretty much everywhere, the value here is
44;; the usual 53.
45;;
46(define dbl-mant-dig
47 (let more ((i 1)
48 (d 2.0))
49 (if (> i 1024)
50 (error "Oops, cannot determine number of bits in mantissa of inexact"))
51 (let* ((sum (+ 1.0 d))
52 (diff (- sum d)))
53 (if (= diff 1.0)
54 (more (1+ i) (* 2.0 d))
55 i))))
56
57;; like ash, but working on a flonum
58(define (ash-flo x n)
59 (while (> n 0)
60 (set! x (* 2.0 x))
61 (set! n (1- n)))
62 (while (< n 0)
63 (set! x (* 0.5 x))
64 (set! n (1+ n)))
65 x)
49579cbd
KR
66
67;; `quotient' but rounded towards -infinity, like `modulo' or `ash' do
68;; note only positive D supported (that's all that's currently required)
69(define-public (quotient-floor n d)
70 (if (negative? n)
71 (quotient (- n d -1) d) ;; neg/pos
72 (quotient n d))) ;; pos/pos
73
8ab3d8a0
KR
74;; return true of X is in the range LO to HI, inclusive
75(define (within-range? lo hi x)
76 (and (>= x (min lo hi))
77 (<= x (max lo hi))))
78
79;; return true if GOT is within +/- 0.01 of GOT
80;; for a complex number both real and imaginary parts must be in that range
81(define (eqv-loosely? want got)
82 (and (within-range? (- (real-part want) 0.01)
83 (+ (real-part want) 0.01)
84 (real-part got))
85 (within-range? (- (imag-part want) 0.01)
86 (+ (imag-part want) 0.01)
87 (imag-part got))))
88
89;; return true if OBJ is negative infinity
90(define (negative-infinity? obj)
91 (and (real? obj)
92 (negative? obj)
93 (inf? obj)))
94
95(define const-e 2.7182818284590452354)
96(define const-e^2 7.3890560989306502274)
97(define const-1/e 0.3678794411714423215)
98
99
a580ebba
KR
100;;;
101;;; 1+
102;;;
103
f13f1e9f 104(with-test-prefix/c&e "1+"
a580ebba
KR
105
106 (pass-if "documented?"
107 (documented? 1+))
108
f13f1e9f
LC
109 (pass-if "0" (eqv? 1 (1+ 0)))
110 (pass-if "-1" (eqv? 0 (1+ -1)))
111 (pass-if "100" (eqv? 101 (1+ 100)))
112 (pass-if "-100" (eqv? -99 (1+ -100)))
e78d4bf9
LC
113
114 ;; The maximum fixnum on a 32-bit architecture: 2^29 - 1.
f13f1e9f
LC
115 (pass-if "1+ fixnum = bignum (32-bit)"
116 (eqv? 536870912 (1+ 536870911)))
e78d4bf9
LC
117
118 ;; The maximum fixnum on a 64-bit architecture: 2^61 - 1.
f13f1e9f
LC
119 (pass-if "1+ fixnum = bignum (64-bit)"
120 (eqv? 2305843009213693952 (1+ 2305843009213693951))))
a580ebba
KR
121
122;;;
123;;; 1-
124;;;
125
f13f1e9f 126(with-test-prefix/c&e "1-"
a580ebba
KR
127
128 (pass-if "documented?"
129 (documented? 1-))
130
f13f1e9f
LC
131 (pass-if "0" (eqv? -1 (1- 0)))
132 (pass-if "1" (eqv? 0 (1- 1)))
133 (pass-if "100" (eqv? 99 (1- 100)))
134 (pass-if "-100" (eqv? -101 (1- -100)))
e78d4bf9
LC
135
136 ;; The minimum fixnum on a 32-bit architecture: -2^29.
f13f1e9f
LC
137 (pass-if "1- fixnum = bignum (32-bit)"
138 (eqv? -536870913 (1- -536870912)))
e78d4bf9
LC
139
140 ;; The minimum fixnum on a 64-bit architecture: -2^61.
f13f1e9f
LC
141 (pass-if "1- fixnum = bignum (64-bit)"
142 (eqv? -2305843009213693953 (1- -2305843009213693952))))
a580ebba 143
49579cbd
KR
144;;;
145;;; ash
146;;;
147
148(with-test-prefix "ash"
149
150 (pass-if "documented?"
151 (documented? ash))
152
153 (pass-if (eqv? 0 (ash 0 0)))
154 (pass-if (eqv? 0 (ash 0 1)))
155 (pass-if (eqv? 0 (ash 0 1000)))
156 (pass-if (eqv? 0 (ash 0 -1)))
157 (pass-if (eqv? 0 (ash 0 -1000)))
158
159 (pass-if (eqv? 1 (ash 1 0)))
160 (pass-if (eqv? 2 (ash 1 1)))
161 (pass-if (eqv? 340282366920938463463374607431768211456 (ash 1 128)))
162 (pass-if (eqv? 0 (ash 1 -1)))
163 (pass-if (eqv? 0 (ash 1 -1000)))
164
165 (pass-if (eqv? -1 (ash -1 0)))
166 (pass-if (eqv? -2 (ash -1 1)))
167 (pass-if (eqv? -340282366920938463463374607431768211456 (ash -1 128)))
168 (pass-if (eqv? -1 (ash -1 -1)))
169 (pass-if (eqv? -1 (ash -1 -1000)))
170
171 (pass-if (eqv? -3 (ash -3 0)))
172 (pass-if (eqv? -6 (ash -3 1)))
173 (pass-if (eqv? -1020847100762815390390123822295304634368 (ash -3 128)))
174 (pass-if (eqv? -2 (ash -3 -1)))
175 (pass-if (eqv? -1 (ash -3 -1000)))
176
177 (pass-if (eqv? -6 (ash -23 -2)))
178
179 (pass-if (eqv? most-positive-fixnum (ash most-positive-fixnum 0)))
180 (pass-if (eqv? (* 2 most-positive-fixnum) (ash most-positive-fixnum 1)))
181 (pass-if (eqv? (* 4 most-positive-fixnum) (ash most-positive-fixnum 2)))
182 (pass-if
183 (eqv? (* most-positive-fixnum 340282366920938463463374607431768211456)
184 (ash most-positive-fixnum 128)))
185 (pass-if (eqv? (quotient most-positive-fixnum 2)
186 (ash most-positive-fixnum -1)))
187 (pass-if (eqv? 0 (ash most-positive-fixnum -1000)))
188
189 (let ((mpf4 (quotient most-positive-fixnum 4)))
190 (pass-if (eqv? (* 2 mpf4) (ash mpf4 1)))
191 (pass-if (eqv? (* 4 mpf4) (ash mpf4 2)))
192 (pass-if (eqv? (* 8 mpf4) (ash mpf4 3))))
193
194 (pass-if (eqv? most-negative-fixnum (ash most-negative-fixnum 0)))
195 (pass-if (eqv? (* 2 most-negative-fixnum) (ash most-negative-fixnum 1)))
196 (pass-if (eqv? (* 4 most-negative-fixnum) (ash most-negative-fixnum 2)))
197 (pass-if
198 (eqv? (* most-negative-fixnum 340282366920938463463374607431768211456)
199 (ash most-negative-fixnum 128)))
200 (pass-if (eqv? (quotient-floor most-negative-fixnum 2)
201 (ash most-negative-fixnum -1)))
202 (pass-if (eqv? -1 (ash most-negative-fixnum -1000)))
203
204 (let ((mnf4 (quotient-floor most-negative-fixnum 4)))
205 (pass-if (eqv? (* 2 mnf4) (ash mnf4 1)))
206 (pass-if (eqv? (* 4 mnf4) (ash mnf4 2)))
207 (pass-if (eqv? (* 8 mnf4) (ash mnf4 3)))))
a1fb3b1c 208
de142bea
DH
209;;;
210;;; exact?
211;;;
212
213(with-test-prefix "exact?"
214
de142bea 215 (pass-if "documented?"
cb18f2a8 216 (documented? exact?))
de142bea 217
21e39e8f 218 (with-test-prefix "integers"
de142bea 219
21e39e8f
DH
220 (pass-if "0"
221 (exact? 0))
de142bea 222
21e39e8f
DH
223 (pass-if "fixnum-max"
224 (exact? fixnum-max))
de142bea 225
21e39e8f
DH
226 (pass-if "fixnum-max + 1"
227 (exact? (+ fixnum-max 1)))
de142bea 228
21e39e8f
DH
229 (pass-if "fixnum-min"
230 (exact? fixnum-min))
de142bea 231
21e39e8f
DH
232 (pass-if "fixnum-min - 1"
233 (exact? (- fixnum-min 1))))
234
235 (with-test-prefix "reals"
236
237 ;; (FIXME: need better examples.)
238
239 (pass-if "sqrt (fixnum-max^2 - 1)"
240 (eq? #f (exact? (sqrt (- (expt fixnum-max 2) 1)))))
241
242 (pass-if "sqrt ((fixnum-max+1)^2 - 1)"
243 (eq? #f (exact? (sqrt (- (expt (+ fixnum-max 1) 2) 1)))))))
de142bea 244
8ab3d8a0
KR
245;;;
246;;; exp
247;;;
248
249(with-test-prefix "exp"
250 (pass-if "documented?"
251 (documented? exp))
252
253 (pass-if-exception "no args" exception:wrong-num-args
254 (exp))
255 (pass-if-exception "two args" exception:wrong-num-args
256 (exp 123 456))
257
258 (pass-if (eqv? 0.0 (exp -inf.0)))
259 (pass-if (eqv-loosely? 1.0 (exp 0)))
260 (pass-if (eqv-loosely? 1.0 (exp 0.0)))
261 (pass-if (eqv-loosely? const-e (exp 1.0)))
262 (pass-if (eqv-loosely? const-e^2 (exp 2.0)))
263 (pass-if (eqv-loosely? const-1/e (exp -1)))
264
265 (pass-if "exp(pi*i) = -1"
266 (eqv-loosely? -1.0 (exp 0+3.14159i)))
267 (pass-if "exp(-pi*i) = -1"
268 (eqv-loosely? -1.0 (exp 0-3.14159i)))
269 (pass-if "exp(2*pi*i) = +1"
270 (eqv-loosely? 1.0 (exp 0+6.28318i)))
271
272 (pass-if "exp(2-pi*i) = -e^2"
273 (eqv-loosely? (- const-e^2) (exp 2.0-3.14159i))))
274
de142bea
DH
275;;;
276;;; odd?
277;;;
278
7c24e528
RB
279(with-test-prefix "odd?"
280 (pass-if (documented? odd?))
281 (pass-if (odd? 1))
282 (pass-if (odd? -1))
4d332f19
DH
283 (pass-if (not (odd? 0)))
284 (pass-if (not (odd? 2)))
285 (pass-if (not (odd? -2)))
7c24e528 286 (pass-if (odd? (+ (* 2 fixnum-max) 1)))
4d332f19 287 (pass-if (not (odd? (* 2 fixnum-max))))
7c24e528 288 (pass-if (odd? (- (* 2 fixnum-min) 1)))
4d332f19 289 (pass-if (not (odd? (* 2 fixnum-min)))))
de142bea
DH
290
291;;;
292;;; even?
293;;;
294
7c24e528
RB
295(with-test-prefix "even?"
296 (pass-if (documented? even?))
297 (pass-if (even? 2))
298 (pass-if (even? -2))
299 (pass-if (even? 0))
4d332f19
DH
300 (pass-if (not (even? 1)))
301 (pass-if (not (even? -1)))
302 (pass-if (not (even? (+ (* 2 fixnum-max) 1))))
7c24e528 303 (pass-if (even? (* 2 fixnum-max)))
4d332f19 304 (pass-if (not (even? (- (* 2 fixnum-min) 1))))
7c24e528 305 (pass-if (even? (* 2 fixnum-min))))
de142bea
DH
306
307;;;
7c24e528
RB
308;;; inf? and inf
309;;;
310
311(with-test-prefix "inf?"
312 (pass-if (documented? inf?))
313 (pass-if (inf? (inf)))
314 ;; FIXME: what are the expected behaviors?
315 ;; (pass-if (inf? (/ 1.0 0.0))
316 ;; (pass-if (inf? (/ 1 0.0))
4d332f19
DH
317 (pass-if (not (inf? 0)))
318 (pass-if (not (inf? 42.0)))
319 (pass-if (not (inf? (+ fixnum-max 1))))
320 (pass-if (not (inf? (- fixnum-min 1)))))
7c24e528
RB
321
322;;;
323;;; nan? and nan
de142bea
DH
324;;;
325
7c24e528
RB
326(with-test-prefix "nan?"
327 (pass-if (documented? nan?))
328 (pass-if (nan? (nan)))
329 ;; FIXME: other ways we should be able to generate NaN?
4d332f19
DH
330 (pass-if (not (nan? 0)))
331 (pass-if (not (nan? 42.0)))
332 (pass-if (not (nan? (+ fixnum-max 1))))
333 (pass-if (not (nan? (- fixnum-min 1)))))
de142bea 334
7c24e528
RB
335;;;
336;;; abs
337;;;
338
339(with-test-prefix "abs"
340 (pass-if (documented? abs))
341 (pass-if (zero? (abs 0)))
342 (pass-if (= 1 (abs 1)))
343 (pass-if (= 1 (abs -1)))
344 (pass-if (= (+ fixnum-max 1) (abs (+ fixnum-max 1))))
345 (pass-if (= (+ (- fixnum-min) 1) (abs (- fixnum-min 1))))
76903a31
KR
346 (pass-if (= 0.0 (abs 0.0)))
347 (pass-if (= 1.0 (abs 1.0)))
348 (pass-if (= 1.0 (abs -1.0)))
349 (pass-if (nan? (abs +nan.0)))
350 (pass-if (= +inf.0 (abs +inf.0)))
351 (pass-if (= +inf.0 (abs -inf.0))))
352
de142bea
DH
353;;;
354;;; quotient
355;;;
356
357(with-test-prefix "quotient"
358
de142bea 359 (expect-fail "documented?"
cb18f2a8 360 (documented? quotient))
de142bea 361
de142bea
DH
362 (with-test-prefix "0 / n"
363
364 (pass-if "n = 1"
365 (eqv? 0 (quotient 0 1)))
366
367 (pass-if "n = -1"
368 (eqv? 0 (quotient 0 -1)))
369
21e39e8f
DH
370 (pass-if "n = 2"
371 (eqv? 0 (quotient 0 2)))
372
373 (pass-if "n = fixnum-max"
374 (eqv? 0 (quotient 0 fixnum-max)))
375
376 (pass-if "n = fixnum-max + 1"
377 (eqv? 0 (quotient 0 (+ fixnum-max 1))))
378
379 (pass-if "n = fixnum-min"
380 (eqv? 0 (quotient 0 fixnum-min)))
381
382 (pass-if "n = fixnum-min - 1"
383 (eqv? 0 (quotient 0 (- fixnum-min 1)))))
de142bea 384
21e39e8f 385 (with-test-prefix "1 / n"
de142bea
DH
386
387 (pass-if "n = 1"
388 (eqv? 1 (quotient 1 1)))
389
390 (pass-if "n = -1"
21e39e8f
DH
391 (eqv? -1 (quotient 1 -1)))
392
393 (pass-if "n = 2"
394 (eqv? 0 (quotient 1 2)))
de142bea 395
21e39e8f
DH
396 (pass-if "n = fixnum-max"
397 (eqv? 0 (quotient 1 fixnum-max)))
de142bea 398
21e39e8f
DH
399 (pass-if "n = fixnum-max + 1"
400 (eqv? 0 (quotient 1 (+ fixnum-max 1))))
de142bea 401
21e39e8f
DH
402 (pass-if "n = fixnum-min"
403 (eqv? 0 (quotient 1 fixnum-min)))
404
405 (pass-if "n = fixnum-min - 1"
406 (eqv? 0 (quotient 1 (- fixnum-min 1)))))
407
408 (with-test-prefix "-1 / n"
de142bea
DH
409
410 (pass-if "n = 1"
21e39e8f 411 (eqv? -1 (quotient -1 1)))
de142bea
DH
412
413 (pass-if "n = -1"
414 (eqv? 1 (quotient -1 -1)))
415
21e39e8f
DH
416 (pass-if "n = 2"
417 (eqv? 0 (quotient -1 2)))
418
419 (pass-if "n = fixnum-max"
420 (eqv? 0 (quotient -1 fixnum-max)))
421
422 (pass-if "n = fixnum-max + 1"
423 (eqv? 0 (quotient -1 (+ fixnum-max 1))))
424
425 (pass-if "n = fixnum-min"
426 (eqv? 0 (quotient -1 fixnum-min)))
427
428 (pass-if "n = fixnum-min - 1"
429 (eqv? 0 (quotient -1 (- fixnum-min 1)))))
430
431 (with-test-prefix "fixnum-max / n"
432
433 (pass-if "n = 1"
434 (eqv? fixnum-max (quotient fixnum-max 1)))
435
436 (pass-if "n = -1"
437 (eqv? (- fixnum-max) (quotient fixnum-max -1)))
438
439 (pass-if "n = 2"
440 (eqv? fixnum-max (+ (* (quotient fixnum-max 2) 2) 1)))
441
442 (pass-if "n = fixnum-max"
443 (eqv? 1 (quotient fixnum-max fixnum-max)))
444
445 (pass-if "n = fixnum-max + 1"
446 (eqv? 0 (quotient fixnum-max (+ fixnum-max 1))))
447
448 (pass-if "n = fixnum-min"
449 (eqv? 0 (quotient fixnum-max fixnum-min)))
450
451 (pass-if "n = fixnum-min - 1"
452 (eqv? 0 (quotient fixnum-max (- fixnum-min 1)))))
453
454 (with-test-prefix "(fixnum-max + 1) / n"
455
456 (pass-if "n = 1"
457 (eqv? (+ fixnum-max 1) (quotient (+ fixnum-max 1) 1)))
458
459 (pass-if "n = -1"
460 (eqv? (- (+ fixnum-max 1)) (quotient (+ fixnum-max 1) -1)))
461
462 (pass-if "n = 2"
463 (eqv? (+ fixnum-max 1) (* (quotient (+ fixnum-max 1) 2) 2)))
464
465 (pass-if "n = fixnum-max"
466 (eqv? 1 (quotient (+ fixnum-max 1) fixnum-max)))
467
468 (pass-if "n = fixnum-max + 1"
469 (eqv? 1 (quotient (+ fixnum-max 1) (+ fixnum-max 1))))
470
471 (pass-if "n = fixnum-min"
472 (eqv? -1 (quotient (+ fixnum-max 1) fixnum-min)))
473
474 (pass-if "n = fixnum-min - 1"
475 (eqv? 0 (quotient (+ fixnum-max 1) (- fixnum-min 1)))))
476
477 (with-test-prefix "fixnum-min / n"
478
479 (pass-if "n = 1"
480 (eqv? fixnum-min (quotient fixnum-min 1)))
481
482 (pass-if "n = -1"
483 (eqv? (- fixnum-min) (quotient fixnum-min -1)))
484
485 (pass-if "n = 2"
486 (eqv? fixnum-min (* (quotient fixnum-min 2) 2)))
487
488 (pass-if "n = fixnum-max"
489 (eqv? -1 (quotient fixnum-min fixnum-max)))
490
491 (pass-if "n = fixnum-max + 1"
492 (eqv? -1 (quotient fixnum-min (+ fixnum-max 1))))
493
494 (pass-if "n = fixnum-min"
495 (eqv? 1 (quotient fixnum-min fixnum-min)))
496
497 (pass-if "n = fixnum-min - 1"
ad22fe7c
KR
498 (eqv? 0 (quotient fixnum-min (- fixnum-min 1))))
499
500 (pass-if "n = - fixnum-min - 1"
501 (eqv? -1 (quotient fixnum-min (1- (- fixnum-min)))))
502
503 ;; special case, normally inum/big is zero
504 (pass-if "n = - fixnum-min"
505 (eqv? -1 (quotient fixnum-min (- fixnum-min))))
506
507 (pass-if "n = - fixnum-min + 1"
508 (eqv? 0 (quotient fixnum-min (1+ (- fixnum-min))))))
21e39e8f
DH
509
510 (with-test-prefix "(fixnum-min - 1) / n"
511
512 (pass-if "n = 1"
513 (eqv? (- fixnum-min 1) (quotient (- fixnum-min 1) 1)))
514
515 (pass-if "n = -1"
516 (eqv? (- (- fixnum-min 1)) (quotient (- fixnum-min 1) -1)))
517
518 (pass-if "n = 2"
519 (eqv? fixnum-min (* (quotient (- fixnum-min 1) 2) 2)))
520
521 (pass-if "n = fixnum-max"
522 (eqv? -1 (quotient (- fixnum-min 1) fixnum-max)))
523
524 (pass-if "n = fixnum-max + 1"
525 (eqv? -1 (quotient (- fixnum-min 1) (+ fixnum-max 1))))
526
527 (pass-if "n = fixnum-min"
528 (eqv? 1 (quotient (- fixnum-min 1) fixnum-min)))
529
530 (pass-if "n = fixnum-min - 1"
531 (eqv? 1 (quotient (- fixnum-min 1) (- fixnum-min 1)))))
de142bea
DH
532
533 ;; Positive dividend and divisor
534
535 (pass-if "35 / 7"
536 (eqv? 5 (quotient 35 7)))
537
538 ;; Negative dividend, positive divisor
539
540 (pass-if "-35 / 7"
541 (eqv? -5 (quotient -35 7)))
542
543 ;; Positive dividend, negative divisor
544
545 (pass-if "35 / -7"
546 (eqv? -5 (quotient 35 -7)))
547
548 ;; Negative dividend and divisor
549
550 (pass-if "-35 / -7"
551 (eqv? 5 (quotient -35 -7)))
552
553 ;; Are numerical overflows detected correctly?
554
80074d77
DH
555 (with-test-prefix "division by zero"
556
557 (pass-if-exception "(quotient 1 0)"
558 exception:numerical-overflow
559 (quotient 1 0))
560
561 (pass-if-exception "(quotient bignum 0)"
562 exception:numerical-overflow
563 (quotient (+ fixnum-max 1) 0)))
564
de142bea
DH
565 ;; Are wrong type arguments detected correctly?
566
567 )
568
569;;;
570;;; remainder
571;;;
572
573(with-test-prefix "remainder"
574
de142bea 575 (expect-fail "documented?"
cb18f2a8 576 (documented? remainder))
de142bea 577
de142bea
DH
578 (with-test-prefix "0 / n"
579
580 (pass-if "n = 1"
581 (eqv? 0 (remainder 0 1)))
582
583 (pass-if "n = -1"
584 (eqv? 0 (remainder 0 -1)))
585
21e39e8f
DH
586 (pass-if "n = fixnum-max"
587 (eqv? 0 (remainder 0 fixnum-max)))
588
589 (pass-if "n = fixnum-max + 1"
590 (eqv? 0 (remainder 0 (+ fixnum-max 1))))
591
592 (pass-if "n = fixnum-min"
593 (eqv? 0 (remainder 0 fixnum-min)))
de142bea 594
21e39e8f
DH
595 (pass-if "n = fixnum-min - 1"
596 (eqv? 0 (remainder 0 (- fixnum-min 1)))))
de142bea 597
21e39e8f 598 (with-test-prefix "1 / n"
de142bea
DH
599
600 (pass-if "n = 1"
601 (eqv? 0 (remainder 1 1)))
602
603 (pass-if "n = -1"
21e39e8f
DH
604 (eqv? 0 (remainder 1 -1)))
605
606 (pass-if "n = fixnum-max"
607 (eqv? 1 (remainder 1 fixnum-max)))
de142bea 608
21e39e8f
DH
609 (pass-if "n = fixnum-max + 1"
610 (eqv? 1 (remainder 1 (+ fixnum-max 1))))
de142bea 611
21e39e8f
DH
612 (pass-if "n = fixnum-min"
613 (eqv? 1 (remainder 1 fixnum-min)))
de142bea 614
21e39e8f
DH
615 (pass-if "n = fixnum-min - 1"
616 (eqv? 1 (remainder 1 (- fixnum-min 1)))))
617
618 (with-test-prefix "-1 / n"
de142bea
DH
619
620 (pass-if "n = 1"
21e39e8f 621 (eqv? 0 (remainder -1 1)))
de142bea
DH
622
623 (pass-if "n = -1"
624 (eqv? 0 (remainder -1 -1)))
625
21e39e8f
DH
626 (pass-if "n = fixnum-max"
627 (eqv? -1 (remainder -1 fixnum-max)))
628
629 (pass-if "n = fixnum-max + 1"
630 (eqv? -1 (remainder -1 (+ fixnum-max 1))))
631
632 (pass-if "n = fixnum-min"
633 (eqv? -1 (remainder -1 fixnum-min)))
634
635 (pass-if "n = fixnum-min - 1"
636 (eqv? -1 (remainder -1 (- fixnum-min 1)))))
637
638 (with-test-prefix "fixnum-max / n"
639
640 (pass-if "n = 1"
641 (eqv? 0 (remainder fixnum-max 1)))
642
643 (pass-if "n = -1"
644 (eqv? 0 (remainder fixnum-max -1)))
645
646 (pass-if "n = fixnum-max"
647 (eqv? 0 (remainder fixnum-max fixnum-max)))
648
649 (pass-if "n = fixnum-max + 1"
650 (eqv? fixnum-max (remainder fixnum-max (+ fixnum-max 1))))
651
652 (pass-if "n = fixnum-min"
653 (eqv? fixnum-max (remainder fixnum-max fixnum-min)))
654
655 (pass-if "n = fixnum-min - 1"
656 (eqv? fixnum-max (remainder fixnum-max (- fixnum-min 1)))))
657
658 (with-test-prefix "(fixnum-max + 1) / n"
659
660 (pass-if "n = 1"
661 (eqv? 0 (remainder (+ fixnum-max 1) 1)))
662
663 (pass-if "n = -1"
664 (eqv? 0 (remainder (+ fixnum-max 1) -1)))
665
666 (pass-if "n = fixnum-max"
667 (eqv? 1 (remainder (+ fixnum-max 1) fixnum-max)))
668
669 (pass-if "n = fixnum-max + 1"
670 (eqv? 0 (remainder (+ fixnum-max 1) (+ fixnum-max 1))))
671
672 (pass-if "n = fixnum-min"
673 (eqv? 0 (remainder (+ fixnum-max 1) fixnum-min)))
674
675 (pass-if "n = fixnum-min - 1"
676 (eqv? (+ fixnum-max 1) (remainder (+ fixnum-max 1) (- fixnum-min 1)))))
677
678 (with-test-prefix "fixnum-min / n"
679
680 (pass-if "n = 1"
681 (eqv? 0 (remainder fixnum-min 1)))
682
683 (pass-if "n = -1"
684 (eqv? 0 (remainder fixnum-min -1)))
685
686 (pass-if "n = fixnum-max"
687 (eqv? -1 (remainder fixnum-min fixnum-max)))
688
689 (pass-if "n = fixnum-max + 1"
690 (eqv? 0 (remainder fixnum-min (+ fixnum-max 1))))
691
692 (pass-if "n = fixnum-min"
693 (eqv? 0 (remainder fixnum-min fixnum-min)))
694
695 (pass-if "n = fixnum-min - 1"
ad22fe7c
KR
696 (eqv? fixnum-min (remainder fixnum-min (- fixnum-min 1))))
697
698 (pass-if "n = - fixnum-min - 1"
699 (eqv? -1 (remainder fixnum-min (1- (- fixnum-min)))))
700
701 ;; special case, normally inum%big is the inum
702 (pass-if "n = - fixnum-min"
703 (eqv? 0 (remainder fixnum-min (- fixnum-min))))
704
705 (pass-if "n = - fixnum-min + 1"
706 (eqv? fixnum-min (remainder fixnum-min (1+ (- fixnum-min))))))
21e39e8f
DH
707
708 (with-test-prefix "(fixnum-min - 1) / n"
709
710 (pass-if "n = 1"
711 (eqv? 0 (remainder (- fixnum-min 1) 1)))
712
713 (pass-if "n = -1"
714 (eqv? 0 (remainder (- fixnum-min 1) -1)))
715
716 (pass-if "n = fixnum-max"
717 (eqv? -2 (remainder (- fixnum-min 1) fixnum-max)))
718
719 (pass-if "n = fixnum-max + 1"
720 (eqv? -1 (remainder (- fixnum-min 1) (+ fixnum-max 1))))
721
722 (pass-if "n = fixnum-min"
723 (eqv? -1 (remainder (- fixnum-min 1) fixnum-min)))
724
725 (pass-if "n = fixnum-min - 1"
726 (eqv? 0 (remainder (- fixnum-min 1) (- fixnum-min 1)))))
de142bea
DH
727
728 ;; Positive dividend and divisor
729
730 (pass-if "35 / 7"
731 (eqv? 0 (remainder 35 7)))
732
733 ;; Negative dividend, positive divisor
734
735 (pass-if "-35 / 7"
736 (eqv? 0 (remainder -35 7)))
737
738 ;; Positive dividend, negative divisor
739
740 (pass-if "35 / -7"
741 (eqv? 0 (remainder 35 -7)))
742
743 ;; Negative dividend and divisor
744
745 (pass-if "-35 / -7"
746 (eqv? 0 (remainder -35 -7)))
747
748 ;; Are numerical overflows detected correctly?
749
80074d77
DH
750 (with-test-prefix "division by zero"
751
752 (pass-if-exception "(remainder 1 0)"
753 exception:numerical-overflow
754 (remainder 1 0))
755
756 (pass-if-exception "(remainder bignum 0)"
757 exception:numerical-overflow
758 (remainder (+ fixnum-max 1) 0)))
759
de142bea
DH
760 ;; Are wrong type arguments detected correctly?
761
762 )
763
764;;;
765;;; modulo
766;;;
767
768(with-test-prefix "modulo"
769
de142bea 770 (expect-fail "documented?"
cb18f2a8 771 (documented? modulo))
de142bea 772
de142bea
DH
773 (with-test-prefix "0 % n"
774
775 (pass-if "n = 1"
776 (eqv? 0 (modulo 0 1)))
777
778 (pass-if "n = -1"
779 (eqv? 0 (modulo 0 -1)))
780
21e39e8f
DH
781 (pass-if "n = fixnum-max"
782 (eqv? 0 (modulo 0 fixnum-max)))
783
784 (pass-if "n = fixnum-max + 1"
785 (eqv? 0 (modulo 0 (+ fixnum-max 1))))
de142bea 786
21e39e8f
DH
787 (pass-if "n = fixnum-min"
788 (eqv? 0 (modulo 0 fixnum-min)))
de142bea 789
21e39e8f
DH
790 (pass-if "n = fixnum-min - 1"
791 (eqv? 0 (modulo 0 (- fixnum-min 1)))))
792
793 (with-test-prefix "1 % n"
de142bea
DH
794
795 (pass-if "n = 1"
796 (eqv? 0 (modulo 1 1)))
797
798 (pass-if "n = -1"
21e39e8f 799 (eqv? 0 (modulo 1 -1)))
de142bea 800
21e39e8f
DH
801 (pass-if "n = fixnum-max"
802 (eqv? 1 (modulo 1 fixnum-max)))
de142bea 803
21e39e8f
DH
804 (pass-if "n = fixnum-max + 1"
805 (eqv? 1 (modulo 1 (+ fixnum-max 1))))
de142bea 806
21e39e8f
DH
807 (pass-if "n = fixnum-min"
808 (eqv? (+ fixnum-min 1) (modulo 1 fixnum-min)))
809
810 (pass-if "n = fixnum-min - 1"
811 (eqv? fixnum-min (modulo 1 (- fixnum-min 1)))))
812
813 (with-test-prefix "-1 % n"
de142bea
DH
814
815 (pass-if "n = 1"
21e39e8f 816 (eqv? 0 (modulo -1 1)))
de142bea
DH
817
818 (pass-if "n = -1"
819 (eqv? 0 (modulo -1 -1)))
820
21e39e8f
DH
821 (pass-if "n = fixnum-max"
822 (eqv? (- fixnum-max 1) (modulo -1 fixnum-max)))
823
824 (pass-if "n = fixnum-max + 1"
825 (eqv? fixnum-max (modulo -1 (+ fixnum-max 1))))
826
827 (pass-if "n = fixnum-min"
828 (eqv? -1 (modulo -1 fixnum-min)))
829
830 (pass-if "n = fixnum-min - 1"
831 (eqv? -1 (modulo -1 (- fixnum-min 1)))))
832
833 (with-test-prefix "fixnum-max % n"
834
835 (pass-if "n = 1"
836 (eqv? 0 (modulo fixnum-max 1)))
837
838 (pass-if "n = -1"
839 (eqv? 0 (modulo fixnum-max -1)))
840
841 (pass-if "n = fixnum-max"
842 (eqv? 0 (modulo fixnum-max fixnum-max)))
843
844 (pass-if "n = fixnum-max + 1"
845 (eqv? fixnum-max (modulo fixnum-max (+ fixnum-max 1))))
846
847 (pass-if "n = fixnum-min"
848 (eqv? -1 (modulo fixnum-max fixnum-min)))
849
850 (pass-if "n = fixnum-min - 1"
851 (eqv? -2 (modulo fixnum-max (- fixnum-min 1)))))
852
853 (with-test-prefix "(fixnum-max + 1) % n"
854
855 (pass-if "n = 1"
856 (eqv? 0 (modulo (+ fixnum-max 1) 1)))
857
858 (pass-if "n = -1"
859 (eqv? 0 (modulo (+ fixnum-max 1) -1)))
860
861 (pass-if "n = fixnum-max"
862 (eqv? 1 (modulo (+ fixnum-max 1) fixnum-max)))
863
864 (pass-if "n = fixnum-max + 1"
865 (eqv? 0 (modulo (+ fixnum-max 1) (+ fixnum-max 1))))
866
867 (pass-if "n = fixnum-min"
868 (eqv? 0 (modulo (+ fixnum-max 1) fixnum-min)))
869
870 (pass-if "n = fixnum-min - 1"
871 (eqv? -1 (modulo (+ fixnum-max 1) (- fixnum-min 1)))))
872
873 (with-test-prefix "fixnum-min % n"
874
875 (pass-if "n = 1"
876 (eqv? 0 (modulo fixnum-min 1)))
877
878 (pass-if "n = -1"
879 (eqv? 0 (modulo fixnum-min -1)))
880
881 (pass-if "n = fixnum-max"
882 (eqv? (- fixnum-max 1) (modulo fixnum-min fixnum-max)))
883
884 (pass-if "n = fixnum-max + 1"
885 (eqv? 0 (modulo fixnum-min (+ fixnum-max 1))))
886
887 (pass-if "n = fixnum-min"
888 (eqv? 0 (modulo fixnum-min fixnum-min)))
889
890 (pass-if "n = fixnum-min - 1"
891 (eqv? fixnum-min (modulo fixnum-min (- fixnum-min 1)))))
892
893 (with-test-prefix "(fixnum-min - 1) % n"
894
895 (pass-if "n = 1"
896 (eqv? 0 (modulo (- fixnum-min 1) 1)))
897
898 (pass-if "n = -1"
899 (eqv? 0 (modulo (- fixnum-min 1) -1)))
900
901 (pass-if "n = fixnum-max"
902 (eqv? (- fixnum-max 2) (modulo (- fixnum-min 1) fixnum-max)))
903
904 (pass-if "n = fixnum-max + 1"
905 (eqv? fixnum-max (modulo (- fixnum-min 1) (+ fixnum-max 1))))
906
907 (pass-if "n = fixnum-min"
908 (eqv? -1 (modulo (- fixnum-min 1) fixnum-min)))
909
910 (pass-if "n = fixnum-min - 1"
911 (eqv? 0 (modulo (- fixnum-min 1) (- fixnum-min 1)))))
de142bea
DH
912
913 ;; Positive dividend and divisor
914
915 (pass-if "13 % 4"
916 (eqv? 1 (modulo 13 4)))
917
918 (pass-if "2177452800 % 86400"
919 (eqv? 0 (modulo 2177452800 86400)))
920
921 ;; Negative dividend, positive divisor
922
923 (pass-if "-13 % 4"
924 (eqv? 3 (modulo -13 4)))
925
926 (pass-if "-2177452800 % 86400"
927 (eqv? 0 (modulo -2177452800 86400)))
928
929 ;; Positive dividend, negative divisor
930
931 (pass-if "13 % -4"
932 (eqv? -3 (modulo 13 -4)))
933
934 (pass-if "2177452800 % -86400"
935 (eqv? 0 (modulo 2177452800 -86400)))
936
937 ;; Negative dividend and divisor
938
939 (pass-if "-13 % -4"
940 (eqv? -1 (modulo -13 -4)))
941
942 (pass-if "-2177452800 % -86400"
943 (eqv? 0 (modulo -2177452800 -86400)))
944
945 ;; Are numerical overflows detected correctly?
946
80074d77
DH
947 (with-test-prefix "division by zero"
948
949 (pass-if-exception "(modulo 1 0)"
950 exception:numerical-overflow
951 (modulo 1 0))
952
953 (pass-if-exception "(modulo bignum 0)"
954 exception:numerical-overflow
955 (modulo (+ fixnum-max 1) 0)))
956
de142bea
DH
957 ;; Are wrong type arguments detected correctly?
958
959 )
960
24360e11
KR
961;;;
962;;; modulo-expt
963;;;
964
965(with-test-prefix "modulo-expt"
966 (pass-if (= 1 (modulo-expt 17 23 47)))
967
968 (pass-if (= 1 (modulo-expt 17 -23 47)))
969
970 (pass-if (= 17 (modulo-expt 17 -22 47)))
971
972 (pass-if (= 36 (modulo-expt 17 22 47)))
973
974 (pass-if (= 183658794479969134816674175082294846241553725240 (modulo-expt 111122223333444455556666 111122223333444455556666 1153478690012629968439432872520758982731022934717)))
975
976 (pass-if-exception
977 "Proper exception with 0 modulus"
18ee5de9 978 exception:numerical-overflow
24360e11
KR
979 (modulo-expt 17 23 0))
980
981 (pass-if-exception
982 "Proper exception when result not invertible"
18ee5de9 983 exception:numerical-overflow
24360e11
KR
984 (modulo-expt 10 -1 48))
985
986 (pass-if-exception
987 "Proper exception with wrong type argument"
18ee5de9 988 exception:wrong-type-arg
24360e11
KR
989 (modulo-expt "Sam" 23 10))
990
991 (pass-if-exception
992 "Proper exception with wrong type argument"
18ee5de9 993 exception:wrong-type-arg
24360e11
KR
994 (modulo-expt 17 9.9 10))
995
996 (pass-if-exception
997 "Proper exception with wrong type argument"
18ee5de9 998 exception:wrong-type-arg
24360e11
KR
999 (modulo-expt 17 23 'Ethel)))
1000
ba46895c
KR
1001;;;
1002;;; numerator
1003;;;
1004
1005(with-test-prefix "numerator"
1006 (pass-if "0"
1007 (eqv? 0 (numerator 0)))
1008 (pass-if "1"
1009 (eqv? 1 (numerator 1)))
1010 (pass-if "2"
1011 (eqv? 2 (numerator 2)))
1012 (pass-if "-1"
1013 (eqv? -1 (numerator -1)))
1014 (pass-if "-2"
1015 (eqv? -2 (numerator -2)))
1016
1017 (pass-if "0.0"
1018 (eqv? 0.0 (numerator 0.0)))
1019 (pass-if "1.0"
1020 (eqv? 1.0 (numerator 1.0)))
1021 (pass-if "2.0"
1022 (eqv? 2.0 (numerator 2.0)))
1023 (pass-if "-1.0"
1024 (eqv? -1.0 (numerator -1.0)))
1025 (pass-if "-2.0"
1026 (eqv? -2.0 (numerator -2.0)))
1027
1028 (pass-if "0.5"
1029 (eqv? 1.0 (numerator 0.5)))
1030 (pass-if "0.25"
1031 (eqv? 1.0 (numerator 0.25)))
1032 (pass-if "0.75"
1033 (eqv? 3.0 (numerator 0.75))))
1034
1035;;;
1036;;; denominator
1037;;;
1038
1039(with-test-prefix "denominator"
1040 (pass-if "0"
1041 (eqv? 1 (denominator 0)))
1042 (pass-if "1"
1043 (eqv? 1 (denominator 1)))
1044 (pass-if "2"
1045 (eqv? 1 (denominator 2)))
1046 (pass-if "-1"
1047 (eqv? 1 (denominator -1)))
1048 (pass-if "-2"
1049 (eqv? 1 (denominator -2)))
1050
1051 (pass-if "0.0"
1052 (eqv? 1.0 (denominator 0.0)))
1053 (pass-if "1.0"
1054 (eqv? 1.0 (denominator 1.0)))
1055 (pass-if "2.0"
1056 (eqv? 1.0 (denominator 2.0)))
1057 (pass-if "-1.0"
1058 (eqv? 1.0 (denominator -1.0)))
1059 (pass-if "-2.0"
1060 (eqv? 1.0 (denominator -2.0)))
1061
1062 (pass-if "0.5"
1063 (eqv? 2.0 (denominator 0.5)))
1064 (pass-if "0.25"
1065 (eqv? 4.0 (denominator 0.25)))
1066 (pass-if "0.75"
1067 (eqv? 4.0 (denominator 0.75))))
1068
de142bea
DH
1069;;;
1070;;; gcd
1071;;;
1072
1073(with-test-prefix "gcd"
1074
d389e966 1075 (pass-if "documented?"
cb18f2a8 1076 (documented? gcd))
de142bea 1077
1dd79792
NJ
1078 (with-test-prefix "(n)"
1079
1080 (pass-if "n = -2"
1081 (eqv? 2 (gcd -2))))
1082
de142bea
DH
1083 (with-test-prefix "(0 n)"
1084
21e39e8f
DH
1085 (pass-if "n = 0"
1086 (eqv? 0 (gcd 0 0)))
1087
de142bea
DH
1088 (pass-if "n = 1"
1089 (eqv? 1 (gcd 0 1)))
1090
1091 (pass-if "n = -1"
1092 (eqv? 1 (gcd 0 -1)))
1093
21e39e8f
DH
1094 (pass-if "n = fixnum-max"
1095 (eqv? fixnum-max (gcd 0 fixnum-max)))
de142bea 1096
21e39e8f
DH
1097 (pass-if "n = fixnum-max + 1"
1098 (eqv? (+ fixnum-max 1) (gcd 0 (+ fixnum-max 1))))
de142bea 1099
21e39e8f
DH
1100 (pass-if "n = fixnum-min"
1101 (eqv? (- fixnum-min) (gcd 0 fixnum-min)))
de142bea 1102
21e39e8f
DH
1103 (pass-if "n = fixnum-min - 1"
1104 (eqv? (- (- fixnum-min 1)) (gcd 0 (- fixnum-min 1)))))
1105
db386f80
KR
1106 (with-test-prefix "(n 0)"
1107
1108 (pass-if "n = 2^128 * fixnum-max"
1109 (eqv? (ash fixnum-max 128) (gcd (ash fixnum-max 128) 0))))
1110
21e39e8f
DH
1111 (with-test-prefix "(1 n)"
1112
1113 (pass-if "n = 0"
de142bea
DH
1114 (eqv? 1 (gcd 1 0)))
1115
21e39e8f
DH
1116 (pass-if "n = 1"
1117 (eqv? 1 (gcd 1 1)))
1118
de142bea 1119 (pass-if "n = -1"
21e39e8f
DH
1120 (eqv? 1 (gcd 1 -1)))
1121
1122 (pass-if "n = fixnum-max"
1123 (eqv? 1 (gcd 1 fixnum-max)))
1124
1125 (pass-if "n = fixnum-max + 1"
1126 (eqv? 1 (gcd 1 (+ fixnum-max 1))))
1127
1128 (pass-if "n = fixnum-min"
1129 (eqv? 1 (gcd 1 fixnum-min)))
1130
1131 (pass-if "n = fixnum-min - 1"
1132 (eqv? 1 (gcd 1 (- fixnum-min 1)))))
1133
1134 (with-test-prefix "(-1 n)"
1135
1136 (pass-if "n = 0"
de142bea
DH
1137 (eqv? 1 (gcd -1 0)))
1138
21e39e8f
DH
1139 (pass-if "n = 1"
1140 (eqv? 1 (gcd -1 1)))
de142bea 1141
21e39e8f
DH
1142 (pass-if "n = -1"
1143 (eqv? 1 (gcd -1 -1)))
de142bea 1144
21e39e8f
DH
1145 (pass-if "n = fixnum-max"
1146 (eqv? 1 (gcd -1 fixnum-max)))
1147
1148 (pass-if "n = fixnum-max + 1"
1149 (eqv? 1 (gcd -1 (+ fixnum-max 1))))
1150
1151 (pass-if "n = fixnum-min"
1152 (eqv? 1 (gcd -1 fixnum-min)))
1153
1154 (pass-if "n = fixnum-min - 1"
1155 (eqv? 1 (gcd -1 (- fixnum-min 1)))))
1156
1157 (with-test-prefix "(fixnum-max n)"
1158
1159 (pass-if "n = 0"
1160 (eqv? fixnum-max (gcd fixnum-max 0)))
de142bea
DH
1161
1162 (pass-if "n = 1"
21e39e8f 1163 (eqv? 1 (gcd fixnum-max 1)))
de142bea
DH
1164
1165 (pass-if "n = -1"
21e39e8f
DH
1166 (eqv? 1 (gcd fixnum-max -1)))
1167
1168 (pass-if "n = fixnum-max"
1169 (eqv? fixnum-max (gcd fixnum-max fixnum-max)))
de142bea 1170
21e39e8f
DH
1171 (pass-if "n = fixnum-max + 1"
1172 (eqv? 1 (gcd fixnum-max (+ fixnum-max 1))))
de142bea 1173
21e39e8f
DH
1174 (pass-if "n = fixnum-min"
1175 (eqv? 1 (gcd fixnum-max fixnum-min)))
de142bea 1176
21e39e8f
DH
1177 (pass-if "n = fixnum-min - 1"
1178 (eqv? 1 (gcd fixnum-max (- fixnum-min 1)))))
1179
1180 (with-test-prefix "((+ fixnum-max 1) n)"
1181
1182 (pass-if "n = 0"
1183 (eqv? (+ fixnum-max 1) (gcd (+ fixnum-max 1) 0)))
1184
1185 (pass-if "n = 1"
1186 (eqv? 1 (gcd (+ fixnum-max 1) 1)))
de142bea
DH
1187
1188 (pass-if "n = -1"
21e39e8f 1189 (eqv? 1 (gcd (+ fixnum-max 1) -1)))
de142bea 1190
21e39e8f
DH
1191 (pass-if "n = fixnum-max"
1192 (eqv? 1 (gcd (+ fixnum-max 1) fixnum-max)))
de142bea 1193
21e39e8f
DH
1194 (pass-if "n = fixnum-max + 1"
1195 (eqv? (+ fixnum-max 1) (gcd (+ fixnum-max 1) (+ fixnum-max 1))))
de142bea 1196
21e39e8f
DH
1197 (pass-if "n = fixnum-min"
1198 (eqv? (+ fixnum-max 1) (gcd (+ fixnum-max 1) fixnum-min)))
1199
1200 (pass-if "n = fixnum-min - 1"
1201 (eqv? 1 (gcd (+ fixnum-max 1) (- fixnum-min 1)))))
1202
1203 (with-test-prefix "(fixnum-min n)"
1204
1205 (pass-if "n = 0"
1206 (eqv? (- fixnum-min) (gcd fixnum-min 0)))
1207
1208 (pass-if "n = 1"
1209 (eqv? 1 (gcd fixnum-min 1)))
de142bea
DH
1210
1211 (pass-if "n = -1"
21e39e8f
DH
1212 (eqv? 1 (gcd fixnum-min -1)))
1213
1214 (pass-if "n = fixnum-max"
1215 (eqv? 1 (gcd fixnum-min fixnum-max)))
1216
1217 (pass-if "n = fixnum-max + 1"
1218 (eqv? (+ fixnum-max 1) (gcd fixnum-min (+ fixnum-max 1))))
de142bea 1219
21e39e8f
DH
1220 (pass-if "n = fixnum-min"
1221 (eqv? (- fixnum-min) (gcd fixnum-min fixnum-min)))
1222
1223 (pass-if "n = fixnum-min - 1"
1224 (eqv? 1 (gcd fixnum-min (- fixnum-min 1)))))
1225
1226 (with-test-prefix "((- fixnum-min 1) n)"
1227
1228 (pass-if "n = 0"
1229 (eqv? (- (- fixnum-min 1)) (gcd (- fixnum-min 1) 0)))
1230
1231 (pass-if "n = 1"
1232 (eqv? 1 (gcd (- fixnum-min 1) 1)))
1233
1234 (pass-if "n = -1"
1235 (eqv? 1 (gcd (- fixnum-min 1) -1)))
1236
1237 (pass-if "n = fixnum-max"
1238 (eqv? 1 (gcd (- fixnum-min 1) fixnum-max)))
1239
1240 (pass-if "n = fixnum-max + 1"
1241 (eqv? 1 (gcd (- fixnum-min 1) (+ fixnum-max 1))))
1242
1243 (pass-if "n = fixnum-min"
1244 (eqv? 1 (gcd (- fixnum-min 1) fixnum-min)))
1245
1246 (pass-if "n = fixnum-min - 1"
1247 (eqv? (- (- fixnum-min 1)) (gcd (- fixnum-min 1) (- fixnum-min 1)))))
de142bea
DH
1248
1249 ;; Are wrong type arguments detected correctly?
1250
1251 )
1252
f29b3454
DH
1253;;;
1254;;; lcm
1255;;;
1256
7c24e528
RB
1257(with-test-prefix "lcm"
1258 ;; FIXME: more tests?
1259 ;; (some of these are already in r4rs.test)
d389e966 1260 (pass-if (documented? lcm))
7c24e528
RB
1261 (pass-if (= (lcm) 1))
1262 (pass-if (= (lcm 32 -36) 288))
1263 (let ((big-n 115792089237316195423570985008687907853269984665640564039457584007913129639936) ; 2 ^ 256
1264 (lcm-of-big-n-and-11 1273712981610478149659280835095566986385969831322046204434033424087044426039296))
1265 (pass-if (= lcm-of-big-n-and-11 (lcm big-n 11)))
1266 (pass-if (= lcm-of-big-n-and-11 (lcm 11 big-n 11)))))
1267
f29b3454
DH
1268;;;
1269;;; number->string
1270;;;
1271
7c24e528
RB
1272(with-test-prefix "number->string"
1273 (let ((num->str->num
1274 (lambda (n radix)
1275 (string->number (number->string n radix) radix))))
1276
1277 (pass-if (documented? number->string))
1278 (pass-if (string=? (number->string 0) "0"))
1279 (pass-if (string=? (number->string 171) "171"))
1280 (pass-if (= (+ fixnum-max 1) (num->str->num (+ fixnum-max 1) 10)))
1281 (pass-if (= (- fixnum-min 1) (num->str->num (- fixnum-min 1) 10)))
1282 (pass-if (= (inf) (num->str->num (inf) 10)))
d39a7b58
MV
1283 (pass-if (= 1.3 (num->str->num 1.3 10)))
1284
eb73f94b
MV
1285 ;; XXX - some results depend on whether Guile is compiled optimzed
1286 ;; or not. It is clearly undesirable to have number->string to be
1287 ;; influenced by this.
1288
3740c788 1289 (pass-if (string=? (number->string 35.25 36) "z.9"))
eb73f94b
MV
1290 (pass-if (or (string=? (number->string 0.25 2) "0.01")
1291 (string=? (number->string 0.25 2) "0.010")))
3740c788 1292 (pass-if (string=? (number->string 255.0625 16) "ff.1"))
d39a7b58 1293 (pass-if (string=? (number->string (/ 1 3) 3) "1/10"))
23f2b9a3 1294
a6f3af16 1295 (pass-if (string=? (number->string 10) "10"))
3740c788 1296 (pass-if (string=? (number->string 10 11) "a"))
a6f3af16
AW
1297 (pass-if (string=? (number->string 36 36) "10"))
1298 (pass-if (= (num->str->num 36 36) 36))
1299 (pass-if (= (string->number "z" 36) 35))
1300 (pass-if (= (string->number "Z" 36) 35))
1301 (pass-if (not (string->number "Z" 35)))
3740c788 1302 (pass-if (string=? (number->string 35 36) "z"))
a6f3af16
AW
1303 (pass-if (= (num->str->num 35 36) 35))
1304
23f2b9a3
KR
1305 ;; Numeric conversion from decimal is not precise, in its current
1306 ;; implementation, so 11.333... and 1.324... can't be expected to
1307 ;; reliably come out to precise values. These tests did actually work
1308 ;; for a while, but something in gcc changed, affecting the conversion
1309 ;; code.
1310 ;;
1311 ;; (pass-if (or (string=? (number->string 11.33333333333333333 12)
1312 ;; "B.4")
1313 ;; (string=? (number->string 11.33333333333333333 12)
1314 ;; "B.400000000000009")))
1315 ;; (pass-if (or (string=? (number->string 1.324e44 16)
1316 ;; "5.EFE0A14FAFEe24")
1317 ;; (string=? (number->string 1.324e44 16)
1318 ;; "5.EFE0A14FAFDF8e24")))
1319 ))
7c24e528 1320
f29b3454
DH
1321;;;
1322;;; string->number
1323;;;
1324
2f4a254a
DH
1325(with-test-prefix "string->number"
1326
ff758237 1327 (pass-if "documented?"
2f4a254a
DH
1328 (documented? string->number))
1329
1330 (pass-if "non number strings"
1331 (for-each (lambda (x) (if (string->number x) (throw 'fail)))
569c483b 1332 '("" "q" "1q" "6+7iq" "8+9q" "10+11" "13+" "18@19q" "20@q" "23@"
2f4a254a 1333 "+25iq" "26i" "-q" "-iq" "i" "5#.0" "8/" "10#11" ".#" "."
569c483b 1334 "#o.2" "3.4q" "15.16e17q" "18.19e+q" ".q" ".17#18" "10q" "#b2"
2f4a254a
DH
1335 "#b3" "#b4" "#b5" "#b6" "#b7" "#b8" "#b9" "#ba" "#bb" "#bc"
1336 "#bd" "#be" "#bf" "#q" "#b#b1" "#o#o1" "#d#d1" "#x#x1" "#e#e1"
1337 "#i#i1" "12@12+0i"))
1338 #t)
1339
b7d9b1cf
DH
1340 (pass-if "valid number strings"
1341 (for-each (lambda (couple)
1342 (apply
1343 (lambda (x y)
9dd9857f
MV
1344 (let ((xx (string->number x)))
1345 (if (or (eq? xx #f) (not (eqv? xx y)))
ca2b31fe
MV
1346 (begin
1347 (pk x y)
1348 (throw 'fail)))))
b7d9b1cf
DH
1349 couple))
1350 `(;; Radix:
1351 ("#b0" 0) ("#B0" 0) ("#b1" 1) ("#B1" 1) ("#o0" 0) ("#O0" 0)
1352 ("#o1" 1) ("#O1" 1) ("#o2" 2) ("#O2" 2) ("#o3" 3) ("#O3" 3)
1353 ("#o4" 4) ("#O4" 4) ("#o5" 5) ("#O5" 5) ("#o6" 6) ("#O6" 6)
1354 ("#o7" 7) ("#O7" 7) ("#d0" 0) ("#D0" 0) ("#d1" 1) ("#D1" 1)
1355 ("#d2" 2) ("#D2" 2) ("#d3" 3) ("#D3" 3) ("#d4" 4) ("#D4" 4)
1356 ("#d5" 5) ("#D5" 5) ("#d6" 6) ("#D6" 6) ("#d7" 7) ("#D7" 7)
1357 ("#d8" 8) ("#D8" 8) ("#d9" 9) ("#D9" 9)
1358 ("#xa" 10) ("#Xa" 10) ("#xb" 11) ("#Xb" 11)
1359 ("#xc" 12) ("#Xc" 12) ("#xd" 13) ("#Xd" 13)
1360 ("#xe" 14) ("#Xe" 14) ("#xf" 15) ("#Xf" 15)
1361 ("#b1010" 10)
1362 ("#o12345670" 2739128)
1363 ("#d1234567890" 1234567890)
1364 ("#x1234567890abcdef" 1311768467294899695)
1365 ;; Exactness:
ca2b31fe 1366 ("#e1" 1) ("#e1.2" 12/10)
9dd9857f 1367 ("#i1.1" 1.1) ("#i1" 1.0)
b7d9b1cf
DH
1368 ;; Integers:
1369 ("1" ,(1+ 0)) ("23" ,(+ 9 9 5)) ("-1" ,(- 0 1))
1370 ("-45" ,(- 0 45)) ("2#" 20.0) ("2##" 200.0) ("12##" 1200.0)
1371 ("#b#i100" 4.0)
9dd9857f
MV
1372 ;; Fractions:
1373 ("1/1" 1) ("1/2" 1/2) ("-1/2" -1/2) ("1#/1" 10.0)
1374 ("10/1#" 1.0) ("1#/1#" 1.0) ("#e9/10" 9/10) ("#e10/1#" 1)
b7d9b1cf
DH
1375 ("#i6/8" 0.75) ("#i1/1" 1.0)
1376 ;; Decimal numbers:
1377 ;; * <uinteger 10> <suffix>
1378 ("1e2" 100.0) ("1E2" 100.0) ("1s2" 100.0) ("1S2" 100.0)
1379 ("1f2" 100.0) ("1F2" 100.0) ("1d2" 100.0) ("1D2" 100.0)
1380 ("1l2" 100.0) ("1L2" 100.0) ("1e+2" 100.0) ("1e-2" 0.01)
1381 ;; * . <digit 10>+ #* <suffix>
1382 (".1" .1) (".0123456789" 123456789e-10) (".16#" 0.16)
1383 (".0123456789e10" 123456789.0) (".16#e3" 160.0) ("#d.3" 0.3)
1384 ;; * <digit 10>+ . <digit 10>* #* <suffix>
1385 ("3." ,(exact->inexact 3)) ("3.e0" ,(exact->inexact 3))
1386 ("3.1" ,(exact->inexact 31/10)) ("3.1e0" 3.1) ("3.1#" 3.1)
1387 ("3.1#e0" 3.1)
1388 ;; * <digit 10>+ #+ . #* <suffix>
1389 ("3#." 30.0) ("3#.e0" 30.0) ("3#.#" 30.0) ("3#.#e0" 30.0)
1390 ;; Complex:
1391 ("1@0" 1.0) ("1@+0" 1.0) ("1@-0" 1.0)
1392 ("2+3i" ,(+ 2 (* 3 +i))) ("4-5i" ,(- 4 (* 5 +i)))
1393 ("1+i" 1+1i) ("1-i" 1-1i) ("+1i" 0+1i) ("-1i" 0-1i)
40f89215
NJ
1394 ("+i" +1i) ("-i" -1i)
1395 ("1.0+.1i" 1.0+0.1i)
1396 ("1.0-.1i" 1.0-0.1i)
1397 (".1+.0i" 0.1)
1398 ("1.+.0i" 1.0)
1399 (".1+.1i" 0.1+0.1i)
1400 ("1e1+.1i" 10+0.1i)
1401 ))
b7d9b1cf
DH
1402 #t)
1403
2f4a254a
DH
1404 (pass-if-exception "exponent too big"
1405 exception:out-of-range
48e78ba6
KR
1406 (string->number "12.13e141414"))
1407
1408 ;; in guile 1.6.7 and earlier, bad polar forms (where the conversion of
1409 ;; the angle gave #f) caused a segv
1410 (pass-if "1@a"
1411 (eq? #f (string->number "1@a"))))
2f4a254a 1412
f29b3454
DH
1413;;;
1414;;; number?
1415;;;
1416
7c24e528
RB
1417(with-test-prefix "number?"
1418 (pass-if (documented? number?))
1419 (pass-if (number? 0))
1420 (pass-if (number? 7))
1421 (pass-if (number? -7))
1422 (pass-if (number? 1.3))
1423 (pass-if (number? (+ 1 fixnum-max)))
1424 (pass-if (number? (- 1 fixnum-min)))
1425 (pass-if (number? 3+4i))
4d332f19
DH
1426 (pass-if (not (number? #\a)))
1427 (pass-if (not (number? "a")))
1428 (pass-if (not (number? (make-vector 0))))
1429 (pass-if (not (number? (cons 1 2))))
1430 (pass-if (not (number? #t)))
1431 (pass-if (not (number? (lambda () #t))))
1432 (pass-if (not (number? (current-input-port)))))
7c24e528 1433
f29b3454
DH
1434;;;
1435;;; complex?
1436;;;
1437
7c24e528
RB
1438(with-test-prefix "complex?"
1439 (pass-if (documented? complex?))
1440 (pass-if (complex? 0))
1441 (pass-if (complex? 7))
1442 (pass-if (complex? -7))
1443 (pass-if (complex? (+ 1 fixnum-max)))
1444 (pass-if (complex? (- 1 fixnum-min)))
1445 (pass-if (complex? 1.3))
1446 (pass-if (complex? 3+4i))
4d332f19
DH
1447 (pass-if (not (complex? #\a)))
1448 (pass-if (not (complex? "a")))
1449 (pass-if (not (complex? (make-vector 0))))
1450 (pass-if (not (complex? (cons 1 2))))
1451 (pass-if (not (complex? #t)))
1452 (pass-if (not (complex? (lambda () #t))))
1453 (pass-if (not (complex? (current-input-port)))))
7c24e528 1454
f29b3454
DH
1455;;;
1456;;; real?
1457;;;
1458
7c24e528
RB
1459(with-test-prefix "real?"
1460 (pass-if (documented? real?))
1461 (pass-if (real? 0))
1462 (pass-if (real? 7))
1463 (pass-if (real? -7))
1464 (pass-if (real? (+ 1 fixnum-max)))
1465 (pass-if (real? (- 1 fixnum-min)))
1466 (pass-if (real? 1.3))
4d332f19
DH
1467 (pass-if (not (real? 3+4i)))
1468 (pass-if (not (real? #\a)))
1469 (pass-if (not (real? "a")))
1470 (pass-if (not (real? (make-vector 0))))
1471 (pass-if (not (real? (cons 1 2))))
1472 (pass-if (not (real? #t)))
1473 (pass-if (not (real? (lambda () #t))))
1474 (pass-if (not (real? (current-input-port)))))
7c24e528 1475
f29b3454 1476;;;
7c24e528 1477;;; rational? (same as real? right now)
f29b3454
DH
1478;;;
1479
7c24e528
RB
1480(with-test-prefix "rational?"
1481 (pass-if (documented? rational?))
1482 (pass-if (rational? 0))
1483 (pass-if (rational? 7))
1484 (pass-if (rational? -7))
1485 (pass-if (rational? (+ 1 fixnum-max)))
1486 (pass-if (rational? (- 1 fixnum-min)))
1487 (pass-if (rational? 1.3))
4d332f19
DH
1488 (pass-if (not (rational? 3+4i)))
1489 (pass-if (not (rational? #\a)))
1490 (pass-if (not (rational? "a")))
1491 (pass-if (not (rational? (make-vector 0))))
1492 (pass-if (not (rational? (cons 1 2))))
1493 (pass-if (not (rational? #t)))
1494 (pass-if (not (rational? (lambda () #t))))
1495 (pass-if (not (rational? (current-input-port)))))
7c24e528 1496
f29b3454
DH
1497;;;
1498;;; integer?
1499;;;
1500
7c24e528
RB
1501(with-test-prefix "integer?"
1502 (pass-if (documented? integer?))
1503 (pass-if (integer? 0))
1504 (pass-if (integer? 7))
1505 (pass-if (integer? -7))
1506 (pass-if (integer? (+ 1 fixnum-max)))
1507 (pass-if (integer? (- 1 fixnum-min)))
1508 (pass-if (and (= 3+0i (round 3+0i)) (integer? 3+0i)))
1509 (pass-if (and (= 1.0 (round 1.0)) (integer? 1.0)))
4d332f19 1510 (pass-if (not (integer? 1.3)))
e456f08e
KR
1511 (pass-if (integer? +inf.0))
1512 (pass-if (integer? -inf.0))
c1122753 1513 (pass-if (not (integer? +nan.0)))
4d332f19
DH
1514 (pass-if (not (integer? 3+4i)))
1515 (pass-if (not (integer? #\a)))
1516 (pass-if (not (integer? "a")))
1517 (pass-if (not (integer? (make-vector 0))))
1518 (pass-if (not (integer? (cons 1 2))))
1519 (pass-if (not (integer? #t)))
1520 (pass-if (not (integer? (lambda () #t))))
1521 (pass-if (not (integer? (current-input-port)))))
7c24e528 1522
f29b3454
DH
1523;;;
1524;;; inexact?
1525;;;
1526
7c24e528
RB
1527(with-test-prefix "inexact?"
1528 (pass-if (documented? inexact?))
4d332f19
DH
1529 (pass-if (not (inexact? 0)))
1530 (pass-if (not (inexact? 7)))
1531 (pass-if (not (inexact? -7)))
1532 (pass-if (not (inexact? (+ 1 fixnum-max))))
1533 (pass-if (not (inexact? (- 1 fixnum-min))))
7c24e528
RB
1534 (pass-if (inexact? 1.3))
1535 (pass-if (inexact? 3.1+4.2i))
ca2b31fe
MV
1536 (pass-if-exception "char"
1537 exception:wrong-type-arg
1538 (not (inexact? #\a)))
1539 (pass-if-exception "string"
1540 exception:wrong-type-arg
1541 (not (inexact? "a")))
1542 (pass-if-exception "vector"
1543 exception:wrong-type-arg
1544 (not (inexact? (make-vector 0))))
1545 (pass-if-exception "cons"
1546 exception:wrong-type-arg
1547 (not (inexact? (cons 1 2))))
1548 (pass-if-exception "bool"
1549 exception:wrong-type-arg
1550 (not (inexact? #t)))
1551 (pass-if-exception "procedure"
1552 exception:wrong-type-arg
1553 (not (inexact? (lambda () #t))))
1554 (pass-if-exception "port"
1555 exception:wrong-type-arg
1556 (not (inexact? (current-input-port)))))
7c24e528 1557
47ae1f0e
DH
1558;;;
1559;;; equal?
1560;;;
1561
1562(with-test-prefix "equal?"
1563 (pass-if (documented? equal?))
1564 (pass-if (equal? 0 0))
1565 (pass-if (equal? 7 7))
1566 (pass-if (equal? -7 -7))
1567 (pass-if (equal? (+ 1 fixnum-max) (+ 1 fixnum-max)))
1568 (pass-if (equal? (- fixnum-min 1) (- fixnum-min 1)))
1569 (pass-if (not (equal? 0 1)))
1570 (pass-if (not (equal? fixnum-max (+ 1 fixnum-max))))
1571 (pass-if (not (equal? (+ 1 fixnum-max) fixnum-max)))
1572 (pass-if (not (equal? (+ 1 fixnum-max) (+ 2 fixnum-max))))
1573 (pass-if (not (equal? fixnum-min (- fixnum-min 1))))
1574 (pass-if (not (equal? (- fixnum-min 1) fixnum-min)))
1575 (pass-if (not (equal? (- fixnum-min 1) (- fixnum-min 2))))
1576 (pass-if (not (equal? (+ fixnum-max 1) (- fixnum-min 1))))
1577
1578 (pass-if (not (equal? (ash 1 256) +inf.0)))
1579 (pass-if (not (equal? +inf.0 (ash 1 256))))
1580 (pass-if (not (equal? (ash 1 256) -inf.0)))
1581 (pass-if (not (equal? -inf.0 (ash 1 256))))
1582
1583 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
1584 ;; sure we've avoided that
1585 (pass-if (not (equal? (ash 1 1024) +inf.0)))
1586 (pass-if (not (equal? +inf.0 (ash 1 1024))))
1587 (pass-if (not (equal? (- (ash 1 1024)) -inf.0)))
1588 (pass-if (not (equal? -inf.0 (- (ash 1 1024)))))
1589
1590 (pass-if (not (equal? +nan.0 +nan.0)))
1591 (pass-if (not (equal? 0 +nan.0)))
1592 (pass-if (not (equal? +nan.0 0)))
1593 (pass-if (not (equal? 1 +nan.0)))
1594 (pass-if (not (equal? +nan.0 1)))
1595 (pass-if (not (equal? -1 +nan.0)))
1596 (pass-if (not (equal? +nan.0 -1)))
1597
1598 (pass-if (not (equal? (ash 1 256) +nan.0)))
1599 (pass-if (not (equal? +nan.0 (ash 1 256))))
1600 (pass-if (not (equal? (- (ash 1 256)) +nan.0)))
1601 (pass-if (not (equal? +nan.0 (- (ash 1 256)))))
1602
1603 (pass-if (not (equal? (ash 1 8192) +nan.0)))
1604 (pass-if (not (equal? +nan.0 (ash 1 8192))))
1605 (pass-if (not (equal? (- (ash 1 8192)) +nan.0)))
1606 (pass-if (not (equal? +nan.0 (- (ash 1 8192)))))
1607
1608 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
1609 ;; sure we've avoided that
1610 (pass-if (not (equal? (ash 3 1023) +nan.0)))
1611 (pass-if (not (equal? +nan.0 (ash 3 1023)))))
1612
f29b3454
DH
1613;;;
1614;;; =
1615;;;
1616
7c24e528 1617(with-test-prefix "="
8a1f4f98 1618 (pass-if (documented? =))
7c24e528
RB
1619 (pass-if (= 0 0))
1620 (pass-if (= 7 7))
1621 (pass-if (= -7 -7))
1622 (pass-if (= (+ 1 fixnum-max) (+ 1 fixnum-max)))
47ae1f0e 1623 (pass-if (= (- fixnum-min 1) (- fixnum-min 1)))
4d332f19
DH
1624 (pass-if (not (= 0 1)))
1625 (pass-if (not (= fixnum-max (+ 1 fixnum-max))))
1626 (pass-if (not (= (+ 1 fixnum-max) fixnum-max)))
47ae1f0e 1627 (pass-if (not (= (+ 1 fixnum-max) (+ 2 fixnum-max))))
4d332f19
DH
1628 (pass-if (not (= fixnum-min (- fixnum-min 1))))
1629 (pass-if (not (= (- fixnum-min 1) fixnum-min)))
47ae1f0e 1630 (pass-if (not (= (- fixnum-min 1) (- fixnum-min 2))))
4d332f19 1631 (pass-if (not (= (+ fixnum-max 1) (- fixnum-min 1))))
2cfcaed5 1632
adda36ed
KR
1633 (pass-if (not (= (ash 1 256) +inf.0)))
1634 (pass-if (not (= +inf.0 (ash 1 256))))
1635 (pass-if (not (= (ash 1 256) -inf.0)))
1636 (pass-if (not (= -inf.0 (ash 1 256))))
1637
1638 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
1639 ;; sure we've avoided that
1640 (pass-if (not (= (ash 1 1024) +inf.0)))
1641 (pass-if (not (= +inf.0 (ash 1 1024))))
1642 (pass-if (not (= (- (ash 1 1024)) -inf.0)))
1643 (pass-if (not (= -inf.0 (- (ash 1 1024)))))
1644
2cfcaed5
KR
1645 (pass-if (not (= +nan.0 +nan.0)))
1646 (pass-if (not (= 0 +nan.0)))
1647 (pass-if (not (= +nan.0 0)))
1648 (pass-if (not (= 1 +nan.0)))
1649 (pass-if (not (= +nan.0 1)))
1650 (pass-if (not (= -1 +nan.0)))
1651 (pass-if (not (= +nan.0 -1)))
1652
1653 (pass-if (not (= (ash 1 256) +nan.0)))
1654 (pass-if (not (= +nan.0 (ash 1 256))))
1655 (pass-if (not (= (- (ash 1 256)) +nan.0)))
1656 (pass-if (not (= +nan.0 (- (ash 1 256)))))
1657
1658 (pass-if (not (= (ash 1 8192) +nan.0)))
1659 (pass-if (not (= +nan.0 (ash 1 8192))))
1660 (pass-if (not (= (- (ash 1 8192)) +nan.0)))
1661 (pass-if (not (= +nan.0 (- (ash 1 8192)))))
1662
1663 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
1664 ;; sure we've avoided that
1665 (pass-if (not (= (ash 3 1023) +nan.0)))
2a8b5e04
KR
1666 (pass-if (not (= +nan.0 (ash 3 1023))))
1667
1668 (pass-if (= 1/2 0.5))
1669 (pass-if (not (= 1/3 0.333333333333333333333333333333333)))
1670 (pass-if (not (= 2/3 0.5)))
1671 (pass-if (not (= 0.5 (+ 1/2 (/ 1 (ash 1 1000))))))
1672
1673 (pass-if (= 1/2 0.5+0i))
1674 (pass-if (not (= 0.333333333333333333333333333333333 1/3)))
1675 (pass-if (not (= 2/3 0.5+0i)))
1676 (pass-if (not (= 1/2 0+0.5i)))
1677
1678 (pass-if (= 0.5 1/2))
1679 (pass-if (not (= 0.5 2/3)))
1680 (pass-if (not (= (+ 1/2 (/ 1 (ash 1 1000))) 0.5)))
1681
1682 (pass-if (= 0.5+0i 1/2))
1683 (pass-if (not (= 0.5+0i 2/3)))
6f6847fa
KR
1684 (pass-if (not (= 0+0.5i 1/2)))
1685
1686 ;; prior to guile 1.8, inum/flonum comparisons were done just by
1687 ;; converting the inum to a double, which on a 64-bit would round making
1688 ;; say inexact 2^58 appear equal to exact 2^58+1
1689 (pass-if (= (ash-flo 1.0 58) (ash 1 58)))
1690 (pass-if (not (= (ash-flo 1.0 58) (1+ (ash 1 58)))))
1691 (pass-if (not (= (ash-flo 1.0 58) (1- (ash 1 58)))))
1692 (pass-if (= (ash 1 58) (ash-flo 1.0 58)))
1693 (pass-if (not (= (1+ (ash 1 58)) (ash-flo 1.0 58))))
1694 (pass-if (not (= (1- (ash 1 58)) (ash-flo 1.0 58)))))
7c24e528 1695
de142bea
DH
1696;;;
1697;;; <
1698;;;
1699
1700(with-test-prefix "<"
1701
8a1f4f98 1702 (pass-if "documented?"
cb18f2a8 1703 (documented? <))
de142bea 1704
de142bea
DH
1705 (with-test-prefix "(< 0 n)"
1706
1707 (pass-if "n = 0"
1708 (not (< 0 0)))
1709
1710 (pass-if "n = 0.0"
1711 (not (< 0 0.0)))
1712
1713 (pass-if "n = 1"
1714 (< 0 1))
1715
1716 (pass-if "n = 1.0"
1717 (< 0 1.0))
1718
1719 (pass-if "n = -1"
1720 (not (< 0 -1)))
1721
1722 (pass-if "n = -1.0"
1723 (not (< 0 -1.0)))
1724
21e39e8f
DH
1725 (pass-if "n = fixnum-max"
1726 (< 0 fixnum-max))
1727
1728 (pass-if "n = fixnum-max + 1"
1729 (< 0 (+ fixnum-max 1)))
1730
1731 (pass-if "n = fixnum-min"
1732 (not (< 0 fixnum-min)))
de142bea 1733
21e39e8f
DH
1734 (pass-if "n = fixnum-min - 1"
1735 (not (< 0 (- fixnum-min 1)))))
1736
de142bea
DH
1737 (with-test-prefix "(< 0.0 n)"
1738
1739 (pass-if "n = 0"
1740 (not (< 0.0 0)))
1741
1742 (pass-if "n = 0.0"
1743 (not (< 0.0 0.0)))
1744
1745 (pass-if "n = 1"
1746 (< 0.0 1))
1747
1748 (pass-if "n = 1.0"
1749 (< 0.0 1.0))
1750
1751 (pass-if "n = -1"
1752 (not (< 0.0 -1)))
1753
1754 (pass-if "n = -1.0"
1755 (not (< 0.0 -1.0)))
1756
21e39e8f
DH
1757 (pass-if "n = fixnum-max"
1758 (< 0.0 fixnum-max))
1759
1760 (pass-if "n = fixnum-max + 1"
1761 (< 0.0 (+ fixnum-max 1)))
de142bea 1762
21e39e8f
DH
1763 (pass-if "n = fixnum-min"
1764 (not (< 0.0 fixnum-min)))
1765
1766 (pass-if "n = fixnum-min - 1"
1767 (not (< 0.0 (- fixnum-min 1)))))
1768
1769 (with-test-prefix "(< 1 n)"
de142bea 1770
21e39e8f 1771 (pass-if "n = 0"
de142bea
DH
1772 (not (< 1 0)))
1773
21e39e8f
DH
1774 (pass-if "n = 0.0"
1775 (not (< 1 0.0)))
1776
1777 (pass-if "n = 1"
1778 (not (< 1 1)))
1779
de142bea 1780 (pass-if "n = 1.0"
21e39e8f
DH
1781 (not (< 1 1.0)))
1782
1783 (pass-if "n = -1"
1784 (not (< 1 -1)))
1785
1786 (pass-if "n = -1.0"
1787 (not (< 1 -1.0)))
1788
1789 (pass-if "n = fixnum-max"
1790 (< 1 fixnum-max))
1791
1792 (pass-if "n = fixnum-max + 1"
1793 (< 1 (+ fixnum-max 1)))
1794
1795 (pass-if "n = fixnum-min"
1796 (not (< 1 fixnum-min)))
1797
1798 (pass-if "n = fixnum-min - 1"
1799 (not (< 1 (- fixnum-min 1)))))
1800
1801 (with-test-prefix "(< 1.0 n)"
1802
1803 (pass-if "n = 0"
de142bea
DH
1804 (not (< 1.0 0)))
1805
21e39e8f
DH
1806 (pass-if "n = 0.0"
1807 (not (< 1.0 0.0)))
1808
1809 (pass-if "n = 1"
1810 (not (< 1.0 1)))
1811
1812 (pass-if "n = 1.0"
1813 (not (< 1.0 1.0)))
1814
de142bea 1815 (pass-if "n = -1"
21e39e8f
DH
1816 (not (< 1.0 -1)))
1817
1818 (pass-if "n = -1.0"
1819 (not (< 1.0 -1.0)))
1820
1821 (pass-if "n = fixnum-max"
1822 (< 1.0 fixnum-max))
1823
1824 (pass-if "n = fixnum-max + 1"
1825 (< 1.0 (+ fixnum-max 1)))
1826
1827 (pass-if "n = fixnum-min"
1828 (not (< 1.0 fixnum-min)))
1829
1830 (pass-if "n = fixnum-min - 1"
1831 (not (< 1.0 (- fixnum-min 1)))))
1832
1833 (with-test-prefix "(< -1 n)"
1834
1835 (pass-if "n = 0"
de142bea
DH
1836 (< -1 0))
1837
21e39e8f
DH
1838 (pass-if "n = 0.0"
1839 (< -1 0.0))
1840
1841 (pass-if "n = 1"
1842 (< -1 1))
1843
1844 (pass-if "n = 1.0"
1845 (< -1 1.0))
1846
1847 (pass-if "n = -1"
1848 (not (< -1 -1)))
1849
de142bea 1850 (pass-if "n = -1.0"
21e39e8f
DH
1851 (not (< -1 -1.0)))
1852
1853 (pass-if "n = fixnum-max"
1854 (< -1 fixnum-max))
1855
1856 (pass-if "n = fixnum-max + 1"
1857 (< -1 (+ fixnum-max 1)))
1858
1859 (pass-if "n = fixnum-min"
1860 (not (< -1 fixnum-min)))
1861
1862 (pass-if "n = fixnum-min - 1"
1863 (not (< -1 (- fixnum-min 1)))))
1864
1865 (with-test-prefix "(< -1.0 n)"
1866
1867 (pass-if "n = 0"
de142bea
DH
1868 (< -1.0 0))
1869
21e39e8f
DH
1870 (pass-if "n = 0.0"
1871 (< -1.0 0.0))
1872
1873 (pass-if "n = 1"
1874 (< -1.0 1))
1875
1876 (pass-if "n = 1.0"
1877 (< -1.0 1.0))
1878
1879 (pass-if "n = -1"
1880 (not (< -1.0 -1)))
1881
1882 (pass-if "n = -1.0"
1883 (not (< -1.0 -1.0)))
1884
1885 (pass-if "n = fixnum-max"
1886 (< -1.0 fixnum-max))
1887
1888 (pass-if "n = fixnum-max + 1"
1889 (< -1.0 (+ fixnum-max 1)))
de142bea 1890
21e39e8f
DH
1891 (pass-if "n = fixnum-min"
1892 (not (< -1.0 fixnum-min)))
1893
1894 (pass-if "n = fixnum-min - 1"
1895 (not (< -1.0 (- fixnum-min 1)))))
1896
1897 (with-test-prefix "(< fixnum-max n)"
1898
1899 (pass-if "n = 0"
1900 (not (< fixnum-max 0)))
1901
1902 (pass-if "n = 0.0"
1903 (not (< fixnum-max 0.0)))
de142bea
DH
1904
1905 (pass-if "n = 1"
21e39e8f 1906 (not (< fixnum-max 1)))
de142bea
DH
1907
1908 (pass-if "n = 1.0"
21e39e8f 1909 (not (< fixnum-max 1.0)))
de142bea
DH
1910
1911 (pass-if "n = -1"
21e39e8f 1912 (not (< fixnum-max -1)))
de142bea
DH
1913
1914 (pass-if "n = -1.0"
21e39e8f 1915 (not (< fixnum-max -1.0)))
de142bea 1916
21e39e8f
DH
1917 (pass-if "n = fixnum-max"
1918 (not (< fixnum-max fixnum-max)))
de142bea 1919
21e39e8f
DH
1920 (pass-if "n = fixnum-max + 1"
1921 (< fixnum-max (+ fixnum-max 1)))
1922
1923 (pass-if "n = fixnum-min"
1924 (not (< fixnum-max fixnum-min)))
1925
1926 (pass-if "n = fixnum-min - 1"
1927 (not (< fixnum-max (- fixnum-min 1)))))
1928
1929 (with-test-prefix "(< (+ fixnum-max 1) n)"
1930
1931 (pass-if "n = 0"
1932 (not (< (+ fixnum-max 1) 0)))
1933
1934 (pass-if "n = 0.0"
1935 (not (< (+ fixnum-max 1) 0.0)))
de142bea
DH
1936
1937 (pass-if "n = 1"
21e39e8f 1938 (not (< (+ fixnum-max 1) 1)))
de142bea
DH
1939
1940 (pass-if "n = 1.0"
21e39e8f 1941 (not (< (+ fixnum-max 1) 1.0)))
de142bea
DH
1942
1943 (pass-if "n = -1"
21e39e8f 1944 (not (< (+ fixnum-max 1) -1)))
de142bea
DH
1945
1946 (pass-if "n = -1.0"
21e39e8f 1947 (not (< (+ fixnum-max 1) -1.0)))
de142bea 1948
21e39e8f
DH
1949 (pass-if "n = fixnum-max"
1950 (not (< (+ fixnum-max 1) fixnum-max)))
de142bea 1951
21e39e8f
DH
1952 (pass-if "n = fixnum-max + 1"
1953 (not (< (+ fixnum-max 1) (+ fixnum-max 1))))
de142bea 1954
21e39e8f
DH
1955 (pass-if "n = fixnum-min"
1956 (not (< (+ fixnum-max 1) fixnum-min)))
1957
1958 (pass-if "n = fixnum-min - 1"
1959 (not (< (+ fixnum-max 1) (- fixnum-min 1)))))
1960
1961 (with-test-prefix "(< fixnum-min n)"
1962
1963 (pass-if "n = 0"
1964 (< fixnum-min 0))
1965
1966 (pass-if "n = 0.0"
1967 (< fixnum-min 0.0))
de142bea
DH
1968
1969 (pass-if "n = 1"
21e39e8f 1970 (< fixnum-min 1))
de142bea
DH
1971
1972 (pass-if "n = 1.0"
21e39e8f 1973 (< fixnum-min 1.0))
de142bea
DH
1974
1975 (pass-if "n = -1"
21e39e8f 1976 (< fixnum-min -1))
de142bea
DH
1977
1978 (pass-if "n = -1.0"
21e39e8f 1979 (< fixnum-min -1.0))
de142bea 1980
21e39e8f
DH
1981 (pass-if "n = fixnum-max"
1982 (< fixnum-min fixnum-max))
1983
1984 (pass-if "n = fixnum-max + 1"
1985 (< fixnum-min (+ fixnum-max 1)))
de142bea 1986
21e39e8f
DH
1987 (pass-if "n = fixnum-min"
1988 (not (< fixnum-min fixnum-min)))
de142bea 1989
21e39e8f
DH
1990 (pass-if "n = fixnum-min - 1"
1991 (not (< fixnum-min (- fixnum-min 1)))))
1992
1993 (with-test-prefix "(< (- fixnum-min 1) n)"
1994
1995 (pass-if "n = 0"
1996 (< (- fixnum-min 1) 0))
1997
1998 (pass-if "n = 0.0"
1999 (< (- fixnum-min 1) 0.0))
2000
2001 (pass-if "n = 1"
2002 (< (- fixnum-min 1) 1))
2003
2004 (pass-if "n = 1.0"
2005 (< (- fixnum-min 1) 1.0))
de142bea
DH
2006
2007 (pass-if "n = -1"
21e39e8f 2008 (< (- fixnum-min 1) -1))
de142bea
DH
2009
2010 (pass-if "n = -1.0"
21e39e8f
DH
2011 (< (- fixnum-min 1) -1.0))
2012
2013 (pass-if "n = fixnum-max"
2014 (< (- fixnum-min 1) fixnum-max))
2015
2016 (pass-if "n = fixnum-max + 1"
2017 (< (- fixnum-min 1) (+ fixnum-max 1)))
2018
2019 (pass-if "n = fixnum-min"
2020 (< (- fixnum-min 1) fixnum-min))
2021
2022 (pass-if "n = fixnum-min - 1"
2cfcaed5
KR
2023 (not (< (- fixnum-min 1) (- fixnum-min 1)))))
2024
adda36ed
KR
2025 (pass-if (< (ash 1 256) +inf.0))
2026 (pass-if (not (< +inf.0 (ash 1 256))))
2027 (pass-if (not (< (ash 1 256) -inf.0)))
2028 (pass-if (< -inf.0 (ash 1 256)))
2029
2030 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
2031 ;; sure we've avoided that
2032 (pass-if (< (1- (ash 1 1024)) +inf.0))
2033 (pass-if (< (ash 1 1024) +inf.0))
2034 (pass-if (< (1+ (ash 1 1024)) +inf.0))
2035 (pass-if (not (< +inf.0 (1- (ash 1 1024)))))
2036 (pass-if (not (< +inf.0 (ash 1 1024))))
2037 (pass-if (not (< +inf.0 (1+ (ash 1 1024)))))
2038 (pass-if (< -inf.0 (- (1- (ash 1 1024)))))
2039 (pass-if (< -inf.0 (- (ash 1 1024))))
2040 (pass-if (< -inf.0 (- (1+ (ash 1 1024)))))
2041 (pass-if (not (< (- (1- (ash 1 1024))) -inf.0)))
2042 (pass-if (not (< (- (ash 1 1024)) -inf.0)))
2043 (pass-if (not (< (- (1+ (ash 1 1024))) -inf.0)))
2044
2cfcaed5
KR
2045 (pass-if (not (< +nan.0 +nan.0)))
2046 (pass-if (not (< 0 +nan.0)))
2047 (pass-if (not (< +nan.0 0)))
2048 (pass-if (not (< 1 +nan.0)))
2049 (pass-if (not (< +nan.0 1)))
2050 (pass-if (not (< -1 +nan.0)))
2051 (pass-if (not (< +nan.0 -1)))
2052
2053 (pass-if (not (< (ash 1 256) +nan.0)))
2054 (pass-if (not (< +nan.0 (ash 1 256))))
2055 (pass-if (not (< (- (ash 1 256)) +nan.0)))
2056 (pass-if (not (< +nan.0 (- (ash 1 256)))))
2057
2058 (pass-if (not (< (ash 1 8192) +nan.0)))
2059 (pass-if (not (< +nan.0 (ash 1 8192))))
2060 (pass-if (not (< (- (ash 1 8192)) +nan.0)))
2061 (pass-if (not (< +nan.0 (- (ash 1 8192)))))
2062
2063 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
2064 ;; sure we've avoided that
2065 (pass-if (not (< (ash 3 1023) +nan.0)))
2066 (pass-if (not (< (1+ (ash 3 1023)) +nan.0)))
2067 (pass-if (not (< (1- (ash 3 1023)) +nan.0)))
2068 (pass-if (not (< +nan.0 (ash 3 1023))))
2069 (pass-if (not (< +nan.0 (1+ (ash 3 1023)))))
fe89421e
KR
2070 (pass-if (not (< +nan.0 (1- (ash 3 1023)))))
2071
2072 (with-test-prefix "inum/frac"
2073 (pass-if (< 2 9/4))
2074 (pass-if (< -2 9/4))
2075 (pass-if (< -2 7/4))
2076 (pass-if (< -2 -7/4))
2077 (pass-if (eq? #f (< 2 7/4)))
2078 (pass-if (eq? #f (< 2 -7/4)))
2079 (pass-if (eq? #f (< 2 -9/4)))
2080 (pass-if (eq? #f (< -2 -9/4))))
2081
2082 (with-test-prefix "bignum/frac"
2083 (let ((x (ash 1 2048)))
2084 (pass-if (< x (* 4/3 x)))
2085 (pass-if (< (- x) (* 4/3 x)))
2086 (pass-if (< (- x) (* 2/3 x)))
2087 (pass-if (< (- x) (* -2/3 x)))
2088 (pass-if (eq? #f (< x (* 2/3 x))))
2089 (pass-if (eq? #f (< x (* -2/3 x))))
2090 (pass-if (eq? #f (< x (* -4/3 x))))
2091 (pass-if (eq? #f (< (- x) (* -4/3 x))))))
2092
2093 (with-test-prefix "flonum/frac"
2094 (pass-if (< 0.75 4/3))
2095 (pass-if (< -0.75 4/3))
2096 (pass-if (< -0.75 2/3))
2097 (pass-if (< -0.75 -2/3))
2098 (pass-if (eq? #f (< 0.75 2/3)))
2099 (pass-if (eq? #f (< 0.75 -2/3)))
2100 (pass-if (eq? #f (< 0.75 -4/3)))
2101 (pass-if (eq? #f (< -0.75 -4/3)))
2102
2103 (pass-if (< -inf.0 4/3))
2104 (pass-if (< -inf.0 -4/3))
2105 (pass-if (eq? #f (< +inf.0 4/3)))
2106 (pass-if (eq? #f (< +inf.0 -4/3)))
2107
2108 (pass-if (eq? #f (< +nan.0 4/3)))
2109 (pass-if (eq? #f (< +nan.0 -4/3))))
2110
2111 (with-test-prefix "frac/inum"
2112 (pass-if (< 7/4 2))
2113 (pass-if (< -7/4 2))
2114 (pass-if (< -9/4 2))
2115 (pass-if (< -9/4 -2))
2116 (pass-if (eq? #f (< 9/4 2)))
2117 (pass-if (eq? #f (< 9/4 -2)))
2118 (pass-if (eq? #f (< 7/4 -2)))
2119 (pass-if (eq? #f (< -7/4 -2))))
2120
2121 (with-test-prefix "frac/bignum"
2122 (let ((x (ash 1 2048)))
2123 (pass-if (< (* 2/3 x) x))
2124 (pass-if (< (* -2/3 x) x))
2125 (pass-if (< (* -4/3 x) x))
2126 (pass-if (< (* -4/3 x) (- x)))
2127 (pass-if (eq? #f (< (* 4/3 x) x)))
2128 (pass-if (eq? #f (< (* 4/3 x) (- x))))
2129 (pass-if (eq? #f (< (* 2/3 x) (- x))))
2130 (pass-if (eq? #f (< (* -2/3 x) (- x))))))
2131
2132 (with-test-prefix "frac/flonum"
2133 (pass-if (< 2/3 0.75))
2134 (pass-if (< -2/3 0.75))
2135 (pass-if (< -4/3 0.75))
2136 (pass-if (< -4/3 -0.75))
2137 (pass-if (eq? #f (< 4/3 0.75)))
2138 (pass-if (eq? #f (< 4/3 -0.75)))
2139 (pass-if (eq? #f (< 2/3 -0.75)))
2140 (pass-if (eq? #f (< -2/3 -0.75)))
2141
2142 (pass-if (< 4/3 +inf.0))
2143 (pass-if (< -4/3 +inf.0))
2144 (pass-if (eq? #f (< 4/3 -inf.0)))
2145 (pass-if (eq? #f (< -4/3 -inf.0)))
2146
2147 (pass-if (eq? #f (< 4/3 +nan.0)))
2148 (pass-if (eq? #f (< -4/3 +nan.0))))
2149
2150 (with-test-prefix "frac/frac"
2151 (pass-if (< 2/3 6/7))
2152 (pass-if (< -2/3 6/7))
2153 (pass-if (< -4/3 6/7))
2154 (pass-if (< -4/3 -6/7))
2155 (pass-if (eq? #f (< 4/3 6/7)))
2156 (pass-if (eq? #f (< 4/3 -6/7)))
2157 (pass-if (eq? #f (< 2/3 -6/7)))
2158 (pass-if (eq? #f (< -2/3 -6/7)))))
f29b3454
DH
2159
2160;;;
2161;;; >
2162;;;
2163
7c24e528
RB
2164;; currently not tested -- implementation is trivial
2165;; (> x y) is implemented as (< y x)
2166;; FIXME: tests should probably be added in case we change implementation.
2167
f29b3454
DH
2168;;;
2169;;; <=
2170;;;
2171
7c24e528
RB
2172;; currently not tested -- implementation is trivial
2173;; (<= x y) is implemented as (not (< y x))
2174;; FIXME: tests should probably be added in case we change implementation.
2175
f29b3454
DH
2176;;;
2177;;; >=
2178;;;
2179
7c24e528
RB
2180;; currently not tested -- implementation is trivial
2181;; (>= x y) is implemented as (not (< x y))
2182;; FIXME: tests should probably be added in case we change implementation.
2183
f29b3454
DH
2184;;;
2185;;; zero?
2186;;;
2187
7c24e528
RB
2188(with-test-prefix "zero?"
2189 (expect-fail (documented? zero?))
2190 (pass-if (zero? 0))
4d332f19
DH
2191 (pass-if (not (zero? 7)))
2192 (pass-if (not (zero? -7)))
2193 (pass-if (not (zero? (+ 1 fixnum-max))))
2194 (pass-if (not (zero? (- 1 fixnum-min))))
2195 (pass-if (not (zero? 1.3)))
2196 (pass-if (not (zero? 3.1+4.2i))))
7c24e528 2197
f29b3454
DH
2198;;;
2199;;; positive?
2200;;;
2201
7c24e528
RB
2202(with-test-prefix "positive?"
2203 (expect-fail (documented? positive?))
2204 (pass-if (positive? 1))
2205 (pass-if (positive? (+ fixnum-max 1)))
2206 (pass-if (positive? 1.3))
4d332f19
DH
2207 (pass-if (not (positive? 0)))
2208 (pass-if (not (positive? -1)))
2209 (pass-if (not (positive? (- fixnum-min 1))))
2210 (pass-if (not (positive? -1.3))))
7c24e528 2211
f29b3454
DH
2212;;;
2213;;; negative?
2214;;;
2215
7c24e528
RB
2216(with-test-prefix "negative?"
2217 (expect-fail (documented? negative?))
4d332f19
DH
2218 (pass-if (not (negative? 1)))
2219 (pass-if (not (negative? (+ fixnum-max 1))))
2220 (pass-if (not (negative? 1.3)))
2221 (pass-if (not (negative? 0)))
7c24e528
RB
2222 (pass-if (negative? -1))
2223 (pass-if (negative? (- fixnum-min 1)))
2224 (pass-if (negative? -1.3)))
2225
f29b3454
DH
2226;;;
2227;;; max
2228;;;
2229
adda36ed 2230(with-test-prefix "max"
593a4c2f
KR
2231 (pass-if-exception "no args" exception:wrong-num-args
2232 (max))
2233
2234 (pass-if-exception "one complex" exception:wrong-type-arg
2235 (max 1+i))
2236
2237 (pass-if-exception "inum/complex" exception:wrong-type-arg
2238 (max 123 1+i))
2239 (pass-if-exception "big/complex" exception:wrong-type-arg
2240 (max 9999999999999999999999999999999999999999 1+i))
2241 (pass-if-exception "real/complex" exception:wrong-type-arg
2242 (max 123.0 1+i))
2243 (pass-if-exception "frac/complex" exception:wrong-type-arg
2244 (max 123/456 1+i))
2245
2246 (pass-if-exception "complex/inum" exception:wrong-type-arg
2247 (max 1+i 123))
2248 (pass-if-exception "complex/big" exception:wrong-type-arg
2249 (max 1+i 9999999999999999999999999999999999999999))
2250 (pass-if-exception "complex/real" exception:wrong-type-arg
2251 (max 1+i 123.0))
2252 (pass-if-exception "complex/frac" exception:wrong-type-arg
2253 (max 1+i 123/456))
2254
adda36ed
KR
2255 (let ((big*2 (* fixnum-max 2))
2256 (big*3 (* fixnum-max 3))
2257 (big*4 (* fixnum-max 4))
2258 (big*5 (* fixnum-max 5)))
501da403 2259
2530518e
KR
2260 (with-test-prefix "inum / frac"
2261 (pass-if (= 3 (max 3 5/2)))
2262 (pass-if (= 5/2 (max 2 5/2))))
2263
2264 (with-test-prefix "frac / inum"
2265 (pass-if (= 3 (max 5/2 3)))
2266 (pass-if (= 5/2 (max 5/2 2))))
2267
23d77957
KR
2268 (with-test-prefix "inum / real"
2269 (pass-if (nan? (max 123 +nan.0))))
2270
2271 (with-test-prefix "real / inum"
2272 (pass-if (nan? (max +nan.0 123))))
2273
2530518e
KR
2274 (with-test-prefix "big / frac"
2275 (pass-if (= big*2 (max big*2 5/2)))
2276 (pass-if (= 5/2 (max (- big*2) 5/2))))
2277
2278 (with-test-prefix "frac / big"
2279 (pass-if (= big*2 (max 5/2 big*2)))
2280 (pass-if (= 5/2 (max 5/2 (- big*2)))))
2281
23d77957
KR
2282 (with-test-prefix "big / real"
2283 (pass-if (nan? (max big*5 +nan.0)))
23d72566
KR
2284 (pass-if (eqv? (exact->inexact big*5) (max big*5 -inf.0)))
2285 (pass-if (eqv? (exact->inexact big*5) (max big*5 1.0)))
2286 (pass-if (eqv? +inf.0 (max big*5 +inf.0)))
2287 (pass-if (eqv? 1.0 (max (- big*5) 1.0))))
23d77957
KR
2288
2289 (with-test-prefix "real / big"
2290 (pass-if (nan? (max +nan.0 big*5)))
23d72566
KR
2291 (pass-if (eqv? (exact->inexact big*5) (max -inf.0 big*5)))
2292 (pass-if (eqv? (exact->inexact big*5) (max 1.0 big*5)))
2293 (pass-if (eqv? +inf.0 (max +inf.0 big*5)))
2294 (pass-if (eqv? 1.0 (max 1.0 (- big*5)))))
23d77957 2295
2530518e
KR
2296 (with-test-prefix "frac / frac"
2297 (pass-if (= 2/3 (max 1/2 2/3)))
2298 (pass-if (= 2/3 (max 2/3 1/2)))
2299 (pass-if (= -1/2 (max -1/2 -2/3)))
2300 (pass-if (= -1/2 (max -2/3 -1/2))))
2301
23d77957
KR
2302 (with-test-prefix "real / real"
2303 (pass-if (nan? (max 123.0 +nan.0)))
2304 (pass-if (nan? (max +nan.0 123.0)))
2305 (pass-if (nan? (max +nan.0 +nan.0)))
2306 (pass-if (= 456.0 (max 123.0 456.0)))
2307 (pass-if (= 456.0 (max 456.0 123.0)))))
adda36ed
KR
2308
2309 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
2310 ;; sure we've avoided that
2311 (for-each (lambda (b)
2312 (pass-if (list b +inf.0)
2313 (= +inf.0 (max b +inf.0)))
2314 (pass-if (list +inf.0 b)
2315 (= +inf.0 (max b +inf.0)))
2316 (pass-if (list b -inf.0)
23d77957 2317 (= (exact->inexact b) (max b -inf.0)))
adda36ed 2318 (pass-if (list -inf.0 b)
23d77957 2319 (= (exact->inexact b) (max b -inf.0))))
adda36ed
KR
2320 (list (1- (ash 1 1024))
2321 (ash 1 1024)
2322 (1+ (ash 1 1024))
2323 (- (1- (ash 1 1024)))
2324 (- (ash 1 1024))
501da403
KR
2325 (- (1+ (ash 1 1024)))))
2326
2327 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
2328 ;; sure we've avoided that
2329 (pass-if (nan? (max (ash 1 2048) +nan.0)))
2330 (pass-if (nan? (max +nan.0 (ash 1 2048)))))
adda36ed 2331
f29b3454
DH
2332;;;
2333;;; min
2334;;;
2335
7c24e528
RB
2336;; FIXME: unfinished...
2337
2338(with-test-prefix "min"
593a4c2f
KR
2339 (pass-if-exception "no args" exception:wrong-num-args
2340 (min))
2341
2342 (pass-if-exception "one complex" exception:wrong-type-arg
2343 (min 1+i))
2344
2345 (pass-if-exception "inum/complex" exception:wrong-type-arg
2346 (min 123 1+i))
2347 (pass-if-exception "big/complex" exception:wrong-type-arg
2348 (min 9999999999999999999999999999999999999999 1+i))
2349 (pass-if-exception "real/complex" exception:wrong-type-arg
2350 (min 123.0 1+i))
2351 (pass-if-exception "frac/complex" exception:wrong-type-arg
2352 (min 123/456 1+i))
2353
2354 (pass-if-exception "complex/inum" exception:wrong-type-arg
2355 (min 1+i 123))
2356 (pass-if-exception "complex/big" exception:wrong-type-arg
2357 (min 1+i 9999999999999999999999999999999999999999))
2358 (pass-if-exception "complex/real" exception:wrong-type-arg
2359 (min 1+i 123.0))
2360 (pass-if-exception "complex/frac" exception:wrong-type-arg
2361 (min 1+i 123/456))
2362
7c24e528
RB
2363 (let ((big*2 (* fixnum-max 2))
2364 (big*3 (* fixnum-max 3))
2365 (big*4 (* fixnum-max 4))
2366 (big*5 (* fixnum-max 5)))
23d77957 2367
d389e966 2368 (pass-if (documented? min))
7c24e528
RB
2369 (pass-if (= 1 (min 7 3 1 5)))
2370 (pass-if (= 1 (min 1 7 3 5)))
2371 (pass-if (= 1 (min 7 3 5 1)))
2372 (pass-if (= -7 (min 2 3 4 -2 5 -7 1 -1 4 2)))
2373 (pass-if (= -7 (min -7 2 3 4 -2 5 1 -1 4 2)))
2374 (pass-if (= -7 (min 2 3 4 -2 5 1 -1 4 2 -7)))
2375 (pass-if (= big*2 (min big*3 big*5 big*2 big*4)))
2376 (pass-if (= big*2 (min big*2 big*3 big*5 big*4)))
2377 (pass-if (= big*2 (min big*3 big*5 big*4 big*2)))
2378 (pass-if
2379 (= (- fixnum-min 1) (min 2 4 (- fixnum-min 1) 3 (* 2 fixnum-max))))
2380 (pass-if
2381 (= (- fixnum-min 1) (min (- fixnum-min 1) 2 4 3 (* 2 fixnum-max))))
2382 (pass-if
adda36ed 2383 (= (- fixnum-min 1) (min 2 4 3 (* 2 fixnum-max) (- fixnum-min 1))))
23d77957 2384
2530518e
KR
2385 (with-test-prefix "inum / frac"
2386 (pass-if (= 5/2 (min 3 5/2)))
2387 (pass-if (= 2 (min 2 5/2))))
2388
2389 (with-test-prefix "frac / inum"
2390 (pass-if (= 5/2 (min 5/2 3)))
2391 (pass-if (= 2 (min 5/2 2))))
2392
23d77957
KR
2393 (with-test-prefix "inum / real"
2394 (pass-if (nan? (min 123 +nan.0))))
2395
2396 (with-test-prefix "real / inum"
2397 (pass-if (nan? (min +nan.0 123))))
2398
2530518e
KR
2399 (with-test-prefix "big / frac"
2400 (pass-if (= 5/2 (min big*2 5/2)))
2401 (pass-if (= (- big*2) (min (- big*2) 5/2))))
2402
2403 (with-test-prefix "frac / big"
2404 (pass-if (= 5/2 (min 5/2 big*2)))
2405 (pass-if (= (- big*2) (min 5/2 (- big*2)))))
2406
23d77957
KR
2407 (with-test-prefix "big / real"
2408 (pass-if (nan? (min big*5 +nan.0)))
23d72566
KR
2409 (pass-if (eqv? (exact->inexact big*5) (min big*5 +inf.0)))
2410 (pass-if (eqv? -inf.0 (min big*5 -inf.0)))
2411 (pass-if (eqv? 1.0 (min big*5 1.0)))
2412 (pass-if (eqv? (exact->inexact (- big*5)) (min (- big*5) 1.0))))
23d77957
KR
2413
2414 (with-test-prefix "real / big"
2415 (pass-if (nan? (min +nan.0 big*5)))
23d72566
KR
2416 (pass-if (eqv? (exact->inexact big*5) (min +inf.0 big*5)))
2417 (pass-if (eqv? -inf.0 (min -inf.0 big*5)))
2418 (pass-if (eqv? 1.0 (min 1.0 big*5)))
2419 (pass-if (eqv? (exact->inexact (- big*5)) (min 1.0 (- big*5)))))
23d77957 2420
2530518e
KR
2421 (with-test-prefix "frac / frac"
2422 (pass-if (= 1/2 (min 1/2 2/3)))
2423 (pass-if (= 1/2 (min 2/3 1/2)))
2424 (pass-if (= -2/3 (min -1/2 -2/3)))
2425 (pass-if (= -2/3 (min -2/3 -1/2))))
2426
23d77957
KR
2427 (with-test-prefix "real / real"
2428 (pass-if (nan? (min 123.0 +nan.0)))
2429 (pass-if (nan? (min +nan.0 123.0)))
2430 (pass-if (nan? (min +nan.0 +nan.0)))
2431 (pass-if (= 123.0 (min 123.0 456.0)))
2432 (pass-if (= 123.0 (min 456.0 123.0)))))
2433
2434
adda36ed
KR
2435 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
2436 ;; sure we've avoided that
2437 (for-each (lambda (b)
2438 (pass-if (list b +inf.0)
23d77957 2439 (= (exact->inexact b) (min b +inf.0)))
adda36ed 2440 (pass-if (list +inf.0 b)
23d77957 2441 (= (exact->inexact b) (min b +inf.0)))
adda36ed
KR
2442 (pass-if (list b -inf.0)
2443 (= -inf.0 (min b -inf.0)))
2444 (pass-if (list -inf.0 b)
2445 (= -inf.0 (min b -inf.0))))
2446 (list (1- (ash 1 1024))
2447 (ash 1 1024)
2448 (1+ (ash 1 1024))
2449 (- (1- (ash 1 1024)))
2450 (- (ash 1 1024))
501da403
KR
2451 (- (1+ (ash 1 1024)))))
2452
2453 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
2454 ;; sure we've avoided that
2455 (pass-if (nan? (min (- (ash 1 2048)) (- +nan.0))))
2456 (pass-if (nan? (min (- +nan.0) (- (ash 1 2048))))))
adda36ed 2457
f29b3454
DH
2458;;;
2459;;; +
2460;;;
2461
2462(with-test-prefix "+"
2463
d389e966 2464 (pass-if "documented?"
cedf24d8 2465 (documented? +)))
f29b3454 2466
f29b3454
DH
2467;;;
2468;;; -
2469;;;
2470
072e6de2
KR
2471(with-test-prefix "-"
2472
2473 (pass-if "-inum - +bignum"
2474 (= #x-100000000000000000000000000000001
ef016629
KR
2475 (- -1 #x100000000000000000000000000000000)))
2476
2477 (pass-if "big - inum"
2478 (= #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
2479 (- #x100000000000000000000000000000000 1)))
2480
2481 (pass-if "big - -inum"
2482 (= #x100000000000000000000000000000001
2483 (- #x100000000000000000000000000000000 -1))))
072e6de2 2484
f29b3454
DH
2485;;;
2486;;; *
2487;;;
2488
65ea251e
KR
2489(with-test-prefix "*"
2490
23d72566
KR
2491 (with-test-prefix "inum * bignum"
2492
2493 (pass-if "0 * 2^256 = 0"
2494 (eqv? 0 (* 0 (ash 1 256)))))
2495
2496 (with-test-prefix "inum * flonum"
2497
2498 (pass-if "0 * 1.0 = 0"
2499 (eqv? 0 (* 0 1.0))))
2500
2501 (with-test-prefix "inum * complex"
2502
2503 (pass-if "0 * 1+1i = 0"
2504 (eqv? 0 (* 0 1+1i))))
2505
2506 (with-test-prefix "inum * frac"
2507
2508 (pass-if "0 * 2/3 = 0"
2509 (eqv? 0 (* 0 2/3))))
2510
2511 (with-test-prefix "bignum * inum"
2512
2513 (pass-if "2^256 * 0 = 0"
2514 (eqv? 0 (* (ash 1 256) 0))))
2515
2516 (with-test-prefix "flonum * inum"
2517
2518 ;; in guile 1.6.8 and 1.8.1 and earlier this returned inexact 0.0
2519 (pass-if "1.0 * 0 = 0"
2520 (eqv? 0 (* 1.0 0))))
2521
2522 (with-test-prefix "complex * inum"
2523
2524 ;; in guile 1.6.8 and 1.8.1 and earlier this returned inexact 0.0
2525 (pass-if "1+1i * 0 = 0"
2526 (eqv? 0 (* 1+1i 0))))
2527
65ea251e
KR
2528 (pass-if "complex * bignum"
2529 (let ((big (ash 1 90)))
2530 (= (make-rectangular big big)
23d72566
KR
2531 (* 1+1i big))))
2532
2533 (with-test-prefix "frac * inum"
2534
2535 (pass-if "2/3 * 0 = 0"
2536 (eqv? 0 (* 2/3 0)))))
65ea251e 2537
f29b3454
DH
2538;;;
2539;;; /
2540;;;
2541
1b3a7932
DH
2542(with-test-prefix "/"
2543
d389e966 2544 (pass-if "documented?"
1b3a7932
DH
2545 (documented? /))
2546
2547 (with-test-prefix "division by zero"
2548
2549 (pass-if-exception "(/ 0)"
2f359170 2550 exception:numerical-overflow
1b3a7932
DH
2551 (/ 0))
2552
cdf52e3d
MV
2553 (pass-if "(/ 0.0)"
2554 (= +inf.0 (/ 0.0)))
80074d77 2555
1b3a7932 2556 (pass-if-exception "(/ 1 0)"
2f359170 2557 exception:numerical-overflow
80074d77
DH
2558 (/ 1 0))
2559
cdf52e3d
MV
2560 (pass-if "(/ 1 0.0)"
2561 (= +inf.0 (/ 1 0.0)))
80074d77
DH
2562
2563 (pass-if-exception "(/ bignum 0)"
2f359170 2564 exception:numerical-overflow
80074d77
DH
2565 (/ (+ fixnum-max 1) 0))
2566
cdf52e3d
MV
2567 (pass-if "(/ bignum 0.0)"
2568 (= +inf.0 (/ (+ fixnum-max 1) 0.0)))
80074d77
DH
2569
2570 (pass-if-exception "(/ 1.0 0)"
2f359170 2571 exception:numerical-overflow
80074d77
DH
2572 (/ 1.0 0))
2573
cdf52e3d
MV
2574 (pass-if "(/ 1.0 0.0)"
2575 (= +inf.0 (/ 1.0 0.0)))
80074d77
DH
2576
2577 (pass-if-exception "(/ +i 0)"
2f359170 2578 exception:numerical-overflow
80074d77
DH
2579 (/ +i 0))
2580
cdf52e3d
MV
2581 (pass-if "(/ +i 0.0)"
2582 (= +inf.0 (imag-part (/ +i 0.0)))))
469b963c 2583
2f359170
KR
2584 (with-test-prefix "1/complex"
2585
2586 (pass-if "0+1i"
2587 (eqv? 0-1i (/ 0+1i)))
2588
2589 ;; in guile 1.6 through 1.6.7 this incorrectly resulted in nans
2590 (pass-if "0-1i"
2591 (eqv? 0+1i (/ 0-1i)))
2592
2593 (pass-if "1+1i"
2594 (eqv? 0.5-0.5i (/ 1+1i)))
2595
2596 (pass-if "1-1i"
2597 (eqv? 0.5+0.5i (/ 1-1i)))
2598
2599 (pass-if "-1+1i"
2600 (eqv? -0.5-0.5i (/ -1+1i)))
2601
2602 (pass-if "-1-1i"
2603 (eqv? -0.5+0.5i (/ -1-1i)))
469b963c
MV
2604
2605 (pass-if "(/ 3+4i)"
2606 (= (/ 3+4i) 0.12-0.16i))
2607
2608 (pass-if "(/ 4+3i)"
2609 (= (/ 4+3i) 0.16-0.12i))
2610
2f359170
KR
2611 (pass-if "(/ 1e200+1e200i)"
2612 (= (/ 1e200+1e200i) 5.0e-201-5.0e-201i)))
469b963c 2613
2f359170 2614 (with-test-prefix "inum/complex"
469b963c
MV
2615
2616 (pass-if "(/ 25 3+4i)"
2617 (= (/ 25 3+4i) 3.0-4.0i))
2618
2619 (pass-if "(/ 25 4+3i)"
2f359170 2620 (= (/ 25 4+3i) 4.0-3.0i)))
469b963c 2621
2f359170
KR
2622 (with-test-prefix "complex/complex"
2623
2624 (pass-if "(/ 25+125i 3+4i)"
2625 (= (/ 25+125i 3+4i) 23.0+11.0i))
2626
2627 (pass-if "(/ 25+125i 4+3i)"
2628 (= (/ 25+125i 4+3i) 19.0+17.0i))))
1b3a7932 2629
f29b3454
DH
2630;;;
2631;;; truncate
2632;;;
2633
14a6784c
KR
2634(with-test-prefix "truncate"
2635 (pass-if (= 1 (truncate 1.75)))
2636 (pass-if (= 1 (truncate 1.5)))
2637 (pass-if (= 1 (truncate 1.25)))
2638 (pass-if (= 0 (truncate 0.75)))
2639 (pass-if (= 0 (truncate 0.5)))
2640 (pass-if (= 0 (truncate 0.0)))
2641 (pass-if (= 0 (truncate -0.5)))
2642 (pass-if (= -1 (truncate -1.25)))
2643 (pass-if (= -1 (truncate -1.5))))
2644
f29b3454
DH
2645;;;
2646;;; round
2647;;;
2648
14a6784c
KR
2649(with-test-prefix "round"
2650 (pass-if (= 2 (round 1.75)))
2651 (pass-if (= 2 (round 1.5)))
2652 (pass-if (= 1 (round 1.25)))
2653 (pass-if (= 1 (round 0.75)))
2654 (pass-if (= 0 (round 0.5)))
2655 (pass-if (= 0 (round 0.0)))
2656 (pass-if (= 0 (round -0.5)))
2657 (pass-if (= -1 (round -1.25)))
abff733b
KR
2658 (pass-if (= -2 (round -1.5)))
2659
2660 (with-test-prefix "inum"
2661 (pass-if "0"
2662 (and (= 0 (round 0))
2663 (exact? (round 0))))
2664
2665 (pass-if "1"
2666 (and (= 1 (round 1))
2667 (exact? (round 1))))
2668
2669 (pass-if "-1"
2670 (and (= -1 (round -1))
2671 (exact? (round -1)))))
2672
2673 (with-test-prefix "bignum"
2674 (let ((x (1+ most-positive-fixnum)))
2675 (pass-if "(1+ most-positive-fixnum)"
2676 (and (= x (round x))
2677 (exact? (round x)))))
2678
2679 (let ((x (1- most-negative-fixnum)))
2680 (pass-if "(1- most-negative-fixnum)"
2681 (and (= x (round x))
2682 (exact? (round x))))))
2683
6203b5f5
KR
2684 (with-test-prefix "frac"
2685 (define (=exact x y)
2686 (and (= x y)
2687 (exact? y)))
2688
2689 (pass-if (=exact -2 (round -7/3)))
2690 (pass-if (=exact -2 (round -5/3)))
2691 (pass-if (=exact -1 (round -4/3)))
2692 (pass-if (=exact -1 (round -2/3)))
2693 (pass-if (=exact 0 (round -1/3)))
2694 (pass-if (=exact 0 (round 1/3)))
2695 (pass-if (=exact 1 (round 2/3)))
2696 (pass-if (=exact 1 (round 4/3)))
2697 (pass-if (=exact 2 (round 5/3)))
2698 (pass-if (=exact 2 (round 7/3)))
2699
2700 (pass-if (=exact -3 (round -17/6)))
2701 (pass-if (=exact -3 (round -16/6)))
2702 (pass-if (=exact -2 (round -15/6)))
2703 (pass-if (=exact -2 (round -14/6)))
2704 (pass-if (=exact -2 (round -13/6)))
2705 (pass-if (=exact -2 (round -11/6)))
2706 (pass-if (=exact -2 (round -10/6)))
2707 (pass-if (=exact -2 (round -9/6)))
2708 (pass-if (=exact -1 (round -8/6)))
2709 (pass-if (=exact -1 (round -7/6)))
2710 (pass-if (=exact -1 (round -5/6)))
2711 (pass-if (=exact -1 (round -4/6)))
2712 (pass-if (=exact 0 (round -3/6)))
2713 (pass-if (=exact 0 (round -2/6)))
2714 (pass-if (=exact 0 (round -1/6)))
2715 (pass-if (=exact 0 (round 1/6)))
2716 (pass-if (=exact 0 (round 2/6)))
2717 (pass-if (=exact 0 (round 3/6)))
2718 (pass-if (=exact 1 (round 4/6)))
2719 (pass-if (=exact 1 (round 5/6)))
2720 (pass-if (=exact 1 (round 7/6)))
2721 (pass-if (=exact 1 (round 8/6)))
2722 (pass-if (=exact 2 (round 9/6)))
2723 (pass-if (=exact 2 (round 10/6)))
2724 (pass-if (=exact 2 (round 11/6)))
2725 (pass-if (=exact 2 (round 13/6)))
2726 (pass-if (=exact 2 (round 14/6)))
2727 (pass-if (=exact 2 (round 15/6)))
2728 (pass-if (=exact 3 (round 16/6)))
2729 (pass-if (=exact 3 (round 17/6))))
2730
abff733b
KR
2731 (with-test-prefix "real"
2732 (pass-if "0.0"
2733 (and (= 0.0 (round 0.0))
2734 (inexact? (round 0.0))))
2735
2736 (pass-if "1.0"
2737 (and (= 1.0 (round 1.0))
2738 (inexact? (round 1.0))))
2739
2740 (pass-if "-1.0"
2741 (and (= -1.0 (round -1.0))
2742 (inexact? (round -1.0))))
2743
2744 (pass-if "-3.1"
2745 (and (= -3.0 (round -3.1))
2746 (inexact? (round -3.1))))
2747
2748 (pass-if "3.1"
2749 (and (= 3.0 (round 3.1))
2750 (inexact? (round 3.1))))
2751
2752 (pass-if "3.9"
2753 (and (= 4.0 (round 3.9))
2754 (inexact? (round 3.9))))
2755
2756 (pass-if "-3.9"
2757 (and (= -4.0 (round -3.9))
2758 (inexact? (round -3.9))))
2759
2760 (pass-if "1.5"
2761 (and (= 2.0 (round 1.5))
2762 (inexact? (round 1.5))))
2763
2764 (pass-if "2.5"
2765 (and (= 2.0 (round 2.5))
2766 (inexact? (round 2.5))))
2767
2768 (pass-if "3.5"
2769 (and (= 4.0 (round 3.5))
2770 (inexact? (round 3.5))))
2771
2772 (pass-if "-1.5"
2773 (and (= -2.0 (round -1.5))
2774 (inexact? (round -1.5))))
2775
2776 (pass-if "-2.5"
2777 (and (= -2.0 (round -2.5))
2778 (inexact? (round -2.5))))
2779
2780 (pass-if "-3.5"
2781 (and (= -4.0 (round -3.5))
2782 (inexact? (round -3.5))))
2783
2784 ;; prior to guile 1.6.5, on an IEEE system an inexact 2^53-1 (ie. a
2785 ;; float with mantissa all ones) came out as 2^53 from `round' (except
2786 ;; on i386 and m68k systems using the coprocessor and optimizing, where
2787 ;; extra precision hid the problem)
2788 (pass-if "2^53-1"
2789 (let ((x (exact->inexact (1- (ash 1 53)))))
2790 (and (= x (round x))
2791 (inexact? (round x)))))
2792 (pass-if "-(2^53-1)"
2793 (let ((x (exact->inexact (- (1- (ash 1 53))))))
2794 (and (= x (round x))
2795 (inexact? (round x)))))))
14a6784c 2796
f29b3454
DH
2797;;;
2798;;; exact->inexact
2799;;;
2800
a1fb3b1c
KR
2801(with-test-prefix "exact->inexact"
2802
2803 ;; Test "(exact->inexact n)", expect "want".
2804 ;; "i" is a index, for diagnostic purposes.
2805 (define (try-i i n want)
2806 (with-test-prefix (list i n want)
2807 (with-test-prefix "pos"
2808 (let ((got (exact->inexact n)))
2809 (pass-if "inexact?" (inexact? got))
2810 (pass-if (list "=" got) (= want got))))
2811 (set! n (- n))
2812 (set! want (- want))
2813 (with-test-prefix "neg"
2814 (let ((got (exact->inexact n)))
2815 (pass-if "inexact?" (inexact? got))
2816 (pass-if (list "=" got) (= want got))))))
2817
2818 (with-test-prefix "2^i, no round"
2819 (do ((i 0 (1+ i))
2820 (n 1 (* 2 n))
2821 (want 1.0 (* 2.0 want)))
2822 ((> i 100))
2823 (try-i i n want)))
2824
2825 (with-test-prefix "2^i+1, no round"
2826 (do ((i 1 (1+ i))
2827 (n 3 (1- (* 2 n)))
2828 (want 3.0 (- (* 2.0 want) 1.0)))
2829 ((>= i dbl-mant-dig))
2830 (try-i i n want)))
2831
2832 (with-test-prefix "(2^i+1)*2^100, no round"
2833 (do ((i 1 (1+ i))
2834 (n 3 (1- (* 2 n)))
2835 (want 3.0 (- (* 2.0 want) 1.0)))
2836 ((>= i dbl-mant-dig))
2837 (try-i i (ash n 100) (ash-flo want 100))))
2838
2839 ;; bit pattern: 1111....11100.00
2840 ;; <-mantdig-><-i->
2841 ;;
2842 (with-test-prefix "mantdig ones then zeros, no rounding"
2843 (do ((i 0 (1+ i))
2844 (n (- (ash 1 dbl-mant-dig) 1) (* 2 n))
2845 (want (- (ash-flo 1.0 dbl-mant-dig) 1.0) (* 2.0 want)))
2846 ((> i 100))
2847 (try-i i n want)))
2848
2849 ;; bit pattern: 1111....111011..1
2850 ;; <-mantdig-> <-i->
2851 ;; This sort of value was incorrectly rounded upwards in Guile 1.6.4 when
2852 ;; i >= 11 (that's when the total is 65 or more bits).
2853 ;;
2854 (with-test-prefix "mantdig ones then 011..11, round down"
2855 (do ((i 0 (1+ i))
2856 (n (- (ash 1 (+ 1 dbl-mant-dig)) 2) (+ 1 (* 2 n)))
2857 (want (- (ash-flo 1.0 (+ 1 dbl-mant-dig)) 2.0) (* 2.0 want)))
2858 ((> i 100))
2859 (try-i i n want)))
2860
2861 ;; bit pattern: 1111....111100..001
2862 ;; <-mantdig-> <--i->
2863 ;;
2864 (with-test-prefix "mantdig ones then 100..001, round up"
2865 (do ((i 0 (1+ i))
2866 (n (- (ash 1 (+ 2 dbl-mant-dig)) 1) (1- (* 2 n)))
2867 (want (ash-flo 1.0 (+ 2 dbl-mant-dig)) (* 2.0 want)))
2868 ((> i 100))
2869 (try-i i n want)))
2870
2871 ;; bit pattern: 1000....000100..001
2872 ;; <-mantdig-> <--i->
2873 ;;
2874 (with-test-prefix "2^mantdig then 100..001, round up"
2875 (do ((i 0 (1+ i))
2876 (n (- (ash 1 (+ 2 dbl-mant-dig)) 1) (1- (* 2 n)))
2877 (want (+ (ash-flo 1.0 (+ 2 dbl-mant-dig)) 4.0) (* 2.0 want)))
2878 ((> i 100))
23f2b9a3
KR
2879 (try-i i n want)))
2880
2881 (pass-if "frac big/big"
2882 (let ((big (ash 1 256)))
2883 (= 1.0 (exact->inexact (/ (1+ big) big)))))
2884
2885 ;; In guile 1.8.0 this failed, giving back "nan" because it tried to
2886 ;; convert the num and den to doubles, resulting in infs.
2887 (pass-if "frac big/big, exceeding double"
2888 (let ((big (ash 1 4096)))
2889 (= 1.0 (exact->inexact (/ (1+ big) big))))))
a1fb3b1c 2890
f29b3454
DH
2891;;;
2892;;; floor
2893;;;
2894
2895;;;
2896;;; ceiling
2897;;;
2898
46f2c0f1
RB
2899;;;
2900;;; expt
2901;;;
2902
2903(with-test-prefix "expt"
a4082ab5
AW
2904 (pass-if-exception "non-numeric base" exception:wrong-type-arg
2905 (expt #t 0))
46f2c0f1
RB
2906 (pass-if "(= 1 (expt 0 0))" (= 1 (expt 0 0)))
2907 (pass-if "(= 1 (expt 0 0.0))" (= 1 (expt 0 0.0)))
2908 (pass-if "(= 1 (expt 0.0 0))" (= 1 (expt 0.0 0)))
2909 (pass-if "(= 1 (expt 0.0 0.0))" (= 1 (expt 0.0 0.0))))
2910
14a6784c
KR
2911;;;
2912;;; asinh
2913;;;
2914
2915(with-test-prefix "asinh"
2916 (pass-if (= 0 (asinh 0))))
2917
2918;;;
2919;;; acosh
2920;;;
2921
2922(with-test-prefix "acosh"
2923 (pass-if (= 0 (acosh 1))))
2924
2925;;;
2926;;; atanh
2927;;;
2928
2929(with-test-prefix "atanh"
2930 (pass-if (= 0 (atanh 0))))
2931
f29b3454
DH
2932;;;
2933;;; make-rectangular
2934;;;
2935
2936;;;
2937;;; make-polar
2938;;;
2939
d40681ec
KR
2940(with-test-prefix "make-polar"
2941 (define pi 3.14159265358979323846)
2942 (define (almost= x y)
2943 (> 0.01 (magnitude (- x y))))
2944
2945 (pass-if (= 0 (make-polar 0 0)))
2946 (pass-if (= 0 (make-polar 0 123.456)))
2947 (pass-if (= 1 (make-polar 1 0)))
2948 (pass-if (= -1 (make-polar -1 0)))
2949
2950 (pass-if (almost= 0+i (make-polar 1 (* 0.5 pi))))
2951 (pass-if (almost= -1 (make-polar 1 (* 1.0 pi))))
2952 (pass-if (almost= 0-i (make-polar 1 (* 1.5 pi))))
2953 (pass-if (almost= 1 (make-polar 1 (* 2.0 pi)))))
2954
f29b3454
DH
2955;;;
2956;;; real-part
2957;;;
2958
2959;;;
2960;;; imag-part
2961;;;
2962
2963;;;
2964;;; magnitude
2965;;;
2966
d40681ec
KR
2967(with-test-prefix "magnitude"
2968 (pass-if (= 0 (magnitude 0)))
2969 (pass-if (= 1 (magnitude 1)))
2970 (pass-if (= 1 (magnitude -1)))
2971 (pass-if (= 1 (magnitude 0+i)))
2972 (pass-if (= 1 (magnitude 0-i)))
2973 (pass-if (= 5 (magnitude 3+4i)))
2974 (pass-if (= 5 (magnitude 3-4i)))
2975 (pass-if (= 5 (magnitude -3+4i)))
2976 (pass-if (= 5 (magnitude -3-4i))))
2977
f29b3454
DH
2978;;;
2979;;; angle
2980;;;
2981
cfc9fc1c
KR
2982(with-test-prefix "angle"
2983 (define pi 3.14159265358979323846)
2984 (define (almost= x y)
2985 (> 0.01 (magnitude (- x y))))
2986
2987 (pass-if "inum +ve" (= 0 (angle 1)))
2988 (pass-if "inum -ve" (almost= pi (angle -1)))
2989
2990 (pass-if "bignum +ve" (= 0 (angle (1+ fixnum-max))))
2991 (pass-if "bignum -ve" (almost= pi (angle (1- fixnum-min))))
2992
2993 (pass-if "flonum +ve" (= 0 (angle 1.5)))
2994 (pass-if "flonum -ve" (almost= pi (angle -1.5))))
2995
f29b3454
DH
2996;;;
2997;;; inexact->exact
2998;;;
300c6a76 2999
1259cb26
KR
3000(with-test-prefix "inexact->exact"
3001
9dd9857f 3002 (pass-if-exception "+inf" exception:out-of-range
a409f865 3003 (inexact->exact +inf.0))
1259cb26 3004
9dd9857f 3005 (pass-if-exception "-inf" exception:out-of-range
a409f865 3006 (inexact->exact -inf.0))
1259cb26 3007
9dd9857f 3008 (pass-if-exception "nan" exception:out-of-range
a409f865 3009 (inexact->exact +nan.0))
1259cb26
KR
3010
3011 (with-test-prefix "2.0**i to exact and back"
3012 (do ((i 0 (1+ i))
3013 (n 1.0 (* 2.0 n)))
3014 ((> i 100))
3015 (pass-if (list i n)
3016 (= n (inexact->exact (exact->inexact n)))))))
3017
c1122753
KR
3018;;;
3019;;; integer-expt
3020;;;
3021
3022(with-test-prefix "integer-expt"
3023
5a8fc758
AW
3024 (pass-if-exception "non-numeric base" exception:wrong-type-arg
3025 (integer-expt #t 0))
c1122753
KR
3026 (pass-if-exception "2^+inf" exception:wrong-type-arg
3027 (integer-expt 2 +inf.0))
3028 (pass-if-exception "2^-inf" exception:wrong-type-arg
3029 (integer-expt 2 -inf.0))
3030 (pass-if-exception "2^nan" exception:wrong-type-arg
3031 (integer-expt 2 +nan.0)))
3032
a04a3604
KR
3033;;;
3034;;; integer-length
3035;;;
3036
3037(with-test-prefix "integer-length"
3038
3039 (with-test-prefix "-2^i, ...11100..00"
3040 (do ((n -1 (ash n 1))
3041 (i 0 (1+ i)))
3042 ((> i 256))
3043 (pass-if (list n "expect" i)
3044 (= i (integer-length n)))))
3045
3046 (with-test-prefix "-2^i+1 ...11100..01"
3047 (do ((n -3 (logxor 3 (ash n 1)))
3048 (i 2 (1+ i)))
3049 ((> i 256))
3050 (pass-if n
3051 (= i (integer-length n)))))
3052
3053 (with-test-prefix "-2^i-1 ...111011..11"
3054 (do ((n -2 (1+ (ash n 1)))
3055 (i 1 (1+ i)))
3056 ((> i 256))
3057 (pass-if n
3058 (= i (integer-length n))))))
3059
8ab3d8a0
KR
3060;;;
3061;;; log
3062;;;
3063
3064(with-test-prefix "log"
3065 (pass-if "documented?"
3066 (documented? log))
3067
3068 (pass-if-exception "no args" exception:wrong-num-args
3069 (log))
3070 (pass-if-exception "two args" exception:wrong-num-args
3071 (log 123 456))
3072
3073 (pass-if (negative-infinity? (log 0)))
3074 (pass-if (negative-infinity? (log 0.0)))
3075 (pass-if (eqv? 0.0 (log 1)))
3076 (pass-if (eqv? 0.0 (log 1.0)))
3077 (pass-if (eqv-loosely? 1.0 (log const-e)))
3078 (pass-if (eqv-loosely? 2.0 (log const-e^2)))
3079 (pass-if (eqv-loosely? -1.0 (log const-1/e)))
3080
3081 (pass-if (eqv-loosely? 1.0+1.57079i (log 0+2.71828i)))
3082 (pass-if (eqv-loosely? 1.0-1.57079i (log 0-2.71828i)))
3083
3084 (pass-if (eqv-loosely? 0.0+3.14159i (log -1.0)))
3085 (pass-if (eqv-loosely? 1.0+3.14159i (log -2.71828)))
3086 (pass-if (eqv-loosely? 2.0+3.14159i (log (* -2.71828 2.71828)))))
3087
3088;;;
3089;;; log10
3090;;;
3091
3092(with-test-prefix "log10"
3093 (pass-if "documented?"
3094 (documented? log10))
3095
3096 (pass-if-exception "no args" exception:wrong-num-args
3097 (log10))
3098 (pass-if-exception "two args" exception:wrong-num-args
3099 (log10 123 456))
3100
3101 (pass-if (negative-infinity? (log10 0)))
3102 (pass-if (negative-infinity? (log10 0.0)))
3103 (pass-if (eqv? 0.0 (log10 1)))
3104 (pass-if (eqv? 0.0 (log10 1.0)))
3105 (pass-if (eqv-loosely? 1.0 (log10 10.0)))
3106 (pass-if (eqv-loosely? 2.0 (log10 100.0)))
3107 (pass-if (eqv-loosely? -1.0 (log10 0.1)))
3108
3109 (pass-if (eqv-loosely? 1.0+0.68218i (log10 0+10.0i)))
3110 (pass-if (eqv-loosely? 1.0-0.68218i (log10 0-10.0i)))
3111
3112 (pass-if (eqv-loosely? 0.0+1.36437i (log10 -1)))
3113 (pass-if (eqv-loosely? 1.0+1.36437i (log10 -10)))
3114 (pass-if (eqv-loosely? 2.0+1.36437i (log10 -100))))
3115
abff733b
KR
3116;;;
3117;;; logbit?
3118;;;
3119
3120(with-test-prefix "logbit?"
3121 (pass-if (eq? #f (logbit? 0 0)))
3122 (pass-if (eq? #f (logbit? 1 0)))
3123 (pass-if (eq? #f (logbit? 31 0)))
3124 (pass-if (eq? #f (logbit? 32 0)))
3125 (pass-if (eq? #f (logbit? 33 0)))
3126 (pass-if (eq? #f (logbit? 63 0)))
3127 (pass-if (eq? #f (logbit? 64 0)))
3128 (pass-if (eq? #f (logbit? 65 0)))
3129
3130 ;; prior to guile 1.6.5, testing bit 32, 64 etc of value 1 would wrap
3131 ;; around and return #t where it ought to be #f
3132 (pass-if (eq? #t (logbit? 0 1)))
3133 (pass-if (eq? #f (logbit? 1 1)))
3134 (pass-if (eq? #f (logbit? 31 1)))
3135 (pass-if (eq? #f (logbit? 32 1)))
3136 (pass-if (eq? #f (logbit? 33 1)))
3137 (pass-if (eq? #f (logbit? 63 1)))
3138 (pass-if (eq? #f (logbit? 64 1)))
3139 (pass-if (eq? #f (logbit? 65 1)))
3140 (pass-if (eq? #f (logbit? 128 1)))
3141
3142 (pass-if (eq? #t (logbit? 0 -1)))
3143 (pass-if (eq? #t (logbit? 1 -1)))
3144 (pass-if (eq? #t (logbit? 31 -1)))
3145 (pass-if (eq? #t (logbit? 32 -1)))
3146 (pass-if (eq? #t (logbit? 33 -1)))
3147 (pass-if (eq? #t (logbit? 63 -1)))
3148 (pass-if (eq? #t (logbit? 64 -1)))
3149 (pass-if (eq? #t (logbit? 65 -1))))
3150
300c6a76
KR
3151;;;
3152;;; logcount
3153;;;
3154
3155(with-test-prefix "logcount"
3156
3157 (with-test-prefix "-2^i, meaning ...11100..00"
3158 (do ((n -1 (ash n 1))
3159 (i 0 (1+ i)))
3160 ((> i 256))
795c0bae
KR
3161 (pass-if n
3162 (= i (logcount n)))))
3163
3164 (with-test-prefix "2^i"
3165 (do ((n 1 (ash n 1))
3166 (i 0 (1+ i)))
3167 ((> i 256))
3168 (pass-if n
3169 (= 1 (logcount n)))))
3170
3171 (with-test-prefix "2^i-1"
3172 (do ((n 0 (1+ (ash n 1)))
3173 (i 0 (1+ i)))
3174 ((> i 256))
300c6a76
KR
3175 (pass-if n
3176 (= i (logcount n))))))
795c0bae 3177
afd09cfb
KR
3178;;;
3179;;; logior
3180;;;
3181
3182(with-test-prefix "logior"
3183 (pass-if (eqv? -1 (logior (ash -1 1) 1)))
3184
3185 ;; check that bignum or bignum+inum args will reduce to an inum
3186 (let ()
3187 (define (test x y)
3188 (pass-if (list x y '=> -1)
3189 (eqv? -1 (logior x y)))
3190 (pass-if (list y x '=> -1)
3191 (eqv? -1 (logior y x))))
3192 (test (ash -1 8) #xFF)
3193 (test (ash -1 28) #x0FFFFFFF)
3194 (test (ash -1 29) #x1FFFFFFF)
3195 (test (ash -1 30) #x3FFFFFFF)
3196 (test (ash -1 31) #x7FFFFFFF)
3197 (test (ash -1 32) #xFFFFFFFF)
3198 (test (ash -1 33) #x1FFFFFFFF)
3199 (test (ash -1 60) #x0FFFFFFFFFFFFFFF)
3200 (test (ash -1 61) #x1FFFFFFFFFFFFFFF)
3201 (test (ash -1 62) #x3FFFFFFFFFFFFFFF)
3202 (test (ash -1 63) #x7FFFFFFFFFFFFFFF)
3203 (test (ash -1 64) #xFFFFFFFFFFFFFFFF)
3204 (test (ash -1 65) #x1FFFFFFFFFFFFFFFF)
3205 (test (ash -1 128) #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)))
3206
1ec2dd6f
KR
3207;;;
3208;;; lognot
3209;;;
3210
3211(with-test-prefix "lognot"
3212 (pass-if (= -1 (lognot 0)))
3213 (pass-if (= 0 (lognot -1)))
3214 (pass-if (= -2 (lognot 1)))
3215 (pass-if (= 1 (lognot -2)))
3216
3217 (pass-if (= #x-100000000000000000000000000000000
3218 (lognot #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)))
3219 (pass-if (= #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
3220 (lognot #x-100000000000000000000000000000000))))
8ab3d8a0
KR
3221
3222;;;
3223;;; sqrt
3224;;;
3225
3226(with-test-prefix "sqrt"
3227 (pass-if "documented?"
3228 (documented? sqrt))
3229
3230 (pass-if-exception "no args" exception:wrong-num-args
3231 (sqrt))
3232 (pass-if-exception "two args" exception:wrong-num-args
3233 (sqrt 123 456))
3234
3235 (pass-if (eqv? 0.0 (sqrt 0)))
3236 (pass-if (eqv? 0.0 (sqrt 0.0)))
3237 (pass-if (eqv? 1.0 (sqrt 1.0)))
3238 (pass-if (eqv-loosely? 2.0 (sqrt 4.0)))
3239 (pass-if (eqv-loosely? 31.62 (sqrt 1000.0)))
3240
3241 (pass-if (eqv? +1.0i (sqrt -1.0)))
3242 (pass-if (eqv-loosely? +2.0i (sqrt -4.0)))
3243 (pass-if (eqv-loosely? +31.62i (sqrt -1000.0)))
3244
3245 (pass-if "+i swings back to 45deg angle"
3246 (eqv-loosely? +0.7071+0.7071i (sqrt +1.0i)))
3247
3248 ;; Note: glibc 2.3 csqrt() had a bug affecting this test case, so if it
3249 ;; fails check whether that's the cause (there's a configure test to
3250 ;; reject it, but when cross-compiling we assume the C library is ok).
3251 (pass-if "-100i swings back to 45deg down"
3252 (eqv-loosely? +7.071-7.071i (sqrt -100.0i))))
3253
c6a576f7
HWN
3254
3255;;
3256;; equal?
3257;;
3258
3259
3260(with-test-prefix "equal?"
3261 (pass-if
3262
3263 ;; lazy reduction bit for rationals should not affect equal?
3264 (equal? 1/2 ((lambda (x) (denominator x) x) 1/2))))
3265