HCoop / bpt / guile.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
(inexact->exact): New tests.
[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
47ae1f0e
DH		 1149;;;
1150;;; equal?
1151;;;
1152
1153(with-test-prefix "equal?"
1154 (pass-if (documented? equal?))
1155 (pass-if (equal? 0 0))
1156 (pass-if (equal? 7 7))
1157 (pass-if (equal? -7 -7))
1158 (pass-if (equal? (+ 1 fixnum-max) (+ 1 fixnum-max)))
1159 (pass-if (equal? (- fixnum-min 1) (- fixnum-min 1)))
1160 (pass-if (not (equal? 0 1)))
1161 (pass-if (not (equal? fixnum-max (+ 1 fixnum-max))))
1162 (pass-if (not (equal? (+ 1 fixnum-max) fixnum-max)))
1163 (pass-if (not (equal? (+ 1 fixnum-max) (+ 2 fixnum-max))))
1164 (pass-if (not (equal? fixnum-min (- fixnum-min 1))))
1165 (pass-if (not (equal? (- fixnum-min 1) fixnum-min)))
1166 (pass-if (not (equal? (- fixnum-min 1) (- fixnum-min 2))))
1167 (pass-if (not (equal? (+ fixnum-max 1) (- fixnum-min 1))))
1168
1169 (pass-if (not (equal? (ash 1 256) +inf.0)))
1170 (pass-if (not (equal? +inf.0 (ash 1 256))))
1171 (pass-if (not (equal? (ash 1 256) -inf.0)))
1172 (pass-if (not (equal? -inf.0 (ash 1 256))))
1173
1174 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
1175 ;; sure we've avoided that
1176 (pass-if (not (equal? (ash 1 1024) +inf.0)))
1177 (pass-if (not (equal? +inf.0 (ash 1 1024))))
1178 (pass-if (not (equal? (- (ash 1 1024)) -inf.0)))
1179 (pass-if (not (equal? -inf.0 (- (ash 1 1024)))))
1180
1181 (pass-if (not (equal? +nan.0 +nan.0)))
1182 (pass-if (not (equal? 0 +nan.0)))
1183 (pass-if (not (equal? +nan.0 0)))
1184 (pass-if (not (equal? 1 +nan.0)))
1185 (pass-if (not (equal? +nan.0 1)))
1186 (pass-if (not (equal? -1 +nan.0)))
1187 (pass-if (not (equal? +nan.0 -1)))
1188
1189 (pass-if (not (equal? (ash 1 256) +nan.0)))
1190 (pass-if (not (equal? +nan.0 (ash 1 256))))
1191 (pass-if (not (equal? (- (ash 1 256)) +nan.0)))
1192 (pass-if (not (equal? +nan.0 (- (ash 1 256)))))
1193
1194 (pass-if (not (equal? (ash 1 8192) +nan.0)))
1195 (pass-if (not (equal? +nan.0 (ash 1 8192))))
1196 (pass-if (not (equal? (- (ash 1 8192)) +nan.0)))
1197 (pass-if (not (equal? +nan.0 (- (ash 1 8192)))))
1198
1199 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
1200 ;; sure we've avoided that
1201 (pass-if (not (equal? (ash 3 1023) +nan.0)))
1202 (pass-if (not (equal? +nan.0 (ash 3 1023)))))
1203
f29b3454
DH		 1204;;;
1205;;; =
1206;;;
1207
7c24e528
RB		 1208(with-test-prefix "="
1209 (expect-fail (documented? =))
1210 (pass-if (= 0 0))
1211 (pass-if (= 7 7))
1212 (pass-if (= -7 -7))
1213 (pass-if (= (+ 1 fixnum-max) (+ 1 fixnum-max)))
47ae1f0e 1214 (pass-if (= (- fixnum-min 1) (- fixnum-min 1)))
4d332f19
DH		 1215 (pass-if (not (= 0 1)))
1216 (pass-if (not (= fixnum-max (+ 1 fixnum-max))))
1217 (pass-if (not (= (+ 1 fixnum-max) fixnum-max)))
47ae1f0e 1218 (pass-if (not (= (+ 1 fixnum-max) (+ 2 fixnum-max))))
4d332f19
DH		 1219 (pass-if (not (= fixnum-min (- fixnum-min 1))))
1220 (pass-if (not (= (- fixnum-min 1) fixnum-min)))
47ae1f0e 1221 (pass-if (not (= (- fixnum-min 1) (- fixnum-min 2))))
4d332f19 1222 (pass-if (not (= (+ fixnum-max 1) (- fixnum-min 1))))
2cfcaed5 1223
adda36ed
KR		 1224 (pass-if (not (= (ash 1 256) +inf.0)))
1225 (pass-if (not (= +inf.0 (ash 1 256))))
1226 (pass-if (not (= (ash 1 256) -inf.0)))
1227 (pass-if (not (= -inf.0 (ash 1 256))))
1228
1229 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
1230 ;; sure we've avoided that
1231 (pass-if (not (= (ash 1 1024) +inf.0)))
1232 (pass-if (not (= +inf.0 (ash 1 1024))))
1233 (pass-if (not (= (- (ash 1 1024)) -inf.0)))
1234 (pass-if (not (= -inf.0 (- (ash 1 1024)))))
1235
2cfcaed5
KR		 1236 (pass-if (not (= +nan.0 +nan.0)))
1237 (pass-if (not (= 0 +nan.0)))
1238 (pass-if (not (= +nan.0 0)))
1239 (pass-if (not (= 1 +nan.0)))
1240 (pass-if (not (= +nan.0 1)))
1241 (pass-if (not (= -1 +nan.0)))
1242 (pass-if (not (= +nan.0 -1)))
1243
1244 (pass-if (not (= (ash 1 256) +nan.0)))
1245 (pass-if (not (= +nan.0 (ash 1 256))))
1246 (pass-if (not (= (- (ash 1 256)) +nan.0)))
1247 (pass-if (not (= +nan.0 (- (ash 1 256)))))
1248
1249 (pass-if (not (= (ash 1 8192) +nan.0)))
1250 (pass-if (not (= +nan.0 (ash 1 8192))))
1251 (pass-if (not (= (- (ash 1 8192)) +nan.0)))
1252 (pass-if (not (= +nan.0 (- (ash 1 8192)))))
1253
1254 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
1255 ;; sure we've avoided that
1256 (pass-if (not (= (ash 3 1023) +nan.0)))
1257 (pass-if (not (= +nan.0 (ash 3 1023)))))
7c24e528 1258
de142bea
DH		 1259;;;
1260;;; <
1261;;;
1262
1263(with-test-prefix "<"
1264
de142bea 1265 (expect-fail "documented?"
cb18f2a8 1266 (documented? <))
de142bea 1267
de142bea
DH		 1268 (with-test-prefix "(< 0 n)"
1269
1270 (pass-if "n = 0"
1271 (not (< 0 0)))
1272
1273 (pass-if "n = 0.0"
1274 (not (< 0 0.0)))
1275
1276 (pass-if "n = 1"
1277 (< 0 1))
1278
1279 (pass-if "n = 1.0"
1280 (< 0 1.0))
1281
1282 (pass-if "n = -1"
1283 (not (< 0 -1)))
1284
1285 (pass-if "n = -1.0"
1286 (not (< 0 -1.0)))
1287
21e39e8f
DH		 1288 (pass-if "n = fixnum-max"
1289 (< 0 fixnum-max))
1290
1291 (pass-if "n = fixnum-max + 1"
1292 (< 0 (+ fixnum-max 1)))
1293
1294 (pass-if "n = fixnum-min"
1295 (not (< 0 fixnum-min)))
de142bea 1296
21e39e8f
DH		 1297 (pass-if "n = fixnum-min - 1"
1298 (not (< 0 (- fixnum-min 1)))))
1299
de142bea
DH		 1300 (with-test-prefix "(< 0.0 n)"
1301
1302 (pass-if "n = 0"
1303 (not (< 0.0 0)))
1304
1305 (pass-if "n = 0.0"
1306 (not (< 0.0 0.0)))
1307
1308 (pass-if "n = 1"
1309 (< 0.0 1))
1310
1311 (pass-if "n = 1.0"
1312 (< 0.0 1.0))
1313
1314 (pass-if "n = -1"
1315 (not (< 0.0 -1)))
1316
1317 (pass-if "n = -1.0"
1318 (not (< 0.0 -1.0)))
1319
21e39e8f
DH		 1320 (pass-if "n = fixnum-max"
1321 (< 0.0 fixnum-max))
1322
1323 (pass-if "n = fixnum-max + 1"
1324 (< 0.0 (+ fixnum-max 1)))
de142bea 1325
21e39e8f
DH		 1326 (pass-if "n = fixnum-min"
1327 (not (< 0.0 fixnum-min)))
1328
1329 (pass-if "n = fixnum-min - 1"
1330 (not (< 0.0 (- fixnum-min 1)))))
1331
1332 (with-test-prefix "(< 1 n)"
de142bea 1333
21e39e8f 1334 (pass-if "n = 0"
de142bea
DH		 1335 (not (< 1 0)))
1336
21e39e8f
DH		 1337 (pass-if "n = 0.0"
1338 (not (< 1 0.0)))
1339
1340 (pass-if "n = 1"
1341 (not (< 1 1)))
1342
de142bea 1343 (pass-if "n = 1.0"
21e39e8f
DH		 1344 (not (< 1 1.0)))
1345
1346 (pass-if "n = -1"
1347 (not (< 1 -1)))
1348
1349 (pass-if "n = -1.0"
1350 (not (< 1 -1.0)))
1351
1352 (pass-if "n = fixnum-max"
1353 (< 1 fixnum-max))
1354
1355 (pass-if "n = fixnum-max + 1"
1356 (< 1 (+ fixnum-max 1)))
1357
1358 (pass-if "n = fixnum-min"
1359 (not (< 1 fixnum-min)))
1360
1361 (pass-if "n = fixnum-min - 1"
1362 (not (< 1 (- fixnum-min 1)))))
1363
1364 (with-test-prefix "(< 1.0 n)"
1365
1366 (pass-if "n = 0"
de142bea
DH		 1367 (not (< 1.0 0)))
1368
21e39e8f
DH		 1369 (pass-if "n = 0.0"
1370 (not (< 1.0 0.0)))
1371
1372 (pass-if "n = 1"
1373 (not (< 1.0 1)))
1374
1375 (pass-if "n = 1.0"
1376 (not (< 1.0 1.0)))
1377
de142bea 1378 (pass-if "n = -1"
21e39e8f
DH		 1379 (not (< 1.0 -1)))
1380
1381 (pass-if "n = -1.0"
1382 (not (< 1.0 -1.0)))
1383
1384 (pass-if "n = fixnum-max"
1385 (< 1.0 fixnum-max))
1386
1387 (pass-if "n = fixnum-max + 1"
1388 (< 1.0 (+ fixnum-max 1)))
1389
1390 (pass-if "n = fixnum-min"
1391 (not (< 1.0 fixnum-min)))
1392
1393 (pass-if "n = fixnum-min - 1"
1394 (not (< 1.0 (- fixnum-min 1)))))
1395
1396 (with-test-prefix "(< -1 n)"
1397
1398 (pass-if "n = 0"
de142bea
DH		 1399 (< -1 0))
1400
21e39e8f
DH		 1401 (pass-if "n = 0.0"
1402 (< -1 0.0))
1403
1404 (pass-if "n = 1"
1405 (< -1 1))
1406
1407 (pass-if "n = 1.0"
1408 (< -1 1.0))
1409
1410 (pass-if "n = -1"
1411 (not (< -1 -1)))
1412
de142bea 1413 (pass-if "n = -1.0"
21e39e8f
DH		 1414 (not (< -1 -1.0)))
1415
1416 (pass-if "n = fixnum-max"
1417 (< -1 fixnum-max))
1418
1419 (pass-if "n = fixnum-max + 1"
1420 (< -1 (+ fixnum-max 1)))
1421
1422 (pass-if "n = fixnum-min"
1423 (not (< -1 fixnum-min)))
1424
1425 (pass-if "n = fixnum-min - 1"
1426 (not (< -1 (- fixnum-min 1)))))
1427
1428 (with-test-prefix "(< -1.0 n)"
1429
1430 (pass-if "n = 0"
de142bea
DH		 1431 (< -1.0 0))
1432
21e39e8f
DH		 1433 (pass-if "n = 0.0"
1434 (< -1.0 0.0))
1435
1436 (pass-if "n = 1"
1437 (< -1.0 1))
1438
1439 (pass-if "n = 1.0"
1440 (< -1.0 1.0))
1441
1442 (pass-if "n = -1"
1443 (not (< -1.0 -1)))
1444
1445 (pass-if "n = -1.0"
1446 (not (< -1.0 -1.0)))
1447
1448 (pass-if "n = fixnum-max"
1449 (< -1.0 fixnum-max))
1450
1451 (pass-if "n = fixnum-max + 1"
1452 (< -1.0 (+ fixnum-max 1)))
de142bea 1453
21e39e8f
DH		 1454 (pass-if "n = fixnum-min"
1455 (not (< -1.0 fixnum-min)))
1456
1457 (pass-if "n = fixnum-min - 1"
1458 (not (< -1.0 (- fixnum-min 1)))))
1459
1460 (with-test-prefix "(< fixnum-max n)"
1461
1462 (pass-if "n = 0"
1463 (not (< fixnum-max 0)))
1464
1465 (pass-if "n = 0.0"
1466 (not (< fixnum-max 0.0)))
de142bea
DH		 1467
1468 (pass-if "n = 1"
21e39e8f 1469 (not (< fixnum-max 1)))
de142bea
DH		 1470
1471 (pass-if "n = 1.0"
21e39e8f 1472 (not (< fixnum-max 1.0)))
de142bea
DH		 1473
1474 (pass-if "n = -1"
21e39e8f 1475 (not (< fixnum-max -1)))
de142bea
DH		 1476
1477 (pass-if "n = -1.0"
21e39e8f 1478 (not (< fixnum-max -1.0)))
de142bea 1479
21e39e8f
DH		 1480 (pass-if "n = fixnum-max"
1481 (not (< fixnum-max fixnum-max)))
de142bea 1482
21e39e8f
DH		 1483 (pass-if "n = fixnum-max + 1"
1484 (< fixnum-max (+ fixnum-max 1)))
1485
1486 (pass-if "n = fixnum-min"
1487 (not (< fixnum-max fixnum-min)))
1488
1489 (pass-if "n = fixnum-min - 1"
1490 (not (< fixnum-max (- fixnum-min 1)))))
1491
1492 (with-test-prefix "(< (+ fixnum-max 1) n)"
1493
1494 (pass-if "n = 0"
1495 (not (< (+ fixnum-max 1) 0)))
1496
1497 (pass-if "n = 0.0"
1498 (not (< (+ fixnum-max 1) 0.0)))
de142bea
DH		 1499
1500 (pass-if "n = 1"
21e39e8f 1501 (not (< (+ fixnum-max 1) 1)))
de142bea
DH		 1502
1503 (pass-if "n = 1.0"
21e39e8f 1504 (not (< (+ fixnum-max 1) 1.0)))
de142bea
DH		 1505
1506 (pass-if "n = -1"
21e39e8f 1507 (not (< (+ fixnum-max 1) -1)))
de142bea
DH		 1508
1509 (pass-if "n = -1.0"
21e39e8f 1510 (not (< (+ fixnum-max 1) -1.0)))
de142bea 1511
21e39e8f
DH		 1512 (pass-if "n = fixnum-max"
1513 (not (< (+ fixnum-max 1) fixnum-max)))
de142bea 1514
21e39e8f
DH		 1515 (pass-if "n = fixnum-max + 1"
1516 (not (< (+ fixnum-max 1) (+ fixnum-max 1))))
de142bea 1517
21e39e8f
DH		 1518 (pass-if "n = fixnum-min"
1519 (not (< (+ fixnum-max 1) fixnum-min)))
1520
1521 (pass-if "n = fixnum-min - 1"
1522 (not (< (+ fixnum-max 1) (- fixnum-min 1)))))
1523
1524 (with-test-prefix "(< fixnum-min n)"
1525
1526 (pass-if "n = 0"
1527 (< fixnum-min 0))
1528
1529 (pass-if "n = 0.0"
1530 (< fixnum-min 0.0))
de142bea
DH		 1531
1532 (pass-if "n = 1"
21e39e8f 1533 (< fixnum-min 1))
de142bea
DH		 1534
1535 (pass-if "n = 1.0"
21e39e8f 1536 (< fixnum-min 1.0))
de142bea
DH		 1537
1538 (pass-if "n = -1"
21e39e8f 1539 (< fixnum-min -1))
de142bea
DH		 1540
1541 (pass-if "n = -1.0"
21e39e8f 1542 (< fixnum-min -1.0))
de142bea 1543
21e39e8f
DH		 1544 (pass-if "n = fixnum-max"
1545 (< fixnum-min fixnum-max))
1546
1547 (pass-if "n = fixnum-max + 1"
1548 (< fixnum-min (+ fixnum-max 1)))
de142bea 1549
21e39e8f
DH		 1550 (pass-if "n = fixnum-min"
1551 (not (< fixnum-min fixnum-min)))
de142bea 1552
21e39e8f
DH		 1553 (pass-if "n = fixnum-min - 1"
1554 (not (< fixnum-min (- fixnum-min 1)))))
1555
1556 (with-test-prefix "(< (- fixnum-min 1) n)"
1557
1558 (pass-if "n = 0"
1559 (< (- fixnum-min 1) 0))
1560
1561 (pass-if "n = 0.0"
1562 (< (- fixnum-min 1) 0.0))
1563
1564 (pass-if "n = 1"
1565 (< (- fixnum-min 1) 1))
1566
1567 (pass-if "n = 1.0"
1568 (< (- fixnum-min 1) 1.0))
de142bea
DH		 1569
1570 (pass-if "n = -1"
21e39e8f 1571 (< (- fixnum-min 1) -1))
de142bea
DH		 1572
1573 (pass-if "n = -1.0"
21e39e8f
DH		 1574 (< (- fixnum-min 1) -1.0))
1575
1576 (pass-if "n = fixnum-max"
1577 (< (- fixnum-min 1) fixnum-max))
1578
1579 (pass-if "n = fixnum-max + 1"
1580 (< (- fixnum-min 1) (+ fixnum-max 1)))
1581
1582 (pass-if "n = fixnum-min"
1583 (< (- fixnum-min 1) fixnum-min))
1584
1585 (pass-if "n = fixnum-min - 1"
2cfcaed5
KR		 1586 (not (< (- fixnum-min 1) (- fixnum-min 1)))))
1587
adda36ed
KR		 1588 (pass-if (< (ash 1 256) +inf.0))
1589 (pass-if (not (< +inf.0 (ash 1 256))))
1590 (pass-if (not (< (ash 1 256) -inf.0)))
1591 (pass-if (< -inf.0 (ash 1 256)))
1592
1593 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
1594 ;; sure we've avoided that
1595 (pass-if (< (1- (ash 1 1024)) +inf.0))
1596 (pass-if (< (ash 1 1024) +inf.0))
1597 (pass-if (< (1+ (ash 1 1024)) +inf.0))
1598 (pass-if (not (< +inf.0 (1- (ash 1 1024)))))
1599 (pass-if (not (< +inf.0 (ash 1 1024))))
1600 (pass-if (not (< +inf.0 (1+ (ash 1 1024)))))
1601 (pass-if (< -inf.0 (- (1- (ash 1 1024)))))
1602 (pass-if (< -inf.0 (- (ash 1 1024))))
1603 (pass-if (< -inf.0 (- (1+ (ash 1 1024)))))
1604 (pass-if (not (< (- (1- (ash 1 1024))) -inf.0)))
1605 (pass-if (not (< (- (ash 1 1024)) -inf.0)))
1606 (pass-if (not (< (- (1+ (ash 1 1024))) -inf.0)))
1607
2cfcaed5
KR		 1608 (pass-if (not (< +nan.0 +nan.0)))
1609 (pass-if (not (< 0 +nan.0)))
1610 (pass-if (not (< +nan.0 0)))
1611 (pass-if (not (< 1 +nan.0)))
1612 (pass-if (not (< +nan.0 1)))
1613 (pass-if (not (< -1 +nan.0)))
1614 (pass-if (not (< +nan.0 -1)))
1615
1616 (pass-if (not (< (ash 1 256) +nan.0)))
1617 (pass-if (not (< +nan.0 (ash 1 256))))
1618 (pass-if (not (< (- (ash 1 256)) +nan.0)))
1619 (pass-if (not (< +nan.0 (- (ash 1 256)))))
1620
1621 (pass-if (not (< (ash 1 8192) +nan.0)))
1622 (pass-if (not (< +nan.0 (ash 1 8192))))
1623 (pass-if (not (< (- (ash 1 8192)) +nan.0)))
1624 (pass-if (not (< +nan.0 (- (ash 1 8192)))))
1625
1626 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
1627 ;; sure we've avoided that
1628 (pass-if (not (< (ash 3 1023) +nan.0)))
1629 (pass-if (not (< (1+ (ash 3 1023)) +nan.0)))
1630 (pass-if (not (< (1- (ash 3 1023)) +nan.0)))
1631 (pass-if (not (< +nan.0 (ash 3 1023))))
1632 (pass-if (not (< +nan.0 (1+ (ash 3 1023)))))
1633 (pass-if (not (< +nan.0 (1- (ash 3 1023))))))
f29b3454
DH		 1634
1635;;;
1636;;; >
1637;;;
1638
7c24e528
RB		 1639;; currently not tested -- implementation is trivial
1640;; (> x y) is implemented as (< y x)
1641;; FIXME: tests should probably be added in case we change implementation.
1642
f29b3454
DH		 1643;;;
1644;;; <=
1645;;;
1646
7c24e528
RB		 1647;; currently not tested -- implementation is trivial
1648;; (<= x y) is implemented as (not (< y x))
1649;; FIXME: tests should probably be added in case we change implementation.
1650
f29b3454
DH		 1651;;;
1652;;; >=
1653;;;
1654
7c24e528
RB		 1655;; currently not tested -- implementation is trivial
1656;; (>= x y) is implemented as (not (< x y))
1657;; FIXME: tests should probably be added in case we change implementation.
1658
f29b3454
DH		 1659;;;
1660;;; zero?
1661;;;
1662
7c24e528
RB		 1663(with-test-prefix "zero?"
1664 (expect-fail (documented? zero?))
1665 (pass-if (zero? 0))
4d332f19
DH		 1666 (pass-if (not (zero? 7)))
1667 (pass-if (not (zero? -7)))
1668 (pass-if (not (zero? (+ 1 fixnum-max))))
1669 (pass-if (not (zero? (- 1 fixnum-min))))
1670 (pass-if (not (zero? 1.3)))
1671 (pass-if (not (zero? 3.1+4.2i))))
7c24e528 1672
f29b3454
DH		 1673;;;
1674;;; positive?
1675;;;
1676
7c24e528
RB		 1677(with-test-prefix "positive?"
1678 (expect-fail (documented? positive?))
1679 (pass-if (positive? 1))
1680 (pass-if (positive? (+ fixnum-max 1)))
1681 (pass-if (positive? 1.3))
4d332f19
DH		 1682 (pass-if (not (positive? 0)))
1683 (pass-if (not (positive? -1)))
1684 (pass-if (not (positive? (- fixnum-min 1))))
1685 (pass-if (not (positive? -1.3))))
7c24e528 1686
f29b3454
DH		 1687;;;
1688;;; negative?
1689;;;
1690
7c24e528
RB		 1691(with-test-prefix "negative?"
1692 (expect-fail (documented? negative?))
4d332f19
DH		 1693 (pass-if (not (negative? 1)))
1694 (pass-if (not (negative? (+ fixnum-max 1))))
1695 (pass-if (not (negative? 1.3)))
1696 (pass-if (not (negative? 0)))
7c24e528
RB		 1697 (pass-if (negative? -1))
1698 (pass-if (negative? (- fixnum-min 1)))
1699 (pass-if (negative? -1.3)))
1700
f29b3454
DH		 1701;;;
1702;;; max
1703;;;
1704
adda36ed 1705(with-test-prefix "max"
501da403
KR		 1706 (pass-if (= 456.0 (max 123.0 456.0)))
1707 (pass-if (= 456.0 (max 456.0 123.0)))
1708
adda36ed
KR		 1709 (let ((big*2 (* fixnum-max 2))
1710 (big*3 (* fixnum-max 3))
1711 (big*4 (* fixnum-max 4))
1712 (big*5 (* fixnum-max 5)))
1713
1714 (pass-if (= +inf.0 (max big*5 +inf.0)))
1715 (pass-if (= +inf.0 (max +inf.0 big*5)))
1716 (pass-if (= big*5 (max big*5 -inf.0)))
501da403
KR		 1717 (pass-if (= big*5 (max -inf.0 big*5)))
1718
1719 (pass-if (nan? (max 123 +nan.0)))
1720 (pass-if (nan? (max big*5 +nan.0)))
1721 (pass-if (nan? (max 123.0 +nan.0)))
1722 (pass-if (nan? (max +nan.0 123)))
1723 (pass-if (nan? (max +nan.0 big*5)))
1724 (pass-if (nan? (max +nan.0 123.0)))
1725 (pass-if (nan? (max +nan.0 +nan.0))))
adda36ed
KR		 1726
1727 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
1728 ;; sure we've avoided that
1729 (for-each (lambda (b)
1730 (pass-if (list b +inf.0)
1731 (= +inf.0 (max b +inf.0)))
1732 (pass-if (list +inf.0 b)
1733 (= +inf.0 (max b +inf.0)))
1734 (pass-if (list b -inf.0)
1735 (= b (max b -inf.0)))
1736 (pass-if (list -inf.0 b)
1737 (= b (max b -inf.0))))
1738 (list (1- (ash 1 1024))
1739 (ash 1 1024)
1740 (1+ (ash 1 1024))
1741 (- (1- (ash 1 1024)))
1742 (- (ash 1 1024))
501da403
KR		 1743 (- (1+ (ash 1 1024)))))
1744
1745 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
1746 ;; sure we've avoided that
1747 (pass-if (nan? (max (ash 1 2048) +nan.0)))
1748 (pass-if (nan? (max +nan.0 (ash 1 2048)))))
adda36ed 1749
f29b3454
DH		 1750;;;
1751;;; min
1752;;;
1753
7c24e528
RB		 1754;; FIXME: unfinished...
1755
1756(with-test-prefix "min"
501da403
KR		 1757 (pass-if (= 123.0 (min 123.0 456.0)))
1758 (pass-if (= 123.0 (min 456.0 123.0)))
1759
7c24e528
RB		 1760 (let ((big*2 (* fixnum-max 2))
1761 (big*3 (* fixnum-max 3))
1762 (big*4 (* fixnum-max 4))
1763 (big*5 (* fixnum-max 5)))
1764
1765 (expect-fail (documented? max))
1766 (pass-if (= 1 (min 7 3 1 5)))
1767 (pass-if (= 1 (min 1 7 3 5)))
1768 (pass-if (= 1 (min 7 3 5 1)))
1769 (pass-if (= -7 (min 2 3 4 -2 5 -7 1 -1 4 2)))
1770 (pass-if (= -7 (min -7 2 3 4 -2 5 1 -1 4 2)))
1771 (pass-if (= -7 (min 2 3 4 -2 5 1 -1 4 2 -7)))
1772 (pass-if (= big*2 (min big*3 big*5 big*2 big*4)))
1773 (pass-if (= big*2 (min big*2 big*3 big*5 big*4)))
1774 (pass-if (= big*2 (min big*3 big*5 big*4 big*2)))
1775 (pass-if
1776 (= (- fixnum-min 1) (min 2 4 (- fixnum-min 1) 3 (* 2 fixnum-max))))
1777 (pass-if
1778 (= (- fixnum-min 1) (min (- fixnum-min 1) 2 4 3 (* 2 fixnum-max))))
1779 (pass-if
adda36ed 1780 (= (- fixnum-min 1) (min 2 4 3 (* 2 fixnum-max) (- fixnum-min 1))))
7c24e528 1781
adda36ed
KR		 1782 (pass-if (= big*5 (min big*5 +inf.0)))
1783 (pass-if (= big*5 (min +inf.0 big*5)))
1784 (pass-if (= -inf.0 (min big*5 -inf.0)))
501da403
KR		 1785 (pass-if (= -inf.0 (min -inf.0 big*5)))
1786
1787 (pass-if (nan? (min 123 +nan.0)))
1788 (pass-if (nan? (min big*5 +nan.0)))
1789 (pass-if (nan? (min 123.0 +nan.0)))
1790 (pass-if (nan? (min +nan.0 123)))
1791 (pass-if (nan? (min +nan.0 big*5)))
1792 (pass-if (nan? (min +nan.0 123.0)))
1793 (pass-if (nan? (min +nan.0 +nan.0))))
adda36ed
KR		 1794
1795 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
1796 ;; sure we've avoided that
1797 (for-each (lambda (b)
1798 (pass-if (list b +inf.0)
1799 (= b (min b +inf.0)))
1800 (pass-if (list +inf.0 b)
1801 (= b (min b +inf.0)))
1802 (pass-if (list b -inf.0)
1803 (= -inf.0 (min b -inf.0)))
1804 (pass-if (list -inf.0 b)
1805 (= -inf.0 (min b -inf.0))))
1806 (list (1- (ash 1 1024))
1807 (ash 1 1024)
1808 (1+ (ash 1 1024))
1809 (- (1- (ash 1 1024)))
1810 (- (ash 1 1024))
501da403
KR		 1811 (- (1+ (ash 1 1024)))))
1812
1813 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
1814 ;; sure we've avoided that
1815 (pass-if (nan? (min (- (ash 1 2048)) (- +nan.0))))
1816 (pass-if (nan? (min (- +nan.0) (- (ash 1 2048))))))
adda36ed 1817
f29b3454
DH		 1818;;;
1819;;; +
1820;;;
1821
1822(with-test-prefix "+"
1823
1824 (expect-fail "documented?"
1825 (documented? +))
1826
1827 (with-test-prefix "wrong type argument"
1828
1829 (pass-if-exception "1st argument string"
1830 exception:wrong-type-arg
1831 (+ "1" 2))
1832
1833 (pass-if-exception "2nd argument bool"
1834 exception:wrong-type-arg
1835 (+ 1 #f))))
1836;;;
1837;;; -
1838;;;
1839
072e6de2
KR		 1840(with-test-prefix "-"
1841
1842 (pass-if "-inum - +bignum"
1843 (= #x-100000000000000000000000000000001
ef016629
KR		 1844 (- -1 #x100000000000000000000000000000000)))
1845
1846 (pass-if "big - inum"
1847 (= #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
1848 (- #x100000000000000000000000000000000 1)))
1849
1850 (pass-if "big - -inum"
1851 (= #x100000000000000000000000000000001
1852 (- #x100000000000000000000000000000000 -1))))
072e6de2 1853
f29b3454
DH		 1854;;;
1855;;; *
1856;;;
1857
65ea251e
KR		 1858(with-test-prefix "*"
1859
1860 (pass-if "complex * bignum"
1861 (let ((big (ash 1 90)))
1862 (= (make-rectangular big big)
1863 (* 1+1i big)))))
1864
f29b3454
DH		 1865;;;
1866;;; /
1867;;;
1868
1b3a7932
DH		 1869(with-test-prefix "/"
1870
1871 (expect-fail "documented?"
1872 (documented? /))
1873
1874 (with-test-prefix "division by zero"
1875
1876 (pass-if-exception "(/ 0)"
1877 exception:numerical-overflow
1878 (/ 0))
1879
cdf52e3d
MV		 1880 (pass-if "(/ 0.0)"
1881 (= +inf.0 (/ 0.0)))
80074d77 1882
1b3a7932
DH		 1883 (pass-if-exception "(/ 1 0)"
1884 exception:numerical-overflow
80074d77
DH		 1885 (/ 1 0))
1886
cdf52e3d
MV		 1887 (pass-if "(/ 1 0.0)"
1888 (= +inf.0 (/ 1 0.0)))
80074d77
DH		 1889
1890 (pass-if-exception "(/ bignum 0)"
1891 exception:numerical-overflow
1892 (/ (+ fixnum-max 1) 0))
1893
cdf52e3d
MV		 1894 (pass-if "(/ bignum 0.0)"
1895 (= +inf.0 (/ (+ fixnum-max 1) 0.0)))
80074d77
DH		 1896
1897 (pass-if-exception "(/ 1.0 0)"
1898 exception:numerical-overflow
1899 (/ 1.0 0))
1900
cdf52e3d
MV		 1901 (pass-if "(/ 1.0 0.0)"
1902 (= +inf.0 (/ 1.0 0.0)))
80074d77
DH		 1903
1904 (pass-if-exception "(/ +i 0)"
1905 exception:numerical-overflow
1906 (/ +i 0))
1907
cdf52e3d
MV		 1908 (pass-if "(/ +i 0.0)"
1909 (= +inf.0 (imag-part (/ +i 0.0)))))
469b963c
MV		 1910
1911 (with-test-prefix "complex division"
1912
1913 (pass-if "(/ 3+4i)"
1914 (= (/ 3+4i) 0.12-0.16i))
1915
1916 (pass-if "(/ 4+3i)"
1917 (= (/ 4+3i) 0.16-0.12i))
1918
1919 (pass-if "(/ 25+125i 3+4i)"
1920 (= (/ 25+125i 3+4i) 23.0+11.0i))
1921
1922 (pass-if "(/ 25+125i 4+3i)"
1923 (= (/ 25+125i 4+3i) 19.0+17.0i))
1924
1925 (pass-if "(/ 25 3+4i)"
1926 (= (/ 25 3+4i) 3.0-4.0i))
1927
1928 (pass-if "(/ 25 4+3i)"
1929 (= (/ 25 4+3i) 4.0-3.0i))
1930
1931 (pass-if "(/ 1e200+1e200i)"
1932 (= (/ 1e200+1e200i) 5.0e-201-5.0e-201i))))
1b3a7932 1933
f29b3454
DH		 1934;;;
1935;;; truncate
1936;;;
1937
14a6784c
KR		 1938(with-test-prefix "truncate"
1939 (pass-if (= 1 (truncate 1.75)))
1940 (pass-if (= 1 (truncate 1.5)))
1941 (pass-if (= 1 (truncate 1.25)))
1942 (pass-if (= 0 (truncate 0.75)))
1943 (pass-if (= 0 (truncate 0.5)))
1944 (pass-if (= 0 (truncate 0.0)))
1945 (pass-if (= 0 (truncate -0.5)))
1946 (pass-if (= -1 (truncate -1.25)))
1947 (pass-if (= -1 (truncate -1.5))))
1948
f29b3454
DH		 1949;;;
1950;;; round
1951;;;
1952
14a6784c
KR		 1953(with-test-prefix "round"
1954 (pass-if (= 2 (round 1.75)))
1955 (pass-if (= 2 (round 1.5)))
1956 (pass-if (= 1 (round 1.25)))
1957 (pass-if (= 1 (round 0.75)))
1958 (pass-if (= 0 (round 0.5)))
1959 (pass-if (= 0 (round 0.0)))
1960 (pass-if (= 0 (round -0.5)))
1961 (pass-if (= -1 (round -1.25)))
1962 (pass-if (= -2 (round -1.5))))
1963
f29b3454
DH		 1964;;;
1965;;; exact->inexact
1966;;;
1967
1968;;;
1969;;; floor
1970;;;
1971
1972;;;
1973;;; ceiling
1974;;;
1975
46f2c0f1
RB		 1976;;;
1977;;; expt
1978;;;
1979
1980(with-test-prefix "expt"
1981 (pass-if "(= 1 (expt 0 0))" (= 1 (expt 0 0)))
1982 (pass-if "(= 1 (expt 0 0.0))" (= 1 (expt 0 0.0)))
1983 (pass-if "(= 1 (expt 0.0 0))" (= 1 (expt 0.0 0)))
1984 (pass-if "(= 1 (expt 0.0 0.0))" (= 1 (expt 0.0 0.0))))
1985
14a6784c
KR		 1986;;;
1987;;; asinh
1988;;;
1989
1990(with-test-prefix "asinh"
1991 (pass-if (= 0 (asinh 0))))
1992
1993;;;
1994;;; acosh
1995;;;
1996
1997(with-test-prefix "acosh"
1998 (pass-if (= 0 (acosh 1))))
1999
2000;;;
2001;;; atanh
2002;;;
2003
2004(with-test-prefix "atanh"
2005 (pass-if (= 0 (atanh 0))))
2006
f29b3454
DH		 2007;;;
2008;;; make-rectangular
2009;;;
2010
2011;;;
2012;;; make-polar
2013;;;
2014
d40681ec
KR		 2015(with-test-prefix "make-polar"
2016 (define pi 3.14159265358979323846)
2017 (define (almost= x y)
2018 (> 0.01 (magnitude (- x y))))
2019
2020 (pass-if (= 0 (make-polar 0 0)))
2021 (pass-if (= 0 (make-polar 0 123.456)))
2022 (pass-if (= 1 (make-polar 1 0)))
2023 (pass-if (= -1 (make-polar -1 0)))
2024
2025 (pass-if (almost= 0+i (make-polar 1 (* 0.5 pi))))
2026 (pass-if (almost= -1 (make-polar 1 (* 1.0 pi))))
2027 (pass-if (almost= 0-i (make-polar 1 (* 1.5 pi))))
2028 (pass-if (almost= 1 (make-polar 1 (* 2.0 pi)))))
2029
f29b3454
DH		 2030;;;
2031;;; real-part
2032;;;
2033
2034;;;
2035;;; imag-part
2036;;;
2037
2038;;;
2039;;; magnitude
2040;;;
2041
d40681ec
KR		 2042(with-test-prefix "magnitude"
2043 (pass-if (= 0 (magnitude 0)))
2044 (pass-if (= 1 (magnitude 1)))
2045 (pass-if (= 1 (magnitude -1)))
2046 (pass-if (= 1 (magnitude 0+i)))
2047 (pass-if (= 1 (magnitude 0-i)))
2048 (pass-if (= 5 (magnitude 3+4i)))
2049 (pass-if (= 5 (magnitude 3-4i)))
2050 (pass-if (= 5 (magnitude -3+4i)))
2051 (pass-if (= 5 (magnitude -3-4i))))
2052
f29b3454
DH		 2053;;;
2054;;; angle
2055;;;
2056
cfc9fc1c
KR		 2057(with-test-prefix "angle"
2058 (define pi 3.14159265358979323846)
2059 (define (almost= x y)
2060 (> 0.01 (magnitude (- x y))))
2061
2062 (pass-if "inum +ve" (= 0 (angle 1)))
2063 (pass-if "inum -ve" (almost= pi (angle -1)))
2064
2065 (pass-if "bignum +ve" (= 0 (angle (1+ fixnum-max))))
2066 (pass-if "bignum -ve" (almost= pi (angle (1- fixnum-min))))
2067
2068 (pass-if "flonum +ve" (= 0 (angle 1.5)))
2069 (pass-if "flonum -ve" (almost= pi (angle -1.5))))
2070
f29b3454
DH		 2071;;;
2072;;; inexact->exact
2073;;;
300c6a76 2074
1259cb26
KR		 2075(with-test-prefix "inexact->exact"
2076
2077 (pass-if-exception exception:numerical-overflow "+inf"
2078 (inexact->exact +.inf))
2079
2080 (pass-if-exception exception:numerical-overflow "-inf"
2081 (inexact->exact -.inf))
2082
2083 (pass-if-exception exception:numerical-overflow "nan"
2084 (inexact->exact +.nan))
2085
2086 (with-test-prefix "2.0**i to exact and back"
2087 (do ((i 0 (1+ i))
2088 (n 1.0 (* 2.0 n)))
2089 ((> i 100))
2090 (pass-if (list i n)
2091 (= n (inexact->exact (exact->inexact n)))))))
2092
a04a3604
KR		 2093;;;
2094;;; integer-length
2095;;;
2096
2097(with-test-prefix "integer-length"
2098
2099 (with-test-prefix "-2^i, ...11100..00"
2100 (do ((n -1 (ash n 1))
2101 (i 0 (1+ i)))
2102 ((> i 256))
2103 (pass-if (list n "expect" i)
2104 (= i (integer-length n)))))
2105
2106 (with-test-prefix "-2^i+1 ...11100..01"
2107 (do ((n -3 (logxor 3 (ash n 1)))
2108 (i 2 (1+ i)))
2109 ((> i 256))
2110 (pass-if n
2111 (= i (integer-length n)))))
2112
2113 (with-test-prefix "-2^i-1 ...111011..11"
2114 (do ((n -2 (1+ (ash n 1)))
2115 (i 1 (1+ i)))
2116 ((> i 256))
2117 (pass-if n
2118 (= i (integer-length n))))))
2119
300c6a76
KR		 2120;;;
2121;;; logcount
2122;;;
2123
2124(with-test-prefix "logcount"
2125
2126 (with-test-prefix "-2^i, meaning ...11100..00"
2127 (do ((n -1 (ash n 1))
2128 (i 0 (1+ i)))
2129 ((> i 256))
795c0bae
KR		 2130 (pass-if n
2131 (= i (logcount n)))))
2132
2133 (with-test-prefix "2^i"
2134 (do ((n 1 (ash n 1))
2135 (i 0 (1+ i)))
2136 ((> i 256))
2137 (pass-if n
2138 (= 1 (logcount n)))))
2139
2140 (with-test-prefix "2^i-1"
2141 (do ((n 0 (1+ (ash n 1)))
2142 (i 0 (1+ i)))
2143 ((> i 256))
300c6a76
KR		 2144 (pass-if n
2145 (= i (logcount n))))))
795c0bae 2146
1ec2dd6f
KR		 2147;;;
2148;;; lognot
2149;;;
2150
2151(with-test-prefix "lognot"
2152 (pass-if (= -1 (lognot 0)))
2153 (pass-if (= 0 (lognot -1)))
2154 (pass-if (= -2 (lognot 1)))
2155 (pass-if (= 1 (lognot -2)))
2156
2157 (pass-if (= #x-100000000000000000000000000000000
2158 (lognot #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)))
2159 (pass-if (= #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
2160 (lognot #x-100000000000000000000000000000000))))
Unnamed repository; edit this file 'description' to name the repository.