HCoop / bpt / guile.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
(-): Exercise bignum - inum.
[bpt/guile.git] / test-suite / tests / numbers.test
CommitLineData
de142bea 1;;;; numbers.test --- tests guile's numbers -*- scheme -*-
072e6de2 2;;;; Copyright (C) 2000, 2001, 2003 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
7;;;; version 2.1 of the License, or (at your option) any later version.
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
16;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
de142bea 17
cb18f2a8 18(use-modules (ice-9 documentation))
de142bea 19
de142bea
DH		 20;;;
21;;; miscellaneous
22;;;
23
1b3a7932
DH		 24(define exception:numerical-overflow
25 (cons 'numerical-overflow "^Numerical overflow"))
26
cb18f2a8 27(define (documented? object)
5c96bc39 28 (not (not (object-documentation object))))
de142bea 29
8b7838b5
RB		 30(define fixnum-bit
31 (inexact->exact (+ (/ (log (+ most-positive-fixnum 1)) (log 2)) 1)))
32
21e39e8f
DH		 33(define fixnum-min most-negative-fixnum)
34(define fixnum-max most-positive-fixnum)
de142bea 35
de142bea
DH		 36;;;
37;;; exact?
38;;;
39
40(with-test-prefix "exact?"
41
de142bea 42 (pass-if "documented?"
cb18f2a8 43 (documented? exact?))
de142bea 44
21e39e8f 45 (with-test-prefix "integers"
de142bea 46
21e39e8f
DH		 47 (pass-if "0"
48 (exact? 0))
de142bea 49
21e39e8f
DH		 50 (pass-if "fixnum-max"
51 (exact? fixnum-max))
de142bea 52
21e39e8f
DH		 53 (pass-if "fixnum-max + 1"
54 (exact? (+ fixnum-max 1)))
de142bea 55
21e39e8f
DH		 56 (pass-if "fixnum-min"
57 (exact? fixnum-min))
de142bea 58
21e39e8f
DH		 59 (pass-if "fixnum-min - 1"
60 (exact? (- fixnum-min 1))))
61
62 (with-test-prefix "reals"
63
64 ;; (FIXME: need better examples.)
65
66 (pass-if "sqrt (fixnum-max^2 - 1)"
67 (eq? #f (exact? (sqrt (- (expt fixnum-max 2) 1)))))
68
69 (pass-if "sqrt ((fixnum-max+1)^2 - 1)"
70 (eq? #f (exact? (sqrt (- (expt (+ fixnum-max 1) 2) 1)))))))
de142bea
DH		 71
72;;;
73;;; odd?
74;;;
75
7c24e528
RB		 76(with-test-prefix "odd?"
77 (pass-if (documented? odd?))
78 (pass-if (odd? 1))
79 (pass-if (odd? -1))
4d332f19
DH		 80 (pass-if (not (odd? 0)))
81 (pass-if (not (odd? 2)))
82 (pass-if (not (odd? -2)))
7c24e528 83 (pass-if (odd? (+ (* 2 fixnum-max) 1)))
4d332f19 84 (pass-if (not (odd? (* 2 fixnum-max))))
7c24e528 85 (pass-if (odd? (- (* 2 fixnum-min) 1)))
4d332f19 86 (pass-if (not (odd? (* 2 fixnum-min)))))
de142bea
DH		 87
88;;;
89;;; even?
90;;;
91
7c24e528
RB		 92(with-test-prefix "even?"
93 (pass-if (documented? even?))
94 (pass-if (even? 2))
95 (pass-if (even? -2))
96 (pass-if (even? 0))
4d332f19
DH		 97 (pass-if (not (even? 1)))
98 (pass-if (not (even? -1)))
99 (pass-if (not (even? (+ (* 2 fixnum-max) 1))))
7c24e528 100 (pass-if (even? (* 2 fixnum-max)))
4d332f19 101 (pass-if (not (even? (- (* 2 fixnum-min) 1))))
7c24e528 102 (pass-if (even? (* 2 fixnum-min))))
de142bea
DH		 103
104;;;
7c24e528
RB		 105;;; inf? and inf
106;;;
107
108(with-test-prefix "inf?"
109 (pass-if (documented? inf?))
110 (pass-if (inf? (inf)))
111 ;; FIXME: what are the expected behaviors?
112 ;; (pass-if (inf? (/ 1.0 0.0))
113 ;; (pass-if (inf? (/ 1 0.0))
4d332f19
DH		 114 (pass-if (not (inf? 0)))
115 (pass-if (not (inf? 42.0)))
116 (pass-if (not (inf? (+ fixnum-max 1))))
117 (pass-if (not (inf? (- fixnum-min 1)))))
7c24e528
RB		 118
119;;;
120;;; nan? and nan
de142bea
DH		 121;;;
122
7c24e528
RB		 123(with-test-prefix "nan?"
124 (pass-if (documented? nan?))
125 (pass-if (nan? (nan)))
126 ;; FIXME: other ways we should be able to generate NaN?
4d332f19
DH		 127 (pass-if (not (nan? 0)))
128 (pass-if (not (nan? 42.0)))
129 (pass-if (not (nan? (+ fixnum-max 1))))
130 (pass-if (not (nan? (- fixnum-min 1)))))
de142bea 131
7c24e528
RB		 132;;;
133;;; abs
134;;;
135
136(with-test-prefix "abs"
137 (pass-if (documented? abs))
138 (pass-if (zero? (abs 0)))
139 (pass-if (= 1 (abs 1)))
140 (pass-if (= 1 (abs -1)))
141 (pass-if (= (+ fixnum-max 1) (abs (+ fixnum-max 1))))
142 (pass-if (= (+ (- fixnum-min) 1) (abs (- fixnum-min 1))))
143 (pass-if (positive? (abs 1.0)))
144 (pass-if (positive? (abs -1.0))))
145
de142bea
DH		 146;;;
147;;; quotient
148;;;
149
150(with-test-prefix "quotient"
151
de142bea 152 (expect-fail "documented?"
cb18f2a8 153 (documented? quotient))
de142bea 154
de142bea
DH		 155 (with-test-prefix "0 / n"
156
157 (pass-if "n = 1"
158 (eqv? 0 (quotient 0 1)))
159
160 (pass-if "n = -1"
161 (eqv? 0 (quotient 0 -1)))
162
21e39e8f
DH		 163 (pass-if "n = 2"
164 (eqv? 0 (quotient 0 2)))
165
166 (pass-if "n = fixnum-max"
167 (eqv? 0 (quotient 0 fixnum-max)))
168
169 (pass-if "n = fixnum-max + 1"
170 (eqv? 0 (quotient 0 (+ fixnum-max 1))))
171
172 (pass-if "n = fixnum-min"
173 (eqv? 0 (quotient 0 fixnum-min)))
174
175 (pass-if "n = fixnum-min - 1"
176 (eqv? 0 (quotient 0 (- fixnum-min 1)))))
de142bea 177
21e39e8f 178 (with-test-prefix "1 / n"
de142bea
DH		 179
180 (pass-if "n = 1"
181 (eqv? 1 (quotient 1 1)))
182
183 (pass-if "n = -1"
21e39e8f
DH		 184 (eqv? -1 (quotient 1 -1)))
185
186 (pass-if "n = 2"
187 (eqv? 0 (quotient 1 2)))
de142bea 188
21e39e8f
DH		 189 (pass-if "n = fixnum-max"
190 (eqv? 0 (quotient 1 fixnum-max)))
de142bea 191
21e39e8f
DH		 192 (pass-if "n = fixnum-max + 1"
193 (eqv? 0 (quotient 1 (+ fixnum-max 1))))
de142bea 194
21e39e8f
DH		 195 (pass-if "n = fixnum-min"
196 (eqv? 0 (quotient 1 fixnum-min)))
197
198 (pass-if "n = fixnum-min - 1"
199 (eqv? 0 (quotient 1 (- fixnum-min 1)))))
200
201 (with-test-prefix "-1 / n"
de142bea
DH		 202
203 (pass-if "n = 1"
21e39e8f 204 (eqv? -1 (quotient -1 1)))
de142bea
DH		 205
206 (pass-if "n = -1"
207 (eqv? 1 (quotient -1 -1)))
208
21e39e8f
DH		 209 (pass-if "n = 2"
210 (eqv? 0 (quotient -1 2)))
211
212 (pass-if "n = fixnum-max"
213 (eqv? 0 (quotient -1 fixnum-max)))
214
215 (pass-if "n = fixnum-max + 1"
216 (eqv? 0 (quotient -1 (+ fixnum-max 1))))
217
218 (pass-if "n = fixnum-min"
219 (eqv? 0 (quotient -1 fixnum-min)))
220
221 (pass-if "n = fixnum-min - 1"
222 (eqv? 0 (quotient -1 (- fixnum-min 1)))))
223
224 (with-test-prefix "fixnum-max / n"
225
226 (pass-if "n = 1"
227 (eqv? fixnum-max (quotient fixnum-max 1)))
228
229 (pass-if "n = -1"
230 (eqv? (- fixnum-max) (quotient fixnum-max -1)))
231
232 (pass-if "n = 2"
233 (eqv? fixnum-max (+ (* (quotient fixnum-max 2) 2) 1)))
234
235 (pass-if "n = fixnum-max"
236 (eqv? 1 (quotient fixnum-max fixnum-max)))
237
238 (pass-if "n = fixnum-max + 1"
239 (eqv? 0 (quotient fixnum-max (+ fixnum-max 1))))
240
241 (pass-if "n = fixnum-min"
242 (eqv? 0 (quotient fixnum-max fixnum-min)))
243
244 (pass-if "n = fixnum-min - 1"
245 (eqv? 0 (quotient fixnum-max (- fixnum-min 1)))))
246
247 (with-test-prefix "(fixnum-max + 1) / n"
248
249 (pass-if "n = 1"
250 (eqv? (+ fixnum-max 1) (quotient (+ fixnum-max 1) 1)))
251
252 (pass-if "n = -1"
253 (eqv? (- (+ fixnum-max 1)) (quotient (+ fixnum-max 1) -1)))
254
255 (pass-if "n = 2"
256 (eqv? (+ fixnum-max 1) (* (quotient (+ fixnum-max 1) 2) 2)))
257
258 (pass-if "n = fixnum-max"
259 (eqv? 1 (quotient (+ fixnum-max 1) fixnum-max)))
260
261 (pass-if "n = fixnum-max + 1"
262 (eqv? 1 (quotient (+ fixnum-max 1) (+ fixnum-max 1))))
263
264 (pass-if "n = fixnum-min"
265 (eqv? -1 (quotient (+ fixnum-max 1) fixnum-min)))
266
267 (pass-if "n = fixnum-min - 1"
268 (eqv? 0 (quotient (+ fixnum-max 1) (- fixnum-min 1)))))
269
270 (with-test-prefix "fixnum-min / n"
271
272 (pass-if "n = 1"
273 (eqv? fixnum-min (quotient fixnum-min 1)))
274
275 (pass-if "n = -1"
276 (eqv? (- fixnum-min) (quotient fixnum-min -1)))
277
278 (pass-if "n = 2"
279 (eqv? fixnum-min (* (quotient fixnum-min 2) 2)))
280
281 (pass-if "n = fixnum-max"
282 (eqv? -1 (quotient fixnum-min fixnum-max)))
283
284 (pass-if "n = fixnum-max + 1"
285 (eqv? -1 (quotient fixnum-min (+ fixnum-max 1))))
286
287 (pass-if "n = fixnum-min"
288 (eqv? 1 (quotient fixnum-min fixnum-min)))
289
290 (pass-if "n = fixnum-min - 1"
291 (eqv? 0 (quotient fixnum-min (- fixnum-min 1)))))
292
293 (with-test-prefix "(fixnum-min - 1) / n"
294
295 (pass-if "n = 1"
296 (eqv? (- fixnum-min 1) (quotient (- fixnum-min 1) 1)))
297
298 (pass-if "n = -1"
299 (eqv? (- (- fixnum-min 1)) (quotient (- fixnum-min 1) -1)))
300
301 (pass-if "n = 2"
302 (eqv? fixnum-min (* (quotient (- fixnum-min 1) 2) 2)))
303
304 (pass-if "n = fixnum-max"
305 (eqv? -1 (quotient (- fixnum-min 1) fixnum-max)))
306
307 (pass-if "n = fixnum-max + 1"
308 (eqv? -1 (quotient (- fixnum-min 1) (+ fixnum-max 1))))
309
310 (pass-if "n = fixnum-min"
311 (eqv? 1 (quotient (- fixnum-min 1) fixnum-min)))
312
313 (pass-if "n = fixnum-min - 1"
314 (eqv? 1 (quotient (- fixnum-min 1) (- fixnum-min 1)))))
de142bea
DH		 315
316 ;; Positive dividend and divisor
317
318 (pass-if "35 / 7"
319 (eqv? 5 (quotient 35 7)))
320
321 ;; Negative dividend, positive divisor
322
323 (pass-if "-35 / 7"
324 (eqv? -5 (quotient -35 7)))
325
326 ;; Positive dividend, negative divisor
327
328 (pass-if "35 / -7"
329 (eqv? -5 (quotient 35 -7)))
330
331 ;; Negative dividend and divisor
332
333 (pass-if "-35 / -7"
334 (eqv? 5 (quotient -35 -7)))
335
336 ;; Are numerical overflows detected correctly?
337
80074d77
DH		 338 (with-test-prefix "division by zero"
339
340 (pass-if-exception "(quotient 1 0)"
341 exception:numerical-overflow
342 (quotient 1 0))
343
344 (pass-if-exception "(quotient bignum 0)"
345 exception:numerical-overflow
346 (quotient (+ fixnum-max 1) 0)))
347
de142bea
DH		 348 ;; Are wrong type arguments detected correctly?
349
350 )
351
352;;;
353;;; remainder
354;;;
355
356(with-test-prefix "remainder"
357
de142bea 358 (expect-fail "documented?"
cb18f2a8 359 (documented? remainder))
de142bea 360
de142bea
DH		 361 (with-test-prefix "0 / n"
362
363 (pass-if "n = 1"
364 (eqv? 0 (remainder 0 1)))
365
366 (pass-if "n = -1"
367 (eqv? 0 (remainder 0 -1)))
368
21e39e8f
DH		 369 (pass-if "n = fixnum-max"
370 (eqv? 0 (remainder 0 fixnum-max)))
371
372 (pass-if "n = fixnum-max + 1"
373 (eqv? 0 (remainder 0 (+ fixnum-max 1))))
374
375 (pass-if "n = fixnum-min"
376 (eqv? 0 (remainder 0 fixnum-min)))
de142bea 377
21e39e8f
DH		 378 (pass-if "n = fixnum-min - 1"
379 (eqv? 0 (remainder 0 (- fixnum-min 1)))))
de142bea 380
21e39e8f 381 (with-test-prefix "1 / n"
de142bea
DH		 382
383 (pass-if "n = 1"
384 (eqv? 0 (remainder 1 1)))
385
386 (pass-if "n = -1"
21e39e8f
DH		 387 (eqv? 0 (remainder 1 -1)))
388
389 (pass-if "n = fixnum-max"
390 (eqv? 1 (remainder 1 fixnum-max)))
de142bea 391
21e39e8f
DH		 392 (pass-if "n = fixnum-max + 1"
393 (eqv? 1 (remainder 1 (+ fixnum-max 1))))
de142bea 394
21e39e8f
DH		 395 (pass-if "n = fixnum-min"
396 (eqv? 1 (remainder 1 fixnum-min)))
de142bea 397
21e39e8f
DH		 398 (pass-if "n = fixnum-min - 1"
399 (eqv? 1 (remainder 1 (- fixnum-min 1)))))
400
401 (with-test-prefix "-1 / n"
de142bea
DH		 402
403 (pass-if "n = 1"
21e39e8f 404 (eqv? 0 (remainder -1 1)))
de142bea
DH		 405
406 (pass-if "n = -1"
407 (eqv? 0 (remainder -1 -1)))
408
21e39e8f
DH		 409 (pass-if "n = fixnum-max"
410 (eqv? -1 (remainder -1 fixnum-max)))
411
412 (pass-if "n = fixnum-max + 1"
413 (eqv? -1 (remainder -1 (+ fixnum-max 1))))
414
415 (pass-if "n = fixnum-min"
416 (eqv? -1 (remainder -1 fixnum-min)))
417
418 (pass-if "n = fixnum-min - 1"
419 (eqv? -1 (remainder -1 (- fixnum-min 1)))))
420
421 (with-test-prefix "fixnum-max / n"
422
423 (pass-if "n = 1"
424 (eqv? 0 (remainder fixnum-max 1)))
425
426 (pass-if "n = -1"
427 (eqv? 0 (remainder fixnum-max -1)))
428
429 (pass-if "n = fixnum-max"
430 (eqv? 0 (remainder fixnum-max fixnum-max)))
431
432 (pass-if "n = fixnum-max + 1"
433 (eqv? fixnum-max (remainder fixnum-max (+ fixnum-max 1))))
434
435 (pass-if "n = fixnum-min"
436 (eqv? fixnum-max (remainder fixnum-max fixnum-min)))
437
438 (pass-if "n = fixnum-min - 1"
439 (eqv? fixnum-max (remainder fixnum-max (- fixnum-min 1)))))
440
441 (with-test-prefix "(fixnum-max + 1) / n"
442
443 (pass-if "n = 1"
444 (eqv? 0 (remainder (+ fixnum-max 1) 1)))
445
446 (pass-if "n = -1"
447 (eqv? 0 (remainder (+ fixnum-max 1) -1)))
448
449 (pass-if "n = fixnum-max"
450 (eqv? 1 (remainder (+ fixnum-max 1) fixnum-max)))
451
452 (pass-if "n = fixnum-max + 1"
453 (eqv? 0 (remainder (+ fixnum-max 1) (+ fixnum-max 1))))
454
455 (pass-if "n = fixnum-min"
456 (eqv? 0 (remainder (+ fixnum-max 1) fixnum-min)))
457
458 (pass-if "n = fixnum-min - 1"
459 (eqv? (+ fixnum-max 1) (remainder (+ fixnum-max 1) (- fixnum-min 1)))))
460
461 (with-test-prefix "fixnum-min / n"
462
463 (pass-if "n = 1"
464 (eqv? 0 (remainder fixnum-min 1)))
465
466 (pass-if "n = -1"
467 (eqv? 0 (remainder fixnum-min -1)))
468
469 (pass-if "n = fixnum-max"
470 (eqv? -1 (remainder fixnum-min fixnum-max)))
471
472 (pass-if "n = fixnum-max + 1"
473 (eqv? 0 (remainder fixnum-min (+ fixnum-max 1))))
474
475 (pass-if "n = fixnum-min"
476 (eqv? 0 (remainder fixnum-min fixnum-min)))
477
478 (pass-if "n = fixnum-min - 1"
479 (eqv? fixnum-min (remainder fixnum-min (- fixnum-min 1)))))
480
481 (with-test-prefix "(fixnum-min - 1) / n"
482
483 (pass-if "n = 1"
484 (eqv? 0 (remainder (- fixnum-min 1) 1)))
485
486 (pass-if "n = -1"
487 (eqv? 0 (remainder (- fixnum-min 1) -1)))
488
489 (pass-if "n = fixnum-max"
490 (eqv? -2 (remainder (- fixnum-min 1) fixnum-max)))
491
492 (pass-if "n = fixnum-max + 1"
493 (eqv? -1 (remainder (- fixnum-min 1) (+ fixnum-max 1))))
494
495 (pass-if "n = fixnum-min"
496 (eqv? -1 (remainder (- fixnum-min 1) fixnum-min)))
497
498 (pass-if "n = fixnum-min - 1"
499 (eqv? 0 (remainder (- fixnum-min 1) (- fixnum-min 1)))))
de142bea
DH		 500
501 ;; Positive dividend and divisor
502
503 (pass-if "35 / 7"
504 (eqv? 0 (remainder 35 7)))
505
506 ;; Negative dividend, positive divisor
507
508 (pass-if "-35 / 7"
509 (eqv? 0 (remainder -35 7)))
510
511 ;; Positive dividend, negative divisor
512
513 (pass-if "35 / -7"
514 (eqv? 0 (remainder 35 -7)))
515
516 ;; Negative dividend and divisor
517
518 (pass-if "-35 / -7"
519 (eqv? 0 (remainder -35 -7)))
520
521 ;; Are numerical overflows detected correctly?
522
80074d77
DH		 523 (with-test-prefix "division by zero"
524
525 (pass-if-exception "(remainder 1 0)"
526 exception:numerical-overflow
527 (remainder 1 0))
528
529 (pass-if-exception "(remainder bignum 0)"
530 exception:numerical-overflow
531 (remainder (+ fixnum-max 1) 0)))
532
de142bea
DH		 533 ;; Are wrong type arguments detected correctly?
534
535 )
536
537;;;
538;;; modulo
539;;;
540
541(with-test-prefix "modulo"
542
de142bea 543 (expect-fail "documented?"
cb18f2a8 544 (documented? modulo))
de142bea 545
de142bea
DH		 546 (with-test-prefix "0 % n"
547
548 (pass-if "n = 1"
549 (eqv? 0 (modulo 0 1)))
550
551 (pass-if "n = -1"
552 (eqv? 0 (modulo 0 -1)))
553
21e39e8f
DH		 554 (pass-if "n = fixnum-max"
555 (eqv? 0 (modulo 0 fixnum-max)))
556
557 (pass-if "n = fixnum-max + 1"
558 (eqv? 0 (modulo 0 (+ fixnum-max 1))))
de142bea 559
21e39e8f
DH		 560 (pass-if "n = fixnum-min"
561 (eqv? 0 (modulo 0 fixnum-min)))
de142bea 562
21e39e8f
DH		 563 (pass-if "n = fixnum-min - 1"
564 (eqv? 0 (modulo 0 (- fixnum-min 1)))))
565
566 (with-test-prefix "1 % n"
de142bea
DH		 567
568 (pass-if "n = 1"
569 (eqv? 0 (modulo 1 1)))
570
571 (pass-if "n = -1"
21e39e8f 572 (eqv? 0 (modulo 1 -1)))
de142bea 573
21e39e8f
DH		 574 (pass-if "n = fixnum-max"
575 (eqv? 1 (modulo 1 fixnum-max)))
de142bea 576
21e39e8f
DH		 577 (pass-if "n = fixnum-max + 1"
578 (eqv? 1 (modulo 1 (+ fixnum-max 1))))
de142bea 579
21e39e8f
DH		 580 (pass-if "n = fixnum-min"
581 (eqv? (+ fixnum-min 1) (modulo 1 fixnum-min)))
582
583 (pass-if "n = fixnum-min - 1"
584 (eqv? fixnum-min (modulo 1 (- fixnum-min 1)))))
585
586 (with-test-prefix "-1 % n"
de142bea
DH		 587
588 (pass-if "n = 1"
21e39e8f 589 (eqv? 0 (modulo -1 1)))
de142bea
DH		 590
591 (pass-if "n = -1"
592 (eqv? 0 (modulo -1 -1)))
593
21e39e8f
DH		 594 (pass-if "n = fixnum-max"
595 (eqv? (- fixnum-max 1) (modulo -1 fixnum-max)))
596
597 (pass-if "n = fixnum-max + 1"
598 (eqv? fixnum-max (modulo -1 (+ fixnum-max 1))))
599
600 (pass-if "n = fixnum-min"
601 (eqv? -1 (modulo -1 fixnum-min)))
602
603 (pass-if "n = fixnum-min - 1"
604 (eqv? -1 (modulo -1 (- fixnum-min 1)))))
605
606 (with-test-prefix "fixnum-max % n"
607
608 (pass-if "n = 1"
609 (eqv? 0 (modulo fixnum-max 1)))
610
611 (pass-if "n = -1"
612 (eqv? 0 (modulo fixnum-max -1)))
613
614 (pass-if "n = fixnum-max"
615 (eqv? 0 (modulo fixnum-max fixnum-max)))
616
617 (pass-if "n = fixnum-max + 1"
618 (eqv? fixnum-max (modulo fixnum-max (+ fixnum-max 1))))
619
620 (pass-if "n = fixnum-min"
621 (eqv? -1 (modulo fixnum-max fixnum-min)))
622
623 (pass-if "n = fixnum-min - 1"
624 (eqv? -2 (modulo fixnum-max (- fixnum-min 1)))))
625
626 (with-test-prefix "(fixnum-max + 1) % n"
627
628 (pass-if "n = 1"
629 (eqv? 0 (modulo (+ fixnum-max 1) 1)))
630
631 (pass-if "n = -1"
632 (eqv? 0 (modulo (+ fixnum-max 1) -1)))
633
634 (pass-if "n = fixnum-max"
635 (eqv? 1 (modulo (+ fixnum-max 1) fixnum-max)))
636
637 (pass-if "n = fixnum-max + 1"
638 (eqv? 0 (modulo (+ fixnum-max 1) (+ fixnum-max 1))))
639
640 (pass-if "n = fixnum-min"
641 (eqv? 0 (modulo (+ fixnum-max 1) fixnum-min)))
642
643 (pass-if "n = fixnum-min - 1"
644 (eqv? -1 (modulo (+ fixnum-max 1) (- fixnum-min 1)))))
645
646 (with-test-prefix "fixnum-min % n"
647
648 (pass-if "n = 1"
649 (eqv? 0 (modulo fixnum-min 1)))
650
651 (pass-if "n = -1"
652 (eqv? 0 (modulo fixnum-min -1)))
653
654 (pass-if "n = fixnum-max"
655 (eqv? (- fixnum-max 1) (modulo fixnum-min fixnum-max)))
656
657 (pass-if "n = fixnum-max + 1"
658 (eqv? 0 (modulo fixnum-min (+ fixnum-max 1))))
659
660 (pass-if "n = fixnum-min"
661 (eqv? 0 (modulo fixnum-min fixnum-min)))
662
663 (pass-if "n = fixnum-min - 1"
664 (eqv? fixnum-min (modulo fixnum-min (- fixnum-min 1)))))
665
666 (with-test-prefix "(fixnum-min - 1) % n"
667
668 (pass-if "n = 1"
669 (eqv? 0 (modulo (- fixnum-min 1) 1)))
670
671 (pass-if "n = -1"
672 (eqv? 0 (modulo (- fixnum-min 1) -1)))
673
674 (pass-if "n = fixnum-max"
675 (eqv? (- fixnum-max 2) (modulo (- fixnum-min 1) fixnum-max)))
676
677 (pass-if "n = fixnum-max + 1"
678 (eqv? fixnum-max (modulo (- fixnum-min 1) (+ fixnum-max 1))))
679
680 (pass-if "n = fixnum-min"
681 (eqv? -1 (modulo (- fixnum-min 1) fixnum-min)))
682
683 (pass-if "n = fixnum-min - 1"
684 (eqv? 0 (modulo (- fixnum-min 1) (- fixnum-min 1)))))
de142bea
DH		 685
686 ;; Positive dividend and divisor
687
688 (pass-if "13 % 4"
689 (eqv? 1 (modulo 13 4)))
690
691 (pass-if "2177452800 % 86400"
692 (eqv? 0 (modulo 2177452800 86400)))
693
694 ;; Negative dividend, positive divisor
695
696 (pass-if "-13 % 4"
697 (eqv? 3 (modulo -13 4)))
698
699 (pass-if "-2177452800 % 86400"
700 (eqv? 0 (modulo -2177452800 86400)))
701
702 ;; Positive dividend, negative divisor
703
704 (pass-if "13 % -4"
705 (eqv? -3 (modulo 13 -4)))
706
707 (pass-if "2177452800 % -86400"
708 (eqv? 0 (modulo 2177452800 -86400)))
709
710 ;; Negative dividend and divisor
711
712 (pass-if "-13 % -4"
713 (eqv? -1 (modulo -13 -4)))
714
715 (pass-if "-2177452800 % -86400"
716 (eqv? 0 (modulo -2177452800 -86400)))
717
718 ;; Are numerical overflows detected correctly?
719
80074d77
DH		 720 (with-test-prefix "division by zero"
721
722 (pass-if-exception "(modulo 1 0)"
723 exception:numerical-overflow
724 (modulo 1 0))
725
726 (pass-if-exception "(modulo bignum 0)"
727 exception:numerical-overflow
728 (modulo (+ fixnum-max 1) 0)))
729
de142bea
DH		 730 ;; Are wrong type arguments detected correctly?
731
732 )
733
734;;;
735;;; gcd
736;;;
737
738(with-test-prefix "gcd"
739
de142bea 740 (expect-fail "documented?"
cb18f2a8 741 (documented? gcd))
de142bea 742
de142bea
DH		 743 (with-test-prefix "(0 n)"
744
21e39e8f
DH		 745 (pass-if "n = 0"
746 (eqv? 0 (gcd 0 0)))
747
de142bea
DH		 748 (pass-if "n = 1"
749 (eqv? 1 (gcd 0 1)))
750
751 (pass-if "n = -1"
752 (eqv? 1 (gcd 0 -1)))
753
21e39e8f
DH		 754 (pass-if "n = fixnum-max"
755 (eqv? fixnum-max (gcd 0 fixnum-max)))
de142bea 756
21e39e8f
DH		 757 (pass-if "n = fixnum-max + 1"
758 (eqv? (+ fixnum-max 1) (gcd 0 (+ fixnum-max 1))))
de142bea 759
21e39e8f
DH		 760 (pass-if "n = fixnum-min"
761 (eqv? (- fixnum-min) (gcd 0 fixnum-min)))
de142bea 762
21e39e8f
DH		 763 (pass-if "n = fixnum-min - 1"
764 (eqv? (- (- fixnum-min 1)) (gcd 0 (- fixnum-min 1)))))
765
db386f80
KR		 766 (with-test-prefix "(n 0)"
767
768 (pass-if "n = 2^128 * fixnum-max"
769 (eqv? (ash fixnum-max 128) (gcd (ash fixnum-max 128) 0))))
770
21e39e8f
DH		 771 (with-test-prefix "(1 n)"
772
773 (pass-if "n = 0"
de142bea
DH		 774 (eqv? 1 (gcd 1 0)))
775
21e39e8f
DH		 776 (pass-if "n = 1"
777 (eqv? 1 (gcd 1 1)))
778
de142bea 779 (pass-if "n = -1"
21e39e8f
DH		 780 (eqv? 1 (gcd 1 -1)))
781
782 (pass-if "n = fixnum-max"
783 (eqv? 1 (gcd 1 fixnum-max)))
784
785 (pass-if "n = fixnum-max + 1"
786 (eqv? 1 (gcd 1 (+ fixnum-max 1))))
787
788 (pass-if "n = fixnum-min"
789 (eqv? 1 (gcd 1 fixnum-min)))
790
791 (pass-if "n = fixnum-min - 1"
792 (eqv? 1 (gcd 1 (- fixnum-min 1)))))
793
794 (with-test-prefix "(-1 n)"
795
796 (pass-if "n = 0"
de142bea
DH		 797 (eqv? 1 (gcd -1 0)))
798
21e39e8f
DH		 799 (pass-if "n = 1"
800 (eqv? 1 (gcd -1 1)))
de142bea 801
21e39e8f
DH		 802 (pass-if "n = -1"
803 (eqv? 1 (gcd -1 -1)))
de142bea 804
21e39e8f
DH		 805 (pass-if "n = fixnum-max"
806 (eqv? 1 (gcd -1 fixnum-max)))
807
808 (pass-if "n = fixnum-max + 1"
809 (eqv? 1 (gcd -1 (+ fixnum-max 1))))
810
811 (pass-if "n = fixnum-min"
812 (eqv? 1 (gcd -1 fixnum-min)))
813
814 (pass-if "n = fixnum-min - 1"
815 (eqv? 1 (gcd -1 (- fixnum-min 1)))))
816
817 (with-test-prefix "(fixnum-max n)"
818
819 (pass-if "n = 0"
820 (eqv? fixnum-max (gcd fixnum-max 0)))
de142bea
DH		 821
822 (pass-if "n = 1"
21e39e8f 823 (eqv? 1 (gcd fixnum-max 1)))
de142bea
DH		 824
825 (pass-if "n = -1"
21e39e8f
DH		 826 (eqv? 1 (gcd fixnum-max -1)))
827
828 (pass-if "n = fixnum-max"
829 (eqv? fixnum-max (gcd fixnum-max fixnum-max)))
de142bea 830
21e39e8f
DH		 831 (pass-if "n = fixnum-max + 1"
832 (eqv? 1 (gcd fixnum-max (+ fixnum-max 1))))
de142bea 833
21e39e8f
DH		 834 (pass-if "n = fixnum-min"
835 (eqv? 1 (gcd fixnum-max fixnum-min)))
de142bea 836
21e39e8f
DH		 837 (pass-if "n = fixnum-min - 1"
838 (eqv? 1 (gcd fixnum-max (- fixnum-min 1)))))
839
840 (with-test-prefix "((+ fixnum-max 1) n)"
841
842 (pass-if "n = 0"
843 (eqv? (+ fixnum-max 1) (gcd (+ fixnum-max 1) 0)))
844
845 (pass-if "n = 1"
846 (eqv? 1 (gcd (+ fixnum-max 1) 1)))
de142bea
DH		 847
848 (pass-if "n = -1"
21e39e8f 849 (eqv? 1 (gcd (+ fixnum-max 1) -1)))
de142bea 850
21e39e8f
DH		 851 (pass-if "n = fixnum-max"
852 (eqv? 1 (gcd (+ fixnum-max 1) fixnum-max)))
de142bea 853
21e39e8f
DH		 854 (pass-if "n = fixnum-max + 1"
855 (eqv? (+ fixnum-max 1) (gcd (+ fixnum-max 1) (+ fixnum-max 1))))
de142bea 856
21e39e8f
DH		 857 (pass-if "n = fixnum-min"
858 (eqv? (+ fixnum-max 1) (gcd (+ fixnum-max 1) fixnum-min)))
859
860 (pass-if "n = fixnum-min - 1"
861 (eqv? 1 (gcd (+ fixnum-max 1) (- fixnum-min 1)))))
862
863 (with-test-prefix "(fixnum-min n)"
864
865 (pass-if "n = 0"
866 (eqv? (- fixnum-min) (gcd fixnum-min 0)))
867
868 (pass-if "n = 1"
869 (eqv? 1 (gcd fixnum-min 1)))
de142bea
DH		 870
871 (pass-if "n = -1"
21e39e8f
DH		 872 (eqv? 1 (gcd fixnum-min -1)))
873
874 (pass-if "n = fixnum-max"
875 (eqv? 1 (gcd fixnum-min fixnum-max)))
876
877 (pass-if "n = fixnum-max + 1"
878 (eqv? (+ fixnum-max 1) (gcd fixnum-min (+ fixnum-max 1))))
de142bea 879
21e39e8f
DH		 880 (pass-if "n = fixnum-min"
881 (eqv? (- fixnum-min) (gcd fixnum-min fixnum-min)))
882
883 (pass-if "n = fixnum-min - 1"
884 (eqv? 1 (gcd fixnum-min (- fixnum-min 1)))))
885
886 (with-test-prefix "((- fixnum-min 1) n)"
887
888 (pass-if "n = 0"
889 (eqv? (- (- fixnum-min 1)) (gcd (- fixnum-min 1) 0)))
890
891 (pass-if "n = 1"
892 (eqv? 1 (gcd (- fixnum-min 1) 1)))
893
894 (pass-if "n = -1"
895 (eqv? 1 (gcd (- fixnum-min 1) -1)))
896
897 (pass-if "n = fixnum-max"
898 (eqv? 1 (gcd (- fixnum-min 1) fixnum-max)))
899
900 (pass-if "n = fixnum-max + 1"
901 (eqv? 1 (gcd (- fixnum-min 1) (+ fixnum-max 1))))
902
903 (pass-if "n = fixnum-min"
904 (eqv? 1 (gcd (- fixnum-min 1) fixnum-min)))
905
906 (pass-if "n = fixnum-min - 1"
907 (eqv? (- (- fixnum-min 1)) (gcd (- fixnum-min 1) (- fixnum-min 1)))))
de142bea
DH		 908
909 ;; Are wrong type arguments detected correctly?
910
911 )
912
f29b3454
DH		 913;;;
914;;; lcm
915;;;
916
7c24e528
RB		 917(with-test-prefix "lcm"
918 ;; FIXME: more tests?
919 ;; (some of these are already in r4rs.test)
920 (expect-fail (documented? lcm))
921 (pass-if (= (lcm) 1))
922 (pass-if (= (lcm 32 -36) 288))
923 (let ((big-n 115792089237316195423570985008687907853269984665640564039457584007913129639936) ; 2 ^ 256
924 (lcm-of-big-n-and-11 1273712981610478149659280835095566986385969831322046204434033424087044426039296))
925 (pass-if (= lcm-of-big-n-and-11 (lcm big-n 11)))
926 (pass-if (= lcm-of-big-n-and-11 (lcm 11 big-n 11)))))
927
f29b3454
DH		 928;;;
929;;; number->string
930;;;
931
7c24e528
RB		 932(with-test-prefix "number->string"
933 (let ((num->str->num
934 (lambda (n radix)
935 (string->number (number->string n radix) radix))))
936
937 (pass-if (documented? number->string))
938 (pass-if (string=? (number->string 0) "0"))
939 (pass-if (string=? (number->string 171) "171"))
940 (pass-if (= (+ fixnum-max 1) (num->str->num (+ fixnum-max 1) 10)))
941 (pass-if (= (- fixnum-min 1) (num->str->num (- fixnum-min 1) 10)))
942 (pass-if (= (inf) (num->str->num (inf) 10)))
943 (pass-if (= 1.3 (num->str->num 1.3 10)))))
944
f29b3454
DH		 945;;;
946;;; string->number
947;;;
948
2f4a254a
DH		 949(with-test-prefix "string->number"
950
951 (pass-if "string->number"
952 (documented? string->number))
953
954 (pass-if "non number strings"
955 (for-each (lambda (x) (if (string->number x) (throw 'fail)))
569c483b 956 '("" "q" "1q" "6+7iq" "8+9q" "10+11" "13+" "18@19q" "20@q" "23@"
2f4a254a 957 "+25iq" "26i" "-q" "-iq" "i" "5#.0" "8/" "10#11" ".#" "."
569c483b 958 "#o.2" "3.4q" "15.16e17q" "18.19e+q" ".q" ".17#18" "10q" "#b2"
2f4a254a
DH		 959 "#b3" "#b4" "#b5" "#b6" "#b7" "#b8" "#b9" "#ba" "#bb" "#bc"
960 "#bd" "#be" "#bf" "#q" "#b#b1" "#o#o1" "#d#d1" "#x#x1" "#e#e1"
961 "#i#i1" "12@12+0i"))
962 #t)
963
b7d9b1cf
DH		 964 (pass-if "valid number strings"
965 (for-each (lambda (couple)
966 (apply
967 (lambda (x y)
968 (let ((x (string->number x)))
969 (if (or (eq? x #f) (not (eqv? x y))) (throw 'fail))))
970 couple))
971 `(;; Radix:
972 ("#b0" 0) ("#B0" 0) ("#b1" 1) ("#B1" 1) ("#o0" 0) ("#O0" 0)
973 ("#o1" 1) ("#O1" 1) ("#o2" 2) ("#O2" 2) ("#o3" 3) ("#O3" 3)
974 ("#o4" 4) ("#O4" 4) ("#o5" 5) ("#O5" 5) ("#o6" 6) ("#O6" 6)
975 ("#o7" 7) ("#O7" 7) ("#d0" 0) ("#D0" 0) ("#d1" 1) ("#D1" 1)
976 ("#d2" 2) ("#D2" 2) ("#d3" 3) ("#D3" 3) ("#d4" 4) ("#D4" 4)
977 ("#d5" 5) ("#D5" 5) ("#d6" 6) ("#D6" 6) ("#d7" 7) ("#D7" 7)
978 ("#d8" 8) ("#D8" 8) ("#d9" 9) ("#D9" 9)
979 ("#xa" 10) ("#Xa" 10) ("#xb" 11) ("#Xb" 11)
980 ("#xc" 12) ("#Xc" 12) ("#xd" 13) ("#Xd" 13)
981 ("#xe" 14) ("#Xe" 14) ("#xf" 15) ("#Xf" 15)
982 ("#b1010" 10)
983 ("#o12345670" 2739128)
984 ("#d1234567890" 1234567890)
985 ("#x1234567890abcdef" 1311768467294899695)
986 ;; Exactness:
987 ("#e1" 1) ("#e1.2" 1) ("#i1.1" 1.1) ("#i1" 1.0)
988 ;; Integers:
989 ("1" ,(1+ 0)) ("23" ,(+ 9 9 5)) ("-1" ,(- 0 1))
990 ("-45" ,(- 0 45)) ("2#" 20.0) ("2##" 200.0) ("12##" 1200.0)
991 ("#b#i100" 4.0)
992 ;; Rationals:
993 ("1/1" 1) ("1/2" 0.5) ("-1/2" -0.5) ("1#/1" 10.0)
994 ("10/1#" 1.0) ("1#/1#" 1.0) ("#e9/10" 1) ("#e10/1#" 1)
995 ("#i6/8" 0.75) ("#i1/1" 1.0)
996 ;; Decimal numbers:
997 ;; * <uinteger 10> <suffix>
998 ("1e2" 100.0) ("1E2" 100.0) ("1s2" 100.0) ("1S2" 100.0)
999 ("1f2" 100.0) ("1F2" 100.0) ("1d2" 100.0) ("1D2" 100.0)
1000 ("1l2" 100.0) ("1L2" 100.0) ("1e+2" 100.0) ("1e-2" 0.01)
1001 ;; * . <digit 10>+ #* <suffix>
1002 (".1" .1) (".0123456789" 123456789e-10) (".16#" 0.16)
1003 (".0123456789e10" 123456789.0) (".16#e3" 160.0) ("#d.3" 0.3)
1004 ;; * <digit 10>+ . <digit 10>* #* <suffix>
1005 ("3." ,(exact->inexact 3)) ("3.e0" ,(exact->inexact 3))
1006 ("3.1" ,(exact->inexact 31/10)) ("3.1e0" 3.1) ("3.1#" 3.1)
1007 ("3.1#e0" 3.1)
1008 ;; * <digit 10>+ #+ . #* <suffix>
1009 ("3#." 30.0) ("3#.e0" 30.0) ("3#.#" 30.0) ("3#.#e0" 30.0)
1010 ;; Complex:
1011 ("1@0" 1.0) ("1@+0" 1.0) ("1@-0" 1.0)
1012 ("2+3i" ,(+ 2 (* 3 +i))) ("4-5i" ,(- 4 (* 5 +i)))
1013 ("1+i" 1+1i) ("1-i" 1-1i) ("+1i" 0+1i) ("-1i" 0-1i)
1014 ("+i" +1i) ("-i" -1i)))
1015 #t)
1016
2f4a254a
DH		 1017 (pass-if-exception "exponent too big"
1018 exception:out-of-range
1019 (string->number "12.13e141414")))
1020
f29b3454
DH		 1021;;;
1022;;; number?
1023;;;
1024
7c24e528
RB		 1025(with-test-prefix "number?"
1026 (pass-if (documented? number?))
1027 (pass-if (number? 0))
1028 (pass-if (number? 7))
1029 (pass-if (number? -7))
1030 (pass-if (number? 1.3))
1031 (pass-if (number? (+ 1 fixnum-max)))
1032 (pass-if (number? (- 1 fixnum-min)))
1033 (pass-if (number? 3+4i))
4d332f19
DH		 1034 (pass-if (not (number? #\a)))
1035 (pass-if (not (number? "a")))
1036 (pass-if (not (number? (make-vector 0))))
1037 (pass-if (not (number? (cons 1 2))))
1038 (pass-if (not (number? #t)))
1039 (pass-if (not (number? (lambda () #t))))
1040 (pass-if (not (number? (current-input-port)))))
7c24e528 1041
f29b3454
DH		 1042;;;
1043;;; complex?
1044;;;
1045
7c24e528
RB		 1046(with-test-prefix "complex?"
1047 (pass-if (documented? complex?))
1048 (pass-if (complex? 0))
1049 (pass-if (complex? 7))
1050 (pass-if (complex? -7))
1051 (pass-if (complex? (+ 1 fixnum-max)))
1052 (pass-if (complex? (- 1 fixnum-min)))
1053 (pass-if (complex? 1.3))
1054 (pass-if (complex? 3+4i))
4d332f19
DH		 1055 (pass-if (not (complex? #\a)))
1056 (pass-if (not (complex? "a")))
1057 (pass-if (not (complex? (make-vector 0))))
1058 (pass-if (not (complex? (cons 1 2))))
1059 (pass-if (not (complex? #t)))
1060 (pass-if (not (complex? (lambda () #t))))
1061 (pass-if (not (complex? (current-input-port)))))
7c24e528 1062
f29b3454
DH		 1063;;;
1064;;; real?
1065;;;
1066
7c24e528
RB		 1067(with-test-prefix "real?"
1068 (pass-if (documented? real?))
1069 (pass-if (real? 0))
1070 (pass-if (real? 7))
1071 (pass-if (real? -7))
1072 (pass-if (real? (+ 1 fixnum-max)))
1073 (pass-if (real? (- 1 fixnum-min)))
1074 (pass-if (real? 1.3))
4d332f19
DH		 1075 (pass-if (not (real? 3+4i)))
1076 (pass-if (not (real? #\a)))
1077 (pass-if (not (real? "a")))
1078 (pass-if (not (real? (make-vector 0))))
1079 (pass-if (not (real? (cons 1 2))))
1080 (pass-if (not (real? #t)))
1081 (pass-if (not (real? (lambda () #t))))
1082 (pass-if (not (real? (current-input-port)))))
7c24e528 1083
f29b3454 1084;;;
7c24e528 1085;;; rational? (same as real? right now)
f29b3454
DH		 1086;;;
1087
7c24e528
RB		 1088(with-test-prefix "rational?"
1089 (pass-if (documented? rational?))
1090 (pass-if (rational? 0))
1091 (pass-if (rational? 7))
1092 (pass-if (rational? -7))
1093 (pass-if (rational? (+ 1 fixnum-max)))
1094 (pass-if (rational? (- 1 fixnum-min)))
1095 (pass-if (rational? 1.3))
4d332f19
DH		 1096 (pass-if (not (rational? 3+4i)))
1097 (pass-if (not (rational? #\a)))
1098 (pass-if (not (rational? "a")))
1099 (pass-if (not (rational? (make-vector 0))))
1100 (pass-if (not (rational? (cons 1 2))))
1101 (pass-if (not (rational? #t)))
1102 (pass-if (not (rational? (lambda () #t))))
1103 (pass-if (not (rational? (current-input-port)))))
7c24e528 1104
f29b3454
DH		 1105;;;
1106;;; integer?
1107;;;
1108
7c24e528
RB		 1109(with-test-prefix "integer?"
1110 (pass-if (documented? integer?))
1111 (pass-if (integer? 0))
1112 (pass-if (integer? 7))
1113 (pass-if (integer? -7))
1114 (pass-if (integer? (+ 1 fixnum-max)))
1115 (pass-if (integer? (- 1 fixnum-min)))
1116 (pass-if (and (= 3+0i (round 3+0i)) (integer? 3+0i)))
1117 (pass-if (and (= 1.0 (round 1.0)) (integer? 1.0)))
4d332f19
DH		 1118 (pass-if (not (integer? 1.3)))
1119 (pass-if (not (integer? 3+4i)))
1120 (pass-if (not (integer? #\a)))
1121 (pass-if (not (integer? "a")))
1122 (pass-if (not (integer? (make-vector 0))))
1123 (pass-if (not (integer? (cons 1 2))))
1124 (pass-if (not (integer? #t)))
1125 (pass-if (not (integer? (lambda () #t))))
1126 (pass-if (not (integer? (current-input-port)))))
7c24e528 1127
f29b3454
DH		 1128;;;
1129;;; inexact?
1130;;;
1131
7c24e528
RB		 1132(with-test-prefix "inexact?"
1133 (pass-if (documented? inexact?))
4d332f19
DH		 1134 (pass-if (not (inexact? 0)))
1135 (pass-if (not (inexact? 7)))
1136 (pass-if (not (inexact? -7)))
1137 (pass-if (not (inexact? (+ 1 fixnum-max))))
1138 (pass-if (not (inexact? (- 1 fixnum-min))))
7c24e528
RB		 1139 (pass-if (inexact? 1.3))
1140 (pass-if (inexact? 3.1+4.2i))
4d332f19
DH		 1141 (pass-if (not (inexact? #\a)))
1142 (pass-if (not (inexact? "a")))
1143 (pass-if (not (inexact? (make-vector 0))))
1144 (pass-if (not (inexact? (cons 1 2))))
1145 (pass-if (not (inexact? #t)))
1146 (pass-if (not (inexact? (lambda () #t))))
1147 (pass-if (not (inexact? (current-input-port)))))
7c24e528 1148
f29b3454
DH		 1149;;;
1150;;; =
1151;;;
1152
7c24e528
RB		 1153(with-test-prefix "="
1154 (expect-fail (documented? =))
1155 (pass-if (= 0 0))
1156 (pass-if (= 7 7))
1157 (pass-if (= -7 -7))
1158 (pass-if (= (+ 1 fixnum-max) (+ 1 fixnum-max)))
1159 (pass-if (= (- 1 fixnum-min) (- 1 fixnum-min)))
4d332f19
DH		 1160 (pass-if (not (= 0 1)))
1161 (pass-if (not (= fixnum-max (+ 1 fixnum-max))))
1162 (pass-if (not (= (+ 1 fixnum-max) fixnum-max)))
1163 (pass-if (not (= fixnum-min (- fixnum-min 1))))
1164 (pass-if (not (= (- fixnum-min 1) fixnum-min)))
1165 (pass-if (not (= (+ fixnum-max 1) (- fixnum-min 1))))
2cfcaed5 1166
adda36ed
KR		 1167 (pass-if (not (= (ash 1 256) +inf.0)))
1168 (pass-if (not (= +inf.0 (ash 1 256))))
1169 (pass-if (not (= (ash 1 256) -inf.0)))
1170 (pass-if (not (= -inf.0 (ash 1 256))))
1171
1172 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
1173 ;; sure we've avoided that
1174 (pass-if (not (= (ash 1 1024) +inf.0)))
1175 (pass-if (not (= +inf.0 (ash 1 1024))))
1176 (pass-if (not (= (- (ash 1 1024)) -inf.0)))
1177 (pass-if (not (= -inf.0 (- (ash 1 1024)))))
1178
2cfcaed5
KR		 1179 (pass-if (not (= +nan.0 +nan.0)))
1180 (pass-if (not (= 0 +nan.0)))
1181 (pass-if (not (= +nan.0 0)))
1182 (pass-if (not (= 1 +nan.0)))
1183 (pass-if (not (= +nan.0 1)))
1184 (pass-if (not (= -1 +nan.0)))
1185 (pass-if (not (= +nan.0 -1)))
1186
1187 (pass-if (not (= (ash 1 256) +nan.0)))
1188 (pass-if (not (= +nan.0 (ash 1 256))))
1189 (pass-if (not (= (- (ash 1 256)) +nan.0)))
1190 (pass-if (not (= +nan.0 (- (ash 1 256)))))
1191
1192 (pass-if (not (= (ash 1 8192) +nan.0)))
1193 (pass-if (not (= +nan.0 (ash 1 8192))))
1194 (pass-if (not (= (- (ash 1 8192)) +nan.0)))
1195 (pass-if (not (= +nan.0 (- (ash 1 8192)))))
1196
1197 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
1198 ;; sure we've avoided that
1199 (pass-if (not (= (ash 3 1023) +nan.0)))
1200 (pass-if (not (= +nan.0 (ash 3 1023)))))
7c24e528 1201
de142bea
DH		 1202;;;
1203;;; <
1204;;;
1205
1206(with-test-prefix "<"
1207
de142bea 1208 (expect-fail "documented?"
cb18f2a8 1209 (documented? <))
de142bea 1210
de142bea
DH		 1211 (with-test-prefix "(< 0 n)"
1212
1213 (pass-if "n = 0"
1214 (not (< 0 0)))
1215
1216 (pass-if "n = 0.0"
1217 (not (< 0 0.0)))
1218
1219 (pass-if "n = 1"
1220 (< 0 1))
1221
1222 (pass-if "n = 1.0"
1223 (< 0 1.0))
1224
1225 (pass-if "n = -1"
1226 (not (< 0 -1)))
1227
1228 (pass-if "n = -1.0"
1229 (not (< 0 -1.0)))
1230
21e39e8f
DH		 1231 (pass-if "n = fixnum-max"
1232 (< 0 fixnum-max))
1233
1234 (pass-if "n = fixnum-max + 1"
1235 (< 0 (+ fixnum-max 1)))
1236
1237 (pass-if "n = fixnum-min"
1238 (not (< 0 fixnum-min)))
de142bea 1239
21e39e8f
DH		 1240 (pass-if "n = fixnum-min - 1"
1241 (not (< 0 (- fixnum-min 1)))))
1242
de142bea
DH		 1243 (with-test-prefix "(< 0.0 n)"
1244
1245 (pass-if "n = 0"
1246 (not (< 0.0 0)))
1247
1248 (pass-if "n = 0.0"
1249 (not (< 0.0 0.0)))
1250
1251 (pass-if "n = 1"
1252 (< 0.0 1))
1253
1254 (pass-if "n = 1.0"
1255 (< 0.0 1.0))
1256
1257 (pass-if "n = -1"
1258 (not (< 0.0 -1)))
1259
1260 (pass-if "n = -1.0"
1261 (not (< 0.0 -1.0)))
1262
21e39e8f
DH		 1263 (pass-if "n = fixnum-max"
1264 (< 0.0 fixnum-max))
1265
1266 (pass-if "n = fixnum-max + 1"
1267 (< 0.0 (+ fixnum-max 1)))
de142bea 1268
21e39e8f
DH		 1269 (pass-if "n = fixnum-min"
1270 (not (< 0.0 fixnum-min)))
1271
1272 (pass-if "n = fixnum-min - 1"
1273 (not (< 0.0 (- fixnum-min 1)))))
1274
1275 (with-test-prefix "(< 1 n)"
de142bea 1276
21e39e8f 1277 (pass-if "n = 0"
de142bea
DH		 1278 (not (< 1 0)))
1279
21e39e8f
DH		 1280 (pass-if "n = 0.0"
1281 (not (< 1 0.0)))
1282
1283 (pass-if "n = 1"
1284 (not (< 1 1)))
1285
de142bea 1286 (pass-if "n = 1.0"
21e39e8f
DH		 1287 (not (< 1 1.0)))
1288
1289 (pass-if "n = -1"
1290 (not (< 1 -1)))
1291
1292 (pass-if "n = -1.0"
1293 (not (< 1 -1.0)))
1294
1295 (pass-if "n = fixnum-max"
1296 (< 1 fixnum-max))
1297
1298 (pass-if "n = fixnum-max + 1"
1299 (< 1 (+ fixnum-max 1)))
1300
1301 (pass-if "n = fixnum-min"
1302 (not (< 1 fixnum-min)))
1303
1304 (pass-if "n = fixnum-min - 1"
1305 (not (< 1 (- fixnum-min 1)))))
1306
1307 (with-test-prefix "(< 1.0 n)"
1308
1309 (pass-if "n = 0"
de142bea
DH		 1310 (not (< 1.0 0)))
1311
21e39e8f
DH		 1312 (pass-if "n = 0.0"
1313 (not (< 1.0 0.0)))
1314
1315 (pass-if "n = 1"
1316 (not (< 1.0 1)))
1317
1318 (pass-if "n = 1.0"
1319 (not (< 1.0 1.0)))
1320
de142bea 1321 (pass-if "n = -1"
21e39e8f
DH		 1322 (not (< 1.0 -1)))
1323
1324 (pass-if "n = -1.0"
1325 (not (< 1.0 -1.0)))
1326
1327 (pass-if "n = fixnum-max"
1328 (< 1.0 fixnum-max))
1329
1330 (pass-if "n = fixnum-max + 1"
1331 (< 1.0 (+ fixnum-max 1)))
1332
1333 (pass-if "n = fixnum-min"
1334 (not (< 1.0 fixnum-min)))
1335
1336 (pass-if "n = fixnum-min - 1"
1337 (not (< 1.0 (- fixnum-min 1)))))
1338
1339 (with-test-prefix "(< -1 n)"
1340
1341 (pass-if "n = 0"
de142bea
DH		 1342 (< -1 0))
1343
21e39e8f
DH		 1344 (pass-if "n = 0.0"
1345 (< -1 0.0))
1346
1347 (pass-if "n = 1"
1348 (< -1 1))
1349
1350 (pass-if "n = 1.0"
1351 (< -1 1.0))
1352
1353 (pass-if "n = -1"
1354 (not (< -1 -1)))
1355
de142bea 1356 (pass-if "n = -1.0"
21e39e8f
DH		 1357 (not (< -1 -1.0)))
1358
1359 (pass-if "n = fixnum-max"
1360 (< -1 fixnum-max))
1361
1362 (pass-if "n = fixnum-max + 1"
1363 (< -1 (+ fixnum-max 1)))
1364
1365 (pass-if "n = fixnum-min"
1366 (not (< -1 fixnum-min)))
1367
1368 (pass-if "n = fixnum-min - 1"
1369 (not (< -1 (- fixnum-min 1)))))
1370
1371 (with-test-prefix "(< -1.0 n)"
1372
1373 (pass-if "n = 0"
de142bea
DH		 1374 (< -1.0 0))
1375
21e39e8f
DH		 1376 (pass-if "n = 0.0"
1377 (< -1.0 0.0))
1378
1379 (pass-if "n = 1"
1380 (< -1.0 1))
1381
1382 (pass-if "n = 1.0"
1383 (< -1.0 1.0))
1384
1385 (pass-if "n = -1"
1386 (not (< -1.0 -1)))
1387
1388 (pass-if "n = -1.0"
1389 (not (< -1.0 -1.0)))
1390
1391 (pass-if "n = fixnum-max"
1392 (< -1.0 fixnum-max))
1393
1394 (pass-if "n = fixnum-max + 1"
1395 (< -1.0 (+ fixnum-max 1)))
de142bea 1396
21e39e8f
DH		 1397 (pass-if "n = fixnum-min"
1398 (not (< -1.0 fixnum-min)))
1399
1400 (pass-if "n = fixnum-min - 1"
1401 (not (< -1.0 (- fixnum-min 1)))))
1402
1403 (with-test-prefix "(< fixnum-max n)"
1404
1405 (pass-if "n = 0"
1406 (not (< fixnum-max 0)))
1407
1408 (pass-if "n = 0.0"
1409 (not (< fixnum-max 0.0)))
de142bea
DH		 1410
1411 (pass-if "n = 1"
21e39e8f 1412 (not (< fixnum-max 1)))
de142bea
DH		 1413
1414 (pass-if "n = 1.0"
21e39e8f 1415 (not (< fixnum-max 1.0)))
de142bea
DH		 1416
1417 (pass-if "n = -1"
21e39e8f 1418 (not (< fixnum-max -1)))
de142bea
DH		 1419
1420 (pass-if "n = -1.0"
21e39e8f 1421 (not (< fixnum-max -1.0)))
de142bea 1422
21e39e8f
DH		 1423 (pass-if "n = fixnum-max"
1424 (not (< fixnum-max fixnum-max)))
de142bea 1425
21e39e8f
DH		 1426 (pass-if "n = fixnum-max + 1"
1427 (< fixnum-max (+ fixnum-max 1)))
1428
1429 (pass-if "n = fixnum-min"
1430 (not (< fixnum-max fixnum-min)))
1431
1432 (pass-if "n = fixnum-min - 1"
1433 (not (< fixnum-max (- fixnum-min 1)))))
1434
1435 (with-test-prefix "(< (+ fixnum-max 1) n)"
1436
1437 (pass-if "n = 0"
1438 (not (< (+ fixnum-max 1) 0)))
1439
1440 (pass-if "n = 0.0"
1441 (not (< (+ fixnum-max 1) 0.0)))
de142bea
DH		 1442
1443 (pass-if "n = 1"
21e39e8f 1444 (not (< (+ fixnum-max 1) 1)))
de142bea
DH		 1445
1446 (pass-if "n = 1.0"
21e39e8f 1447 (not (< (+ fixnum-max 1) 1.0)))
de142bea
DH		 1448
1449 (pass-if "n = -1"
21e39e8f 1450 (not (< (+ fixnum-max 1) -1)))
de142bea
DH		 1451
1452 (pass-if "n = -1.0"
21e39e8f 1453 (not (< (+ fixnum-max 1) -1.0)))
de142bea 1454
21e39e8f
DH		 1455 (pass-if "n = fixnum-max"
1456 (not (< (+ fixnum-max 1) fixnum-max)))
de142bea 1457
21e39e8f
DH		 1458 (pass-if "n = fixnum-max + 1"
1459 (not (< (+ fixnum-max 1) (+ fixnum-max 1))))
de142bea 1460
21e39e8f
DH		 1461 (pass-if "n = fixnum-min"
1462 (not (< (+ fixnum-max 1) fixnum-min)))
1463
1464 (pass-if "n = fixnum-min - 1"
1465 (not (< (+ fixnum-max 1) (- fixnum-min 1)))))
1466
1467 (with-test-prefix "(< fixnum-min n)"
1468
1469 (pass-if "n = 0"
1470 (< fixnum-min 0))
1471
1472 (pass-if "n = 0.0"
1473 (< fixnum-min 0.0))
de142bea
DH		 1474
1475 (pass-if "n = 1"
21e39e8f 1476 (< fixnum-min 1))
de142bea
DH		 1477
1478 (pass-if "n = 1.0"
21e39e8f 1479 (< fixnum-min 1.0))
de142bea
DH		 1480
1481 (pass-if "n = -1"
21e39e8f 1482 (< fixnum-min -1))
de142bea
DH		 1483
1484 (pass-if "n = -1.0"
21e39e8f 1485 (< fixnum-min -1.0))
de142bea 1486
21e39e8f
DH		 1487 (pass-if "n = fixnum-max"
1488 (< fixnum-min fixnum-max))
1489
1490 (pass-if "n = fixnum-max + 1"
1491 (< fixnum-min (+ fixnum-max 1)))
de142bea 1492
21e39e8f
DH		 1493 (pass-if "n = fixnum-min"
1494 (not (< fixnum-min fixnum-min)))
de142bea 1495
21e39e8f
DH		 1496 (pass-if "n = fixnum-min - 1"
1497 (not (< fixnum-min (- fixnum-min 1)))))
1498
1499 (with-test-prefix "(< (- fixnum-min 1) n)"
1500
1501 (pass-if "n = 0"
1502 (< (- fixnum-min 1) 0))
1503
1504 (pass-if "n = 0.0"
1505 (< (- fixnum-min 1) 0.0))
1506
1507 (pass-if "n = 1"
1508 (< (- fixnum-min 1) 1))
1509
1510 (pass-if "n = 1.0"
1511 (< (- fixnum-min 1) 1.0))
de142bea
DH		 1512
1513 (pass-if "n = -1"
21e39e8f 1514 (< (- fixnum-min 1) -1))
de142bea
DH		 1515
1516 (pass-if "n = -1.0"
21e39e8f
DH		 1517 (< (- fixnum-min 1) -1.0))
1518
1519 (pass-if "n = fixnum-max"
1520 (< (- fixnum-min 1) fixnum-max))
1521
1522 (pass-if "n = fixnum-max + 1"
1523 (< (- fixnum-min 1) (+ fixnum-max 1)))
1524
1525 (pass-if "n = fixnum-min"
1526 (< (- fixnum-min 1) fixnum-min))
1527
1528 (pass-if "n = fixnum-min - 1"
2cfcaed5
KR		 1529 (not (< (- fixnum-min 1) (- fixnum-min 1)))))
1530
adda36ed
KR		 1531 (pass-if (< (ash 1 256) +inf.0))
1532 (pass-if (not (< +inf.0 (ash 1 256))))
1533 (pass-if (not (< (ash 1 256) -inf.0)))
1534 (pass-if (< -inf.0 (ash 1 256)))
1535
1536 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
1537 ;; sure we've avoided that
1538 (pass-if (< (1- (ash 1 1024)) +inf.0))
1539 (pass-if (< (ash 1 1024) +inf.0))
1540 (pass-if (< (1+ (ash 1 1024)) +inf.0))
1541 (pass-if (not (< +inf.0 (1- (ash 1 1024)))))
1542 (pass-if (not (< +inf.0 (ash 1 1024))))
1543 (pass-if (not (< +inf.0 (1+ (ash 1 1024)))))
1544 (pass-if (< -inf.0 (- (1- (ash 1 1024)))))
1545 (pass-if (< -inf.0 (- (ash 1 1024))))
1546 (pass-if (< -inf.0 (- (1+ (ash 1 1024)))))
1547 (pass-if (not (< (- (1- (ash 1 1024))) -inf.0)))
1548 (pass-if (not (< (- (ash 1 1024)) -inf.0)))
1549 (pass-if (not (< (- (1+ (ash 1 1024))) -inf.0)))
1550
2cfcaed5
KR		 1551 (pass-if (not (< +nan.0 +nan.0)))
1552 (pass-if (not (< 0 +nan.0)))
1553 (pass-if (not (< +nan.0 0)))
1554 (pass-if (not (< 1 +nan.0)))
1555 (pass-if (not (< +nan.0 1)))
1556 (pass-if (not (< -1 +nan.0)))
1557 (pass-if (not (< +nan.0 -1)))
1558
1559 (pass-if (not (< (ash 1 256) +nan.0)))
1560 (pass-if (not (< +nan.0 (ash 1 256))))
1561 (pass-if (not (< (- (ash 1 256)) +nan.0)))
1562 (pass-if (not (< +nan.0 (- (ash 1 256)))))
1563
1564 (pass-if (not (< (ash 1 8192) +nan.0)))
1565 (pass-if (not (< +nan.0 (ash 1 8192))))
1566 (pass-if (not (< (- (ash 1 8192)) +nan.0)))
1567 (pass-if (not (< +nan.0 (- (ash 1 8192)))))
1568
1569 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
1570 ;; sure we've avoided that
1571 (pass-if (not (< (ash 3 1023) +nan.0)))
1572 (pass-if (not (< (1+ (ash 3 1023)) +nan.0)))
1573 (pass-if (not (< (1- (ash 3 1023)) +nan.0)))
1574 (pass-if (not (< +nan.0 (ash 3 1023))))
1575 (pass-if (not (< +nan.0 (1+ (ash 3 1023)))))
1576 (pass-if (not (< +nan.0 (1- (ash 3 1023))))))
f29b3454
DH		 1577
1578;;;
1579;;; >
1580;;;
1581
7c24e528
RB		 1582;; currently not tested -- implementation is trivial
1583;; (> x y) is implemented as (< y x)
1584;; FIXME: tests should probably be added in case we change implementation.
1585
f29b3454
DH		 1586;;;
1587;;; <=
1588;;;
1589
7c24e528
RB		 1590;; currently not tested -- implementation is trivial
1591;; (<= x y) is implemented as (not (< y x))
1592;; FIXME: tests should probably be added in case we change implementation.
1593
f29b3454
DH		 1594;;;
1595;;; >=
1596;;;
1597
7c24e528
RB		 1598;; currently not tested -- implementation is trivial
1599;; (>= x y) is implemented as (not (< x y))
1600;; FIXME: tests should probably be added in case we change implementation.
1601
f29b3454
DH		 1602;;;
1603;;; zero?
1604;;;
1605
7c24e528
RB		 1606(with-test-prefix "zero?"
1607 (expect-fail (documented? zero?))
1608 (pass-if (zero? 0))
4d332f19
DH		 1609 (pass-if (not (zero? 7)))
1610 (pass-if (not (zero? -7)))
1611 (pass-if (not (zero? (+ 1 fixnum-max))))
1612 (pass-if (not (zero? (- 1 fixnum-min))))
1613 (pass-if (not (zero? 1.3)))
1614 (pass-if (not (zero? 3.1+4.2i))))
7c24e528 1615
f29b3454
DH		 1616;;;
1617;;; positive?
1618;;;
1619
7c24e528
RB		 1620(with-test-prefix "positive?"
1621 (expect-fail (documented? positive?))
1622 (pass-if (positive? 1))
1623 (pass-if (positive? (+ fixnum-max 1)))
1624 (pass-if (positive? 1.3))
4d332f19
DH		 1625 (pass-if (not (positive? 0)))
1626 (pass-if (not (positive? -1)))
1627 (pass-if (not (positive? (- fixnum-min 1))))
1628 (pass-if (not (positive? -1.3))))
7c24e528 1629
f29b3454
DH		 1630;;;
1631;;; negative?
1632;;;
1633
7c24e528
RB		 1634(with-test-prefix "negative?"
1635 (expect-fail (documented? negative?))
4d332f19
DH		 1636 (pass-if (not (negative? 1)))
1637 (pass-if (not (negative? (+ fixnum-max 1))))
1638 (pass-if (not (negative? 1.3)))
1639 (pass-if (not (negative? 0)))
7c24e528
RB		 1640 (pass-if (negative? -1))
1641 (pass-if (negative? (- fixnum-min 1)))
1642 (pass-if (negative? -1.3)))
1643
f29b3454
DH		 1644;;;
1645;;; max
1646;;;
1647
adda36ed 1648(with-test-prefix "max"
501da403
KR		 1649 (pass-if (= 456.0 (max 123.0 456.0)))
1650 (pass-if (= 456.0 (max 456.0 123.0)))
1651
adda36ed
KR		 1652 (let ((big*2 (* fixnum-max 2))
1653 (big*3 (* fixnum-max 3))
1654 (big*4 (* fixnum-max 4))
1655 (big*5 (* fixnum-max 5)))
1656
1657 (pass-if (= +inf.0 (max big*5 +inf.0)))
1658 (pass-if (= +inf.0 (max +inf.0 big*5)))
1659 (pass-if (= big*5 (max big*5 -inf.0)))
501da403
KR		 1660 (pass-if (= big*5 (max -inf.0 big*5)))
1661
1662 (pass-if (nan? (max 123 +nan.0)))
1663 (pass-if (nan? (max big*5 +nan.0)))
1664 (pass-if (nan? (max 123.0 +nan.0)))
1665 (pass-if (nan? (max +nan.0 123)))
1666 (pass-if (nan? (max +nan.0 big*5)))
1667 (pass-if (nan? (max +nan.0 123.0)))
1668 (pass-if (nan? (max +nan.0 +nan.0))))
adda36ed
KR		 1669
1670 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
1671 ;; sure we've avoided that
1672 (for-each (lambda (b)
1673 (pass-if (list b +inf.0)
1674 (= +inf.0 (max b +inf.0)))
1675 (pass-if (list +inf.0 b)
1676 (= +inf.0 (max b +inf.0)))
1677 (pass-if (list b -inf.0)
1678 (= b (max b -inf.0)))
1679 (pass-if (list -inf.0 b)
1680 (= b (max b -inf.0))))
1681 (list (1- (ash 1 1024))
1682 (ash 1 1024)
1683 (1+ (ash 1 1024))
1684 (- (1- (ash 1 1024)))
1685 (- (ash 1 1024))
501da403
KR		 1686 (- (1+ (ash 1 1024)))))
1687
1688 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
1689 ;; sure we've avoided that
1690 (pass-if (nan? (max (ash 1 2048) +nan.0)))
1691 (pass-if (nan? (max +nan.0 (ash 1 2048)))))
adda36ed 1692
f29b3454
DH		 1693;;;
1694;;; min
1695;;;
1696
7c24e528
RB		 1697;; FIXME: unfinished...
1698
1699(with-test-prefix "min"
501da403
KR		 1700 (pass-if (= 123.0 (min 123.0 456.0)))
1701 (pass-if (= 123.0 (min 456.0 123.0)))
1702
7c24e528
RB		 1703 (let ((big*2 (* fixnum-max 2))
1704 (big*3 (* fixnum-max 3))
1705 (big*4 (* fixnum-max 4))
1706 (big*5 (* fixnum-max 5)))
1707
1708 (expect-fail (documented? max))
1709 (pass-if (= 1 (min 7 3 1 5)))
1710 (pass-if (= 1 (min 1 7 3 5)))
1711 (pass-if (= 1 (min 7 3 5 1)))
1712 (pass-if (= -7 (min 2 3 4 -2 5 -7 1 -1 4 2)))
1713 (pass-if (= -7 (min -7 2 3 4 -2 5 1 -1 4 2)))
1714 (pass-if (= -7 (min 2 3 4 -2 5 1 -1 4 2 -7)))
1715 (pass-if (= big*2 (min big*3 big*5 big*2 big*4)))
1716 (pass-if (= big*2 (min big*2 big*3 big*5 big*4)))
1717 (pass-if (= big*2 (min big*3 big*5 big*4 big*2)))
1718 (pass-if
1719 (= (- fixnum-min 1) (min 2 4 (- fixnum-min 1) 3 (* 2 fixnum-max))))
1720 (pass-if
1721 (= (- fixnum-min 1) (min (- fixnum-min 1) 2 4 3 (* 2 fixnum-max))))
1722 (pass-if
adda36ed 1723 (= (- fixnum-min 1) (min 2 4 3 (* 2 fixnum-max) (- fixnum-min 1))))
7c24e528 1724
adda36ed
KR		 1725 (pass-if (= big*5 (min big*5 +inf.0)))
1726 (pass-if (= big*5 (min +inf.0 big*5)))
1727 (pass-if (= -inf.0 (min big*5 -inf.0)))
501da403
KR		 1728 (pass-if (= -inf.0 (min -inf.0 big*5)))
1729
1730 (pass-if (nan? (min 123 +nan.0)))
1731 (pass-if (nan? (min big*5 +nan.0)))
1732 (pass-if (nan? (min 123.0 +nan.0)))
1733 (pass-if (nan? (min +nan.0 123)))
1734 (pass-if (nan? (min +nan.0 big*5)))
1735 (pass-if (nan? (min +nan.0 123.0)))
1736 (pass-if (nan? (min +nan.0 +nan.0))))
adda36ed
KR		 1737
1738 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
1739 ;; sure we've avoided that
1740 (for-each (lambda (b)
1741 (pass-if (list b +inf.0)
1742 (= b (min b +inf.0)))
1743 (pass-if (list +inf.0 b)
1744 (= b (min b +inf.0)))
1745 (pass-if (list b -inf.0)
1746 (= -inf.0 (min b -inf.0)))
1747 (pass-if (list -inf.0 b)
1748 (= -inf.0 (min b -inf.0))))
1749 (list (1- (ash 1 1024))
1750 (ash 1 1024)
1751 (1+ (ash 1 1024))
1752 (- (1- (ash 1 1024)))
1753 (- (ash 1 1024))
501da403
KR		 1754 (- (1+ (ash 1 1024)))))
1755
1756 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
1757 ;; sure we've avoided that
1758 (pass-if (nan? (min (- (ash 1 2048)) (- +nan.0))))
1759 (pass-if (nan? (min (- +nan.0) (- (ash 1 2048))))))
adda36ed 1760
f29b3454
DH		 1761;;;
1762;;; +
1763;;;
1764
1765(with-test-prefix "+"
1766
1767 (expect-fail "documented?"
1768 (documented? +))
1769
1770 (with-test-prefix "wrong type argument"
1771
1772 (pass-if-exception "1st argument string"
1773 exception:wrong-type-arg
1774 (+ "1" 2))
1775
1776 (pass-if-exception "2nd argument bool"
1777 exception:wrong-type-arg
1778 (+ 1 #f))))
1779;;;
1780;;; -
1781;;;
1782
072e6de2
KR		 1783(with-test-prefix "-"
1784
1785 (pass-if "-inum - +bignum"
1786 (= #x-100000000000000000000000000000001
ef016629
KR		 1787 (- -1 #x100000000000000000000000000000000)))
1788
1789 (pass-if "big - inum"
1790 (= #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
1791 (- #x100000000000000000000000000000000 1)))
1792
1793 (pass-if "big - -inum"
1794 (= #x100000000000000000000000000000001
1795 (- #x100000000000000000000000000000000 -1))))
072e6de2 1796
f29b3454
DH		 1797;;;
1798;;; *
1799;;;
1800
65ea251e
KR		 1801(with-test-prefix "*"
1802
1803 (pass-if "complex * bignum"
1804 (let ((big (ash 1 90)))
1805 (= (make-rectangular big big)
1806 (* 1+1i big)))))
1807
f29b3454
DH		 1808;;;
1809;;; /
1810;;;
1811
1b3a7932
DH		 1812(with-test-prefix "/"
1813
1814 (expect-fail "documented?"
1815 (documented? /))
1816
1817 (with-test-prefix "division by zero"
1818
1819 (pass-if-exception "(/ 0)"
1820 exception:numerical-overflow
1821 (/ 0))
1822
cdf52e3d
MV		 1823 (pass-if "(/ 0.0)"
1824 (= +inf.0 (/ 0.0)))
80074d77 1825
1b3a7932
DH		 1826 (pass-if-exception "(/ 1 0)"
1827 exception:numerical-overflow
80074d77
DH		 1828 (/ 1 0))
1829
cdf52e3d
MV		 1830 (pass-if "(/ 1 0.0)"
1831 (= +inf.0 (/ 1 0.0)))
80074d77
DH		 1832
1833 (pass-if-exception "(/ bignum 0)"
1834 exception:numerical-overflow
1835 (/ (+ fixnum-max 1) 0))
1836
cdf52e3d
MV		 1837 (pass-if "(/ bignum 0.0)"
1838 (= +inf.0 (/ (+ fixnum-max 1) 0.0)))
80074d77
DH		 1839
1840 (pass-if-exception "(/ 1.0 0)"
1841 exception:numerical-overflow
1842 (/ 1.0 0))
1843
cdf52e3d
MV		 1844 (pass-if "(/ 1.0 0.0)"
1845 (= +inf.0 (/ 1.0 0.0)))
80074d77
DH		 1846
1847 (pass-if-exception "(/ +i 0)"
1848 exception:numerical-overflow
1849 (/ +i 0))
1850
cdf52e3d
MV		 1851 (pass-if "(/ +i 0.0)"
1852 (= +inf.0 (imag-part (/ +i 0.0)))))
469b963c
MV		 1853
1854 (with-test-prefix "complex division"
1855
1856 (pass-if "(/ 3+4i)"
1857 (= (/ 3+4i) 0.12-0.16i))
1858
1859 (pass-if "(/ 4+3i)"
1860 (= (/ 4+3i) 0.16-0.12i))
1861
1862 (pass-if "(/ 25+125i 3+4i)"
1863 (= (/ 25+125i 3+4i) 23.0+11.0i))
1864
1865 (pass-if "(/ 25+125i 4+3i)"
1866 (= (/ 25+125i 4+3i) 19.0+17.0i))
1867
1868 (pass-if "(/ 25 3+4i)"
1869 (= (/ 25 3+4i) 3.0-4.0i))
1870
1871 (pass-if "(/ 25 4+3i)"
1872 (= (/ 25 4+3i) 4.0-3.0i))
1873
1874 (pass-if "(/ 1e200+1e200i)"
1875 (= (/ 1e200+1e200i) 5.0e-201-5.0e-201i))))
1b3a7932 1876
f29b3454
DH		 1877;;;
1878;;; truncate
1879;;;
1880
14a6784c
KR		 1881(with-test-prefix "truncate"
1882 (pass-if (= 1 (truncate 1.75)))
1883 (pass-if (= 1 (truncate 1.5)))
1884 (pass-if (= 1 (truncate 1.25)))
1885 (pass-if (= 0 (truncate 0.75)))
1886 (pass-if (= 0 (truncate 0.5)))
1887 (pass-if (= 0 (truncate 0.0)))
1888 (pass-if (= 0 (truncate -0.5)))
1889 (pass-if (= -1 (truncate -1.25)))
1890 (pass-if (= -1 (truncate -1.5))))
1891
f29b3454
DH		 1892;;;
1893;;; round
1894;;;
1895
14a6784c
KR		 1896(with-test-prefix "round"
1897 (pass-if (= 2 (round 1.75)))
1898 (pass-if (= 2 (round 1.5)))
1899 (pass-if (= 1 (round 1.25)))
1900 (pass-if (= 1 (round 0.75)))
1901 (pass-if (= 0 (round 0.5)))
1902 (pass-if (= 0 (round 0.0)))
1903 (pass-if (= 0 (round -0.5)))
1904 (pass-if (= -1 (round -1.25)))
1905 (pass-if (= -2 (round -1.5))))
1906
f29b3454
DH		 1907;;;
1908;;; exact->inexact
1909;;;
1910
1911;;;
1912;;; floor
1913;;;
1914
1915;;;
1916;;; ceiling
1917;;;
1918
46f2c0f1
RB		 1919;;;
1920;;; expt
1921;;;
1922
1923(with-test-prefix "expt"
1924 (pass-if "(= 1 (expt 0 0))" (= 1 (expt 0 0)))
1925 (pass-if "(= 1 (expt 0 0.0))" (= 1 (expt 0 0.0)))
1926 (pass-if "(= 1 (expt 0.0 0))" (= 1 (expt 0.0 0)))
1927 (pass-if "(= 1 (expt 0.0 0.0))" (= 1 (expt 0.0 0.0))))
1928
14a6784c
KR		 1929;;;
1930;;; asinh
1931;;;
1932
1933(with-test-prefix "asinh"
1934 (pass-if (= 0 (asinh 0))))
1935
1936;;;
1937;;; acosh
1938;;;
1939
1940(with-test-prefix "acosh"
1941 (pass-if (= 0 (acosh 1))))
1942
1943;;;
1944;;; atanh
1945;;;
1946
1947(with-test-prefix "atanh"
1948 (pass-if (= 0 (atanh 0))))
1949
f29b3454
DH		 1950;;;
1951;;; make-rectangular
1952;;;
1953
1954;;;
1955;;; make-polar
1956;;;
1957
d40681ec
KR		 1958(with-test-prefix "make-polar"
1959 (define pi 3.14159265358979323846)
1960 (define (almost= x y)
1961 (> 0.01 (magnitude (- x y))))
1962
1963 (pass-if (= 0 (make-polar 0 0)))
1964 (pass-if (= 0 (make-polar 0 123.456)))
1965 (pass-if (= 1 (make-polar 1 0)))
1966 (pass-if (= -1 (make-polar -1 0)))
1967
1968 (pass-if (almost= 0+i (make-polar 1 (* 0.5 pi))))
1969 (pass-if (almost= -1 (make-polar 1 (* 1.0 pi))))
1970 (pass-if (almost= 0-i (make-polar 1 (* 1.5 pi))))
1971 (pass-if (almost= 1 (make-polar 1 (* 2.0 pi)))))
1972
f29b3454
DH		 1973;;;
1974;;; real-part
1975;;;
1976
1977;;;
1978;;; imag-part
1979;;;
1980
1981;;;
1982;;; magnitude
1983;;;
1984
d40681ec
KR		 1985(with-test-prefix "magnitude"
1986 (pass-if (= 0 (magnitude 0)))
1987 (pass-if (= 1 (magnitude 1)))
1988 (pass-if (= 1 (magnitude -1)))
1989 (pass-if (= 1 (magnitude 0+i)))
1990 (pass-if (= 1 (magnitude 0-i)))
1991 (pass-if (= 5 (magnitude 3+4i)))
1992 (pass-if (= 5 (magnitude 3-4i)))
1993 (pass-if (= 5 (magnitude -3+4i)))
1994 (pass-if (= 5 (magnitude -3-4i))))
1995
f29b3454
DH		 1996;;;
1997;;; angle
1998;;;
1999
cfc9fc1c
KR		 2000(with-test-prefix "angle"
2001 (define pi 3.14159265358979323846)
2002 (define (almost= x y)
2003 (> 0.01 (magnitude (- x y))))
2004
2005 (pass-if "inum +ve" (= 0 (angle 1)))
2006 (pass-if "inum -ve" (almost= pi (angle -1)))
2007
2008 (pass-if "bignum +ve" (= 0 (angle (1+ fixnum-max))))
2009 (pass-if "bignum -ve" (almost= pi (angle (1- fixnum-min))))
2010
2011 (pass-if "flonum +ve" (= 0 (angle 1.5)))
2012 (pass-if "flonum -ve" (almost= pi (angle -1.5))))
2013
f29b3454
DH		 2014;;;
2015;;; inexact->exact
2016;;;
300c6a76 2017
a04a3604
KR		 2018;;;
2019;;; integer-length
2020;;;
2021
2022(with-test-prefix "integer-length"
2023
2024 (with-test-prefix "-2^i, ...11100..00"
2025 (do ((n -1 (ash n 1))
2026 (i 0 (1+ i)))
2027 ((> i 256))
2028 (pass-if (list n "expect" i)
2029 (= i (integer-length n)))))
2030
2031 (with-test-prefix "-2^i+1 ...11100..01"
2032 (do ((n -3 (logxor 3 (ash n 1)))
2033 (i 2 (1+ i)))
2034 ((> i 256))
2035 (pass-if n
2036 (= i (integer-length n)))))
2037
2038 (with-test-prefix "-2^i-1 ...111011..11"
2039 (do ((n -2 (1+ (ash n 1)))
2040 (i 1 (1+ i)))
2041 ((> i 256))
2042 (pass-if n
2043 (= i (integer-length n))))))
2044
300c6a76
KR		 2045;;;
2046;;; logcount
2047;;;
2048
2049(with-test-prefix "logcount"
2050
2051 (with-test-prefix "-2^i, meaning ...11100..00"
2052 (do ((n -1 (ash n 1))
2053 (i 0 (1+ i)))
2054 ((> i 256))
795c0bae
KR		 2055 (pass-if n
2056 (= i (logcount n)))))
2057
2058 (with-test-prefix "2^i"
2059 (do ((n 1 (ash n 1))
2060 (i 0 (1+ i)))
2061 ((> i 256))
2062 (pass-if n
2063 (= 1 (logcount n)))))
2064
2065 (with-test-prefix "2^i-1"
2066 (do ((n 0 (1+ (ash n 1)))
2067 (i 0 (1+ i)))
2068 ((> i 256))
300c6a76
KR		 2069 (pass-if n
2070 (= i (logcount n))))))
795c0bae 2071
Unnamed repository; edit this file 'description' to name the repository.