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