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