test-suite/tests/numbers.test

   1 ;;;; numbers.test --- tests guile's numbers     -*- scheme -*-
   2 ;;;; Copyright (C) 2000, 2001, 2003 Free Software Foundation, Inc.
   3 ;;;;
   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,
  10 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  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
  17
  18 (define-module (test-suite test-numbers)
  19   #:use-module (test-suite lib)
  20   #:use-module (ice-9 documentation))
  21
  22 ;;;
  23 ;;; miscellaneous
  24 ;;;
  25
  26 (define exception:numerical-overflow
  27   (cons 'numerical-overflow "^Numerical overflow"))
  28
  29 (define (documented? object)
  30   (not (not (object-documentation object))))
  31
  32 (define fixnum-bit
  33   (inexact->exact (+ (/ (log (+ most-positive-fixnum 1)) (log 2)) 1)))
  34
  35 (define fixnum-min most-negative-fixnum)
  36 (define fixnum-max most-positive-fixnum)
  37
  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
  68 ;;;
  69 ;;; exact?
  70 ;;;
  71
  72 (with-test-prefix "exact?"
  73
  74   (pass-if "documented?"
  75     (documented? exact?))
  76
  77   (with-test-prefix "integers"
  78
  79     (pass-if "0"
  80       (exact? 0))
  81
  82     (pass-if "fixnum-max"
  83       (exact? fixnum-max))
  84
  85     (pass-if "fixnum-max + 1"
  86       (exact? (+ fixnum-max 1)))
  87
  88     (pass-if "fixnum-min"
  89       (exact? fixnum-min))
  90
  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)))))))
 103
 104 ;;;
 105 ;;; odd?
 106 ;;;
 107
 108 (with-test-prefix "odd?"
 109   (pass-if (documented? odd?))
 110   (pass-if (odd? 1))
 111   (pass-if (odd? -1))
 112   (pass-if (not (odd? 0)))
 113   (pass-if (not (odd? 2)))
 114   (pass-if (not (odd? -2)))
 115   (pass-if (odd? (+ (* 2 fixnum-max) 1)))
 116   (pass-if (not (odd? (* 2 fixnum-max))))
 117   (pass-if (odd? (- (* 2 fixnum-min) 1)))
 118   (pass-if (not (odd? (* 2 fixnum-min)))))
 119
 120 ;;;
 121 ;;; even?
 122 ;;;
 123
 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))
 129   (pass-if (not (even? 1)))
 130   (pass-if (not (even? -1)))
 131   (pass-if (not (even? (+ (* 2 fixnum-max) 1))))
 132   (pass-if (even? (* 2 fixnum-max)))
 133   (pass-if (not (even? (- (* 2 fixnum-min) 1))))
 134   (pass-if (even? (* 2 fixnum-min))))
 135
 136 ;;;
 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))
 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)))))
 150
 151 ;;;
 152 ;;; nan? and nan
 153 ;;;
 154
 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?
 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)))))
 163
 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))))
 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
 182 ;;;
 183 ;;; quotient
 184 ;;;
 185
 186 (with-test-prefix "quotient"
 187
 188   (expect-fail "documented?"
 189     (documented? quotient))
 190
 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
 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)))))
 213
 214   (with-test-prefix "1 / n"
 215
 216     (pass-if "n = 1"
 217       (eqv? 1 (quotient 1 1)))
 218
 219     (pass-if "n = -1"
 220       (eqv? -1 (quotient 1 -1)))
 221
 222     (pass-if "n = 2"
 223       (eqv? 0 (quotient 1 2)))
 224
 225     (pass-if "n = fixnum-max"
 226       (eqv? 0 (quotient 1 fixnum-max)))
 227
 228     (pass-if "n = fixnum-max + 1"
 229       (eqv? 0 (quotient 1 (+ fixnum-max 1))))
 230
 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"
 238
 239     (pass-if "n = 1"
 240       (eqv? -1 (quotient -1 1)))
 241
 242     (pass-if "n = -1"
 243       (eqv? 1 (quotient -1 -1)))
 244
 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)))))
 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
 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
 384   ;; Are wrong type arguments detected correctly?
 385
 386   )
 387
 388 ;;;
 389 ;;; remainder
 390 ;;;
 391
 392 (with-test-prefix "remainder"
 393
 394   (expect-fail "documented?"
 395     (documented? remainder))
 396
 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
 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)))
 413
 414     (pass-if "n = fixnum-min - 1"
 415       (eqv? 0 (remainder 0 (- fixnum-min 1)))))
 416
 417   (with-test-prefix "1 / n"
 418
 419     (pass-if "n = 1"
 420       (eqv? 0 (remainder 1 1)))
 421
 422     (pass-if "n = -1"
 423       (eqv? 0 (remainder 1 -1)))
 424
 425     (pass-if "n = fixnum-max"
 426       (eqv? 1 (remainder 1 fixnum-max)))
 427
 428     (pass-if "n = fixnum-max + 1"
 429       (eqv? 1 (remainder 1 (+ fixnum-max 1))))
 430
 431     (pass-if "n = fixnum-min"
 432       (eqv? 1 (remainder 1 fixnum-min)))
 433
 434     (pass-if "n = fixnum-min - 1"
 435       (eqv? 1 (remainder 1 (- fixnum-min 1)))))
 436
 437   (with-test-prefix "-1 / n"
 438
 439     (pass-if "n = 1"
 440       (eqv? 0 (remainder -1 1)))
 441
 442     (pass-if "n = -1"
 443       (eqv? 0 (remainder -1 -1)))
 444
 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)))))
 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
 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
 569   ;; Are wrong type arguments detected correctly?
 570
 571   )
 572
 573 ;;;
 574 ;;; modulo
 575 ;;;
 576
 577 (with-test-prefix "modulo"
 578
 579   (expect-fail "documented?"
 580     (documented? modulo))
 581
 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
 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))))
 595
 596     (pass-if "n = fixnum-min"
 597       (eqv? 0 (modulo 0 fixnum-min)))
 598
 599     (pass-if "n = fixnum-min - 1"
 600       (eqv? 0 (modulo 0 (- fixnum-min 1)))))
 601
 602   (with-test-prefix "1 % n"
 603
 604     (pass-if "n = 1"
 605       (eqv? 0 (modulo 1 1)))
 606
 607     (pass-if "n = -1"
 608       (eqv? 0 (modulo 1 -1)))
 609
 610     (pass-if "n = fixnum-max"
 611       (eqv? 1 (modulo 1 fixnum-max)))
 612
 613     (pass-if "n = fixnum-max + 1"
 614       (eqv? 1 (modulo 1 (+ fixnum-max 1))))
 615
 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"
 623
 624     (pass-if "n = 1"
 625       (eqv? 0 (modulo -1 1)))
 626
 627     (pass-if "n = -1"
 628       (eqv? 0 (modulo -1 -1)))
 629
 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)))))
 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
 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
 766   ;; Are wrong type arguments detected correctly?
 767
 768   )
 769
 770 ;;;
 771 ;;; gcd
 772 ;;;
 773
 774 (with-test-prefix "gcd"
 775
 776   (expect-fail "documented?"
 777     (documented? gcd))
 778
 779   (with-test-prefix "(0 n)"
 780
 781     (pass-if "n = 0"
 782       (eqv? 0 (gcd 0 0)))
 783
 784     (pass-if "n = 1"
 785       (eqv? 1 (gcd 0 1)))
 786
 787     (pass-if "n = -1"
 788       (eqv? 1 (gcd 0 -1)))
 789
 790     (pass-if "n = fixnum-max"
 791       (eqv? fixnum-max (gcd 0 fixnum-max)))
 792
 793     (pass-if "n = fixnum-max + 1"
 794       (eqv? (+ fixnum-max 1) (gcd 0 (+ fixnum-max 1))))
 795
 796     (pass-if "n = fixnum-min"
 797       (eqv? (- fixnum-min) (gcd 0 fixnum-min)))
 798
 799     (pass-if "n = fixnum-min - 1"
 800       (eqv? (- (- fixnum-min 1)) (gcd 0 (- fixnum-min 1)))))
 801
 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
 807   (with-test-prefix "(1 n)"
 808
 809     (pass-if "n = 0"
 810       (eqv? 1 (gcd 1 0)))
 811
 812     (pass-if "n = 1"
 813       (eqv? 1 (gcd 1 1)))
 814
 815     (pass-if "n = -1"
 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"
 833       (eqv? 1 (gcd -1 0)))
 834
 835     (pass-if "n = 1"
 836       (eqv? 1 (gcd -1 1)))
 837
 838     (pass-if "n = -1"
 839       (eqv? 1 (gcd -1 -1)))
 840
 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)))
 857
 858     (pass-if "n = 1"
 859       (eqv? 1 (gcd fixnum-max 1)))
 860
 861     (pass-if "n = -1"
 862       (eqv? 1 (gcd fixnum-max -1)))
 863
 864     (pass-if "n = fixnum-max"
 865       (eqv? fixnum-max (gcd fixnum-max fixnum-max)))
 866
 867     (pass-if "n = fixnum-max + 1"
 868       (eqv? 1 (gcd fixnum-max (+ fixnum-max 1))))
 869
 870     (pass-if "n = fixnum-min"
 871       (eqv? 1 (gcd fixnum-max fixnum-min)))
 872
 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)))
 883
 884     (pass-if "n = -1"
 885       (eqv? 1 (gcd (+ fixnum-max 1) -1)))
 886
 887     (pass-if "n = fixnum-max"
 888       (eqv? 1 (gcd (+ fixnum-max 1) fixnum-max)))
 889
 890     (pass-if "n = fixnum-max + 1"
 891       (eqv? (+ fixnum-max 1) (gcd (+ fixnum-max 1) (+ fixnum-max 1))))
 892
 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)))
 906
 907     (pass-if "n = -1"
 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))))
 915
 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)))))
 944
 945   ;; Are wrong type arguments detected correctly?
 946
 947   )
 948
 949 ;;;
 950 ;;; lcm
 951 ;;;
 952
 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
 964 ;;;
 965 ;;; number->string
 966 ;;;
 967
 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
 981 ;;;
 982 ;;; string->number
 983 ;;;
 984
 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)))
 992               '("" "q" "1q" "6+7iq" "8+9q" "10+11" "13+" "18@19q" "20@q" "23@"
 993                 "+25iq" "26i" "-q" "-iq" "i" "5#.0" "8/" "10#11" ".#" "."
 994                 "#o.2" "3.4q" "15.16e17q" "18.19e+q" ".q" ".17#18" "10q" "#b2"
 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
1000   (pass-if "valid number strings"
1001     (for-each (lambda (couple)
1002                 (apply
1003                  (lambda (x y)
1004                    (let ((xx (string->number x)))
1005                      (if (or (eq? xx #f) (not (eqv? xx y)))
1006                          (begin
1007                            (pk x y)
1008                            (throw 'fail)))))
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:
1026                 ("#e1" 1) ("#e1.2" 12/10)
1027                 ("#i1.1" 1.1) ("#i1" 1.0)
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)
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)
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
1057   (pass-if-exception "exponent too big"
1058     exception:out-of-range
1059     (string->number "12.13e141414")))
1060
1061 ;;;
1062 ;;; number?
1063 ;;;
1064
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))
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)))))
1081
1082 ;;;
1083 ;;; complex?
1084 ;;;
1085
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))
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)))))
1102
1103 ;;;
1104 ;;; real?
1105 ;;;
1106
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))
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)))))
1123
1124 ;;;
1125 ;;; rational? (same as real? right now)
1126 ;;;
1127
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))
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)))))
1144
1145 ;;;
1146 ;;; integer?
1147 ;;;
1148
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)))
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)))))
1167
1168 ;;;
1169 ;;; inexact?
1170 ;;;
1171
1172 (with-test-prefix "inexact?"
1173   (pass-if (documented? inexact?))
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))))
1179   (pass-if (inexact? 1.3))
1180   (pass-if (inexact? 3.1+4.2i))
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)))))
1202
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
1258 ;;;
1259 ;;; =
1260 ;;;
1261
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)))
1268   (pass-if (= (- fixnum-min 1) (- fixnum-min 1)))
1269   (pass-if (not (= 0 1)))
1270   (pass-if (not (= fixnum-max (+ 1 fixnum-max))))
1271   (pass-if (not (= (+ 1 fixnum-max) fixnum-max)))
1272   (pass-if (not (= (+ 1 fixnum-max) (+ 2 fixnum-max))))
1273   (pass-if (not (= fixnum-min (- fixnum-min 1))))
1274   (pass-if (not (= (- fixnum-min 1) fixnum-min)))
1275   (pass-if (not (= (- fixnum-min 1) (- fixnum-min 2))))
1276   (pass-if (not (= (+ fixnum-max 1) (- fixnum-min 1))))
1277
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
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)))
1311   (pass-if (not (= +nan.0 (ash 3 1023)))))
1312
1313 ;;;
1314 ;;; <
1315 ;;;
1316
1317 (with-test-prefix "<"
1318
1319   (expect-fail "documented?"
1320     (documented? <))
1321
1322   (with-test-prefix "(< 0 n)"
1323
1324     (pass-if "n = 0"
1325       (not (< 0 0)))
1326
1327     (pass-if "n = 0.0"
1328       (not (< 0 0.0)))
1329
1330     (pass-if "n = 1"
1331       (< 0 1))
1332
1333     (pass-if "n = 1.0"
1334       (< 0 1.0))
1335
1336     (pass-if "n = -1"
1337       (not (< 0 -1)))
1338
1339     (pass-if "n = -1.0"
1340       (not (< 0 -1.0)))
1341
1342     (pass-if "n = fixnum-max"
1343       (< 0 fixnum-max))
1344
1345     (pass-if "n = fixnum-max + 1"
1346       (< 0 (+ fixnum-max 1)))
1347
1348     (pass-if "n = fixnum-min"
1349       (not (< 0 fixnum-min)))
1350
1351     (pass-if "n = fixnum-min - 1"
1352       (not (< 0 (- fixnum-min 1)))))
1353
1354   (with-test-prefix "(< 0.0 n)"
1355
1356     (pass-if "n = 0"
1357       (not (< 0.0 0)))
1358
1359     (pass-if "n = 0.0"
1360       (not (< 0.0 0.0)))
1361
1362     (pass-if "n = 1"
1363       (< 0.0 1))
1364
1365     (pass-if "n = 1.0"
1366       (< 0.0 1.0))
1367
1368     (pass-if "n = -1"
1369       (not (< 0.0 -1)))
1370
1371     (pass-if "n = -1.0"
1372       (not (< 0.0 -1.0)))
1373
1374     (pass-if "n = fixnum-max"
1375       (< 0.0 fixnum-max))
1376
1377     (pass-if "n = fixnum-max + 1"
1378       (< 0.0 (+ fixnum-max 1)))
1379
1380     (pass-if "n = fixnum-min"
1381       (not (< 0.0 fixnum-min)))
1382
1383     (pass-if "n = fixnum-min - 1"
1384       (not (< 0.0 (- fixnum-min 1)))))
1385
1386   (with-test-prefix "(< 1 n)"
1387
1388     (pass-if "n = 0"
1389       (not (< 1 0)))
1390
1391     (pass-if "n = 0.0"
1392       (not (< 1 0.0)))
1393
1394     (pass-if "n = 1"
1395       (not (< 1 1)))
1396
1397     (pass-if "n = 1.0"
1398       (not (< 1 1.0)))
1399
1400     (pass-if "n = -1"
1401       (not (< 1 -1)))
1402
1403     (pass-if "n = -1.0"
1404       (not (< 1 -1.0)))
1405
1406     (pass-if "n = fixnum-max"
1407       (< 1 fixnum-max))
1408
1409     (pass-if "n = fixnum-max + 1"
1410       (< 1 (+ fixnum-max 1)))
1411
1412     (pass-if "n = fixnum-min"
1413       (not (< 1 fixnum-min)))
1414
1415     (pass-if "n = fixnum-min - 1"
1416       (not (< 1 (- fixnum-min 1)))))
1417
1418   (with-test-prefix "(< 1.0 n)"
1419
1420     (pass-if "n = 0"
1421       (not (< 1.0 0)))
1422
1423     (pass-if "n = 0.0"
1424       (not (< 1.0 0.0)))
1425
1426     (pass-if "n = 1"
1427       (not (< 1.0 1)))
1428
1429     (pass-if "n = 1.0"
1430       (not (< 1.0 1.0)))
1431
1432     (pass-if "n = -1"
1433       (not (< 1.0 -1)))
1434
1435     (pass-if "n = -1.0"
1436       (not (< 1.0 -1.0)))
1437
1438     (pass-if "n = fixnum-max"
1439       (< 1.0 fixnum-max))
1440
1441     (pass-if "n = fixnum-max + 1"
1442       (< 1.0 (+ fixnum-max 1)))
1443
1444     (pass-if "n = fixnum-min"
1445       (not (< 1.0 fixnum-min)))
1446
1447     (pass-if "n = fixnum-min - 1"
1448       (not (< 1.0 (- fixnum-min 1)))))
1449
1450   (with-test-prefix "(< -1 n)"
1451
1452     (pass-if "n = 0"
1453       (< -1 0))
1454
1455     (pass-if "n = 0.0"
1456       (< -1 0.0))
1457
1458     (pass-if "n = 1"
1459       (< -1 1))
1460
1461     (pass-if "n = 1.0"
1462       (< -1 1.0))
1463
1464     (pass-if "n = -1"
1465       (not (< -1 -1)))
1466
1467     (pass-if "n = -1.0"
1468       (not (< -1 -1.0)))
1469
1470     (pass-if "n = fixnum-max"
1471       (< -1 fixnum-max))
1472
1473     (pass-if "n = fixnum-max + 1"
1474       (< -1 (+ fixnum-max 1)))
1475
1476     (pass-if "n = fixnum-min"
1477       (not (< -1 fixnum-min)))
1478
1479     (pass-if "n = fixnum-min - 1"
1480       (not (< -1 (- fixnum-min 1)))))
1481
1482   (with-test-prefix "(< -1.0 n)"
1483
1484     (pass-if "n = 0"
1485       (< -1.0 0))
1486
1487     (pass-if "n = 0.0"
1488       (< -1.0 0.0))
1489
1490     (pass-if "n = 1"
1491       (< -1.0 1))
1492
1493     (pass-if "n = 1.0"
1494       (< -1.0 1.0))
1495
1496     (pass-if "n = -1"
1497       (not (< -1.0 -1)))
1498
1499     (pass-if "n = -1.0"
1500       (not (< -1.0 -1.0)))
1501
1502     (pass-if "n = fixnum-max"
1503       (< -1.0 fixnum-max))
1504
1505     (pass-if "n = fixnum-max + 1"
1506       (< -1.0 (+ fixnum-max 1)))
1507
1508     (pass-if "n = fixnum-min"
1509       (not (< -1.0 fixnum-min)))
1510
1511     (pass-if "n = fixnum-min - 1"
1512       (not (< -1.0 (- fixnum-min 1)))))
1513
1514   (with-test-prefix "(< fixnum-max n)"
1515
1516     (pass-if "n = 0"
1517       (not (< fixnum-max 0)))
1518
1519     (pass-if "n = 0.0"
1520       (not (< fixnum-max 0.0)))
1521
1522     (pass-if "n = 1"
1523       (not (< fixnum-max 1)))
1524
1525     (pass-if "n = 1.0"
1526       (not (< fixnum-max 1.0)))
1527
1528     (pass-if "n = -1"
1529       (not (< fixnum-max -1)))
1530
1531     (pass-if "n = -1.0"
1532       (not (< fixnum-max -1.0)))
1533
1534     (pass-if "n = fixnum-max"
1535       (not (< fixnum-max fixnum-max)))
1536
1537     (pass-if "n = fixnum-max + 1"
1538       (< fixnum-max (+ fixnum-max 1)))
1539
1540     (pass-if "n = fixnum-min"
1541       (not (< fixnum-max fixnum-min)))
1542
1543     (pass-if "n = fixnum-min - 1"
1544       (not (< fixnum-max (- fixnum-min 1)))))
1545
1546   (with-test-prefix "(< (+ fixnum-max 1) n)"
1547
1548     (pass-if "n = 0"
1549       (not (< (+ fixnum-max 1) 0)))
1550
1551     (pass-if "n = 0.0"
1552       (not (< (+ fixnum-max 1) 0.0)))
1553
1554     (pass-if "n = 1"
1555       (not (< (+ fixnum-max 1) 1)))
1556
1557     (pass-if "n = 1.0"
1558       (not (< (+ fixnum-max 1) 1.0)))
1559
1560     (pass-if "n = -1"
1561       (not (< (+ fixnum-max 1) -1)))
1562
1563     (pass-if "n = -1.0"
1564       (not (< (+ fixnum-max 1) -1.0)))
1565
1566     (pass-if "n = fixnum-max"
1567       (not (< (+ fixnum-max 1) fixnum-max)))
1568
1569     (pass-if "n = fixnum-max + 1"
1570       (not (< (+ fixnum-max 1) (+ fixnum-max 1))))
1571
1572     (pass-if "n = fixnum-min"
1573       (not (< (+ fixnum-max 1) fixnum-min)))
1574
1575     (pass-if "n = fixnum-min - 1"
1576       (not (< (+ fixnum-max 1) (- fixnum-min 1)))))
1577
1578   (with-test-prefix "(< fixnum-min n)"
1579
1580     (pass-if "n = 0"
1581       (< fixnum-min 0))
1582
1583     (pass-if "n = 0.0"
1584       (< fixnum-min 0.0))
1585
1586     (pass-if "n = 1"
1587       (< fixnum-min 1))
1588
1589     (pass-if "n = 1.0"
1590       (< fixnum-min 1.0))
1591
1592     (pass-if "n = -1"
1593       (< fixnum-min -1))
1594
1595     (pass-if "n = -1.0"
1596       (< fixnum-min -1.0))
1597
1598     (pass-if "n = fixnum-max"
1599       (< fixnum-min fixnum-max))
1600
1601     (pass-if "n = fixnum-max + 1"
1602       (< fixnum-min (+ fixnum-max 1)))
1603
1604     (pass-if "n = fixnum-min"
1605       (not (< fixnum-min fixnum-min)))
1606
1607     (pass-if "n = fixnum-min - 1"
1608       (not (< fixnum-min (- fixnum-min 1)))))
1609
1610   (with-test-prefix "(< (- fixnum-min 1) n)"
1611
1612     (pass-if "n = 0"
1613       (< (- fixnum-min 1) 0))
1614
1615     (pass-if "n = 0.0"
1616       (< (- fixnum-min 1) 0.0))
1617
1618     (pass-if "n = 1"
1619       (< (- fixnum-min 1) 1))
1620
1621     (pass-if "n = 1.0"
1622       (< (- fixnum-min 1) 1.0))
1623
1624     (pass-if "n = -1"
1625       (< (- fixnum-min 1) -1))
1626
1627     (pass-if "n = -1.0"
1628       (< (- fixnum-min 1) -1.0))
1629
1630     (pass-if "n = fixnum-max"
1631       (< (- fixnum-min 1) fixnum-max))
1632
1633     (pass-if "n = fixnum-max + 1"
1634       (< (- fixnum-min 1) (+ fixnum-max 1)))
1635
1636     (pass-if "n = fixnum-min"
1637       (< (- fixnum-min 1) fixnum-min))
1638
1639     (pass-if "n = fixnum-min - 1"
1640       (not (< (- fixnum-min 1) (- fixnum-min 1)))))
1641
1642   (pass-if (< (ash 1 256) +inf.0))
1643   (pass-if (not (< +inf.0 (ash 1 256))))
1644   (pass-if (not (< (ash 1 256) -inf.0)))
1645   (pass-if (< -inf.0 (ash 1 256)))
1646
1647   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
1648   ;; sure we've avoided that
1649   (pass-if (< (1- (ash 1 1024)) +inf.0))
1650   (pass-if (<     (ash 1 1024)  +inf.0))
1651   (pass-if (< (1+ (ash 1 1024)) +inf.0))
1652   (pass-if (not (< +inf.0 (1- (ash 1 1024)))))
1653   (pass-if (not (< +inf.0     (ash 1 1024))))
1654   (pass-if (not (< +inf.0 (1+ (ash 1 1024)))))
1655   (pass-if (< -inf.0 (- (1- (ash 1 1024)))))
1656   (pass-if (< -inf.0 (-     (ash 1 1024))))
1657   (pass-if (< -inf.0 (- (1+ (ash 1 1024)))))
1658   (pass-if (not (< (- (1- (ash 1 1024))) -inf.0)))
1659   (pass-if (not (< (-     (ash 1 1024))  -inf.0)))
1660   (pass-if (not (< (- (1+ (ash 1 1024))) -inf.0)))
1661
1662   (pass-if (not (< +nan.0 +nan.0)))
1663   (pass-if (not (< 0 +nan.0)))
1664   (pass-if (not (< +nan.0 0)))
1665   (pass-if (not (< 1 +nan.0)))
1666   (pass-if (not (< +nan.0 1)))
1667   (pass-if (not (< -1 +nan.0)))
1668   (pass-if (not (< +nan.0 -1)))
1669
1670   (pass-if (not (< (ash 1 256) +nan.0)))
1671   (pass-if (not (< +nan.0 (ash 1 256))))
1672   (pass-if (not (< (- (ash 1 256)) +nan.0)))
1673   (pass-if (not (< +nan.0 (- (ash 1 256)))))
1674
1675   (pass-if (not (< (ash 1 8192) +nan.0)))
1676   (pass-if (not (< +nan.0 (ash 1 8192))))
1677   (pass-if (not (< (- (ash 1 8192)) +nan.0)))
1678   (pass-if (not (< +nan.0 (- (ash 1 8192)))))
1679
1680   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
1681   ;; sure we've avoided that
1682   (pass-if (not (< (ash 3 1023) +nan.0)))
1683   (pass-if (not (< (1+ (ash 3 1023)) +nan.0)))
1684   (pass-if (not (< (1- (ash 3 1023)) +nan.0)))
1685   (pass-if (not (< +nan.0 (ash 3 1023))))
1686   (pass-if (not (< +nan.0 (1+ (ash 3 1023)))))
1687   (pass-if (not (< +nan.0 (1- (ash 3 1023)))))
1688
1689   (with-test-prefix "inum/frac"
1690     (pass-if (< 2 9/4))
1691     (pass-if (< -2 9/4))
1692     (pass-if (< -2 7/4))
1693     (pass-if (< -2 -7/4))
1694     (pass-if (eq? #f (< 2 7/4)))
1695     (pass-if (eq? #f (< 2 -7/4)))
1696     (pass-if (eq? #f (< 2 -9/4)))
1697     (pass-if (eq? #f (< -2 -9/4))))
1698
1699   (with-test-prefix "bignum/frac"
1700     (let ((x (ash 1 2048)))
1701       (pass-if (< x (* 4/3 x)))
1702       (pass-if (< (- x) (* 4/3 x)))
1703       (pass-if (< (- x) (* 2/3 x)))
1704       (pass-if (< (- x) (* -2/3 x)))
1705       (pass-if (eq? #f (< x (* 2/3 x))))
1706       (pass-if (eq? #f (< x (* -2/3 x))))
1707       (pass-if (eq? #f (< x (* -4/3 x))))
1708       (pass-if (eq? #f (< (- x) (* -4/3 x))))))
1709
1710   (with-test-prefix "flonum/frac"
1711     (pass-if (< 0.75 4/3))
1712     (pass-if (< -0.75 4/3))
1713     (pass-if (< -0.75 2/3))
1714     (pass-if (< -0.75 -2/3))
1715     (pass-if (eq? #f (< 0.75 2/3)))
1716     (pass-if (eq? #f (< 0.75 -2/3)))
1717     (pass-if (eq? #f (< 0.75 -4/3)))
1718     (pass-if (eq? #f (< -0.75 -4/3)))
1719
1720     (pass-if (< -inf.0 4/3))
1721     (pass-if (< -inf.0 -4/3))
1722     (pass-if (eq? #f (< +inf.0 4/3)))
1723     (pass-if (eq? #f (< +inf.0 -4/3)))
1724
1725     (pass-if (eq? #f (< +nan.0 4/3)))
1726     (pass-if (eq? #f (< +nan.0 -4/3))))
1727
1728   (with-test-prefix "frac/inum"
1729     (pass-if (< 7/4 2))
1730     (pass-if (< -7/4 2))
1731     (pass-if (< -9/4 2))
1732     (pass-if (< -9/4 -2))
1733     (pass-if (eq? #f (< 9/4 2)))
1734     (pass-if (eq? #f (< 9/4 -2)))
1735     (pass-if (eq? #f (< 7/4 -2)))
1736     (pass-if (eq? #f (< -7/4 -2))))
1737
1738   (with-test-prefix "frac/bignum"
1739     (let ((x (ash 1 2048)))
1740       (pass-if (< (* 2/3 x) x))
1741       (pass-if (< (* -2/3 x) x))
1742       (pass-if (< (* -4/3 x) x))
1743       (pass-if (< (* -4/3 x) (- x)))
1744       (pass-if (eq? #f (< (* 4/3 x) x)))
1745       (pass-if (eq? #f (< (* 4/3 x) (- x))))
1746       (pass-if (eq? #f (< (* 2/3 x) (- x))))
1747       (pass-if (eq? #f (< (* -2/3 x) (- x))))))
1748
1749   (with-test-prefix "frac/flonum"
1750     (pass-if (< 2/3 0.75))
1751     (pass-if (< -2/3 0.75))
1752     (pass-if (< -4/3 0.75))
1753     (pass-if (< -4/3 -0.75))
1754     (pass-if (eq? #f (< 4/3 0.75)))
1755     (pass-if (eq? #f (< 4/3 -0.75)))
1756     (pass-if (eq? #f (< 2/3 -0.75)))
1757     (pass-if (eq? #f (< -2/3 -0.75)))
1758
1759     (pass-if (< 4/3 +inf.0))
1760     (pass-if (< -4/3 +inf.0))
1761     (pass-if (eq? #f (< 4/3 -inf.0)))
1762     (pass-if (eq? #f (< -4/3 -inf.0)))
1763
1764     (pass-if (eq? #f (< 4/3 +nan.0)))
1765     (pass-if (eq? #f (< -4/3 +nan.0))))
1766
1767   (with-test-prefix "frac/frac"
1768     (pass-if (< 2/3 6/7))
1769     (pass-if (< -2/3 6/7))
1770     (pass-if (< -4/3 6/7))
1771     (pass-if (< -4/3 -6/7))
1772     (pass-if (eq? #f (< 4/3 6/7)))
1773     (pass-if (eq? #f (< 4/3 -6/7)))
1774     (pass-if (eq? #f (< 2/3 -6/7)))
1775     (pass-if (eq? #f (< -2/3 -6/7)))))
1776
1777 ;;;
1778 ;;; >
1779 ;;;
1780
1781 ;; currently not tested -- implementation is trivial
1782 ;; (> x y) is implemented as (< y x)
1783 ;; FIXME: tests should probably be added in case we change implementation.
1784
1785 ;;;
1786 ;;; <=
1787 ;;;
1788
1789 ;; currently not tested -- implementation is trivial
1790 ;; (<= x y) is implemented as (not (< y x))
1791 ;; FIXME: tests should probably be added in case we change implementation.
1792
1793 ;;;
1794 ;;; >=
1795 ;;;
1796
1797 ;; currently not tested -- implementation is trivial
1798 ;; (>= x y) is implemented as (not (< x y))
1799 ;; FIXME: tests should probably be added in case we change implementation.
1800
1801 ;;;
1802 ;;; zero?
1803 ;;;
1804
1805 (with-test-prefix "zero?"
1806   (expect-fail (documented? zero?))
1807   (pass-if (zero? 0))
1808   (pass-if (not (zero? 7)))
1809   (pass-if (not (zero? -7)))
1810   (pass-if (not (zero? (+ 1 fixnum-max))))
1811   (pass-if (not (zero? (- 1 fixnum-min))))
1812   (pass-if (not (zero? 1.3)))
1813   (pass-if (not (zero? 3.1+4.2i))))
1814
1815 ;;;
1816 ;;; positive?
1817 ;;;
1818
1819 (with-test-prefix "positive?"
1820   (expect-fail (documented? positive?))
1821   (pass-if (positive? 1))
1822   (pass-if (positive? (+ fixnum-max 1)))
1823   (pass-if (positive? 1.3))
1824   (pass-if (not (positive? 0)))
1825   (pass-if (not (positive? -1)))
1826   (pass-if (not (positive? (- fixnum-min 1))))
1827   (pass-if (not (positive? -1.3))))
1828
1829 ;;;
1830 ;;; negative?
1831 ;;;
1832
1833 (with-test-prefix "negative?"
1834   (expect-fail (documented? negative?))
1835   (pass-if (not (negative? 1)))
1836   (pass-if (not (negative? (+ fixnum-max 1))))
1837   (pass-if (not (negative? 1.3)))
1838   (pass-if (not (negative? 0)))
1839   (pass-if (negative? -1))
1840   (pass-if (negative? (- fixnum-min 1)))
1841   (pass-if (negative? -1.3)))
1842
1843 ;;;
1844 ;;; max
1845 ;;;
1846
1847 (with-test-prefix "max"
1848   (pass-if (= 456.0 (max 123.0 456.0)))
1849   (pass-if (= 456.0 (max 456.0 123.0)))
1850
1851   (let ((big*2 (* fixnum-max 2))
1852         (big*3 (* fixnum-max 3))
1853         (big*4 (* fixnum-max 4))
1854         (big*5 (* fixnum-max 5)))
1855
1856     (pass-if (= +inf.0 (max big*5  +inf.0)))
1857     (pass-if (= +inf.0 (max +inf.0 big*5)))
1858     (pass-if (= big*5  (max big*5  -inf.0)))
1859     (pass-if (= big*5  (max -inf.0 big*5)))
1860
1861     (pass-if (nan? (max 123 +nan.0)))
1862     (pass-if (nan? (max big*5 +nan.0)))
1863     (pass-if (nan? (max 123.0 +nan.0)))
1864     (pass-if (nan? (max +nan.0 123)))
1865     (pass-if (nan? (max +nan.0 big*5)))
1866     (pass-if (nan? (max +nan.0 123.0)))
1867     (pass-if (nan? (max +nan.0 +nan.0))))
1868
1869   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
1870   ;; sure we've avoided that
1871   (for-each (lambda (b)
1872               (pass-if (list b +inf.0)
1873                 (= +inf.0 (max b +inf.0)))
1874               (pass-if (list +inf.0 b)
1875                 (= +inf.0 (max b +inf.0)))
1876               (pass-if (list b -inf.0)
1877                 (= b (max b -inf.0)))
1878               (pass-if (list -inf.0 b)
1879                 (= b (max b -inf.0))))
1880             (list (1- (ash 1 1024))
1881                   (ash 1 1024)
1882                   (1+ (ash 1 1024))
1883                   (- (1- (ash 1 1024)))
1884                   (- (ash 1 1024))
1885                   (- (1+ (ash 1 1024)))))
1886
1887   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
1888   ;; sure we've avoided that
1889   (pass-if (nan? (max (ash 1 2048) +nan.0)))
1890   (pass-if (nan? (max +nan.0 (ash 1 2048)))))
1891
1892 ;;;
1893 ;;; min
1894 ;;;
1895
1896 ;; FIXME: unfinished...
1897
1898 (with-test-prefix "min"
1899   (pass-if (= 123.0 (min 123.0 456.0)))
1900   (pass-if (= 123.0 (min 456.0 123.0)))
1901
1902   (let ((big*2 (* fixnum-max 2))
1903         (big*3 (* fixnum-max 3))
1904         (big*4 (* fixnum-max 4))
1905         (big*5 (* fixnum-max 5)))
1906
1907     (expect-fail (documented? max))
1908     (pass-if (= 1 (min 7 3 1 5)))
1909     (pass-if (= 1 (min 1 7 3 5)))
1910     (pass-if (= 1 (min 7 3 5 1)))
1911     (pass-if (= -7 (min 2 3 4 -2 5 -7 1 -1 4 2)))
1912     (pass-if (= -7 (min -7 2 3 4 -2 5 1 -1 4 2)))
1913     (pass-if (= -7 (min 2 3 4 -2 5 1 -1 4 2 -7)))
1914     (pass-if (= big*2 (min big*3 big*5 big*2 big*4)))
1915     (pass-if (= big*2 (min big*2 big*3 big*5 big*4)))
1916     (pass-if (= big*2 (min big*3 big*5 big*4 big*2)))
1917     (pass-if
1918         (= (- fixnum-min 1) (min 2 4 (- fixnum-min 1) 3 (* 2 fixnum-max))))
1919     (pass-if
1920         (= (- fixnum-min 1) (min (- fixnum-min 1) 2 4 3 (* 2 fixnum-max))))
1921     (pass-if
1922         (= (- fixnum-min 1) (min 2 4 3 (* 2 fixnum-max) (- fixnum-min 1))))
1923
1924     (pass-if (= big*5  (min big*5  +inf.0)))
1925     (pass-if (= big*5  (min +inf.0 big*5)))
1926     (pass-if (= -inf.0 (min big*5  -inf.0)))
1927     (pass-if (= -inf.0 (min -inf.0 big*5)))
1928
1929     (pass-if (nan? (min 123 +nan.0)))
1930     (pass-if (nan? (min big*5 +nan.0)))
1931     (pass-if (nan? (min 123.0 +nan.0)))
1932     (pass-if (nan? (min +nan.0 123)))
1933     (pass-if (nan? (min +nan.0 big*5)))
1934     (pass-if (nan? (min +nan.0 123.0)))
1935     (pass-if (nan? (min +nan.0 +nan.0))))
1936
1937   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
1938   ;; sure we've avoided that
1939   (for-each (lambda (b)
1940               (pass-if (list b +inf.0)
1941                 (= b (min b +inf.0)))
1942               (pass-if (list +inf.0 b)
1943                 (= b (min b +inf.0)))
1944               (pass-if (list b -inf.0)
1945                 (= -inf.0 (min b -inf.0)))
1946               (pass-if (list -inf.0 b)
1947                 (= -inf.0 (min b -inf.0))))
1948             (list (1- (ash 1 1024))
1949                   (ash 1 1024)
1950                   (1+ (ash 1 1024))
1951                   (- (1- (ash 1 1024)))
1952                   (- (ash 1 1024))
1953                   (- (1+ (ash 1 1024)))))
1954
1955   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
1956   ;; sure we've avoided that
1957   (pass-if (nan? (min (- (ash 1 2048)) (- +nan.0))))
1958   (pass-if (nan? (min (- +nan.0) (- (ash 1 2048))))))
1959
1960 ;;;
1961 ;;; +
1962 ;;;
1963
1964 (with-test-prefix "+"
1965
1966   (expect-fail "documented?"
1967     (documented? +))
1968
1969   (with-test-prefix "wrong type argument"
1970
1971     (pass-if-exception "1st argument string"
1972       exception:wrong-type-arg
1973       (+ "1" 2))
1974
1975     (pass-if-exception "2nd argument bool"
1976       exception:wrong-type-arg
1977       (+ 1 #f))))
1978 ;;;
1979 ;;; -
1980 ;;;
1981
1982 (with-test-prefix "-"
1983
1984   (pass-if "-inum - +bignum"
1985     (= #x-100000000000000000000000000000001
1986        (- -1 #x100000000000000000000000000000000)))
1987
1988   (pass-if "big - inum"
1989     (= #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
1990        (- #x100000000000000000000000000000000 1)))
1991
1992   (pass-if "big - -inum"
1993     (= #x100000000000000000000000000000001
1994        (- #x100000000000000000000000000000000 -1))))
1995
1996 ;;;
1997 ;;; *
1998 ;;;
1999
2000 (with-test-prefix "*"
2001
2002   (pass-if "complex * bignum"
2003     (let ((big (ash 1 90)))
2004       (= (make-rectangular big big)
2005          (* 1+1i big)))))
2006
2007 ;;;
2008 ;;; /
2009 ;;;
2010
2011 (with-test-prefix "/"
2012
2013   (expect-fail "documented?"
2014     (documented? /))
2015
2016   (with-test-prefix "division by zero"
2017
2018     (pass-if-exception "(/ 0)"
2019       exception:numerical-overflow
2020       (/ 0))
2021
2022     (pass-if "(/ 0.0)"
2023       (= +inf.0 (/ 0.0)))
2024
2025     (pass-if-exception "(/ 1 0)"
2026       exception:numerical-overflow
2027       (/ 1 0))
2028
2029     (pass-if "(/ 1 0.0)"
2030       (= +inf.0 (/ 1 0.0)))
2031
2032     (pass-if-exception "(/ bignum 0)"
2033       exception:numerical-overflow
2034       (/ (+ fixnum-max 1) 0))
2035
2036     (pass-if "(/ bignum 0.0)"
2037       (= +inf.0 (/ (+ fixnum-max 1) 0.0)))
2038
2039     (pass-if-exception "(/ 1.0 0)"
2040       exception:numerical-overflow
2041       (/ 1.0 0))
2042
2043     (pass-if "(/ 1.0 0.0)"
2044       (= +inf.0 (/ 1.0 0.0)))
2045
2046     (pass-if-exception "(/ +i 0)"
2047       exception:numerical-overflow
2048       (/ +i 0))
2049
2050     (pass-if "(/ +i 0.0)"
2051       (= +inf.0 (imag-part (/ +i 0.0)))))
2052
2053   (with-test-prefix "complex division"
2054
2055     (pass-if "(/ 3+4i)"
2056       (= (/ 3+4i) 0.12-0.16i))
2057
2058     (pass-if "(/ 4+3i)"
2059       (= (/ 4+3i) 0.16-0.12i))
2060
2061     (pass-if "(/ 25+125i 3+4i)"
2062       (= (/ 25+125i 3+4i) 23.0+11.0i))
2063
2064     (pass-if "(/ 25+125i 4+3i)"
2065       (= (/ 25+125i 4+3i) 19.0+17.0i))
2066
2067     (pass-if "(/ 25 3+4i)"
2068       (= (/ 25 3+4i) 3.0-4.0i))
2069
2070     (pass-if "(/ 25 4+3i)"
2071       (= (/ 25 4+3i) 4.0-3.0i))
2072
2073     (pass-if "(/ 1e200+1e200i)"
2074       (= (/ 1e200+1e200i) 5.0e-201-5.0e-201i))))
2075
2076 ;;;
2077 ;;; truncate
2078 ;;;
2079
2080 (with-test-prefix "truncate"
2081   (pass-if (=  1 (truncate  1.75)))
2082   (pass-if (=  1 (truncate  1.5)))
2083   (pass-if (=  1 (truncate  1.25)))
2084   (pass-if (=  0 (truncate  0.75)))
2085   (pass-if (=  0 (truncate  0.5)))
2086   (pass-if (=  0 (truncate  0.0)))
2087   (pass-if (=  0 (truncate -0.5)))
2088   (pass-if (= -1 (truncate -1.25)))
2089   (pass-if (= -1 (truncate -1.5))))
2090
2091 ;;;
2092 ;;; round
2093 ;;;
2094
2095 (with-test-prefix "round"
2096   (pass-if (=  2 (round  1.75)))
2097   (pass-if (=  2 (round  1.5)))
2098   (pass-if (=  1 (round  1.25)))
2099   (pass-if (=  1 (round  0.75)))
2100   (pass-if (=  0 (round  0.5)))
2101   (pass-if (=  0 (round  0.0)))
2102   (pass-if (=  0 (round -0.5)))
2103   (pass-if (= -1 (round -1.25)))
2104   (pass-if (= -2 (round -1.5))))
2105
2106 ;;;
2107 ;;; exact->inexact
2108 ;;;
2109
2110 (with-test-prefix "exact->inexact"
2111
2112   ;; Test "(exact->inexact n)", expect "want".
2113   ;; "i" is a index, for diagnostic purposes.
2114   (define (try-i i n want)
2115     (with-test-prefix (list i n want)
2116       (with-test-prefix "pos"
2117         (let ((got (exact->inexact n)))
2118           (pass-if "inexact?" (inexact? got))
2119           (pass-if (list "=" got) (= want got))))
2120       (set! n    (- n))
2121       (set! want (- want))
2122       (with-test-prefix "neg"
2123         (let ((got (exact->inexact n)))
2124           (pass-if "inexact?" (inexact? got))
2125           (pass-if (list "=" got) (= want got))))))
2126
2127   (with-test-prefix "2^i, no round"
2128     (do ((i    0   (1+ i))
2129          (n    1   (* 2 n))
2130          (want 1.0 (* 2.0 want)))
2131         ((> i 100))
2132       (try-i i n want)))
2133
2134   (with-test-prefix "2^i+1, no round"
2135     (do ((i    1   (1+ i))
2136          (n    3   (1- (* 2 n)))
2137          (want 3.0 (- (* 2.0 want) 1.0)))
2138         ((>= i dbl-mant-dig))
2139       (try-i i n want)))
2140
2141   (with-test-prefix "(2^i+1)*2^100, no round"
2142     (do ((i    1   (1+ i))
2143          (n    3   (1- (* 2 n)))
2144          (want 3.0 (- (* 2.0 want) 1.0)))
2145         ((>= i dbl-mant-dig))
2146       (try-i i (ash n 100) (ash-flo want 100))))
2147
2148   ;; bit pattern: 1111....11100.00
2149   ;;              <-mantdig-><-i->
2150   ;;
2151   (with-test-prefix "mantdig ones then zeros, no rounding"
2152     (do ((i    0  (1+ i))
2153          (n    (- (ash     1   dbl-mant-dig) 1)   (* 2 n))
2154          (want (- (ash-flo 1.0 dbl-mant-dig) 1.0) (* 2.0 want)))
2155         ((> i 100))
2156       (try-i i n want)))
2157
2158   ;; bit pattern: 1111....111011..1
2159   ;;              <-mantdig-> <-i->
2160   ;; This sort of value was incorrectly rounded upwards in Guile 1.6.4 when
2161   ;; i >= 11 (that's when the total is 65 or more bits).
2162   ;;
2163   (with-test-prefix "mantdig ones then 011..11, round down"
2164     (do ((i    0  (1+ i))
2165          (n    (- (ash     1   (+ 1 dbl-mant-dig)) 2)   (+ 1 (* 2 n)))
2166          (want (- (ash-flo 1.0 (+ 1 dbl-mant-dig)) 2.0) (* 2.0 want)))
2167         ((> i 100))
2168       (try-i i n want)))
2169
2170   ;; bit pattern: 1111....111100..001
2171   ;;              <-mantdig-> <--i->
2172   ;;
2173   (with-test-prefix "mantdig ones then 100..001, round up"
2174     (do ((i    0  (1+ i))
2175          (n    (- (ash     1   (+ 2 dbl-mant-dig)) 1)  (1- (* 2 n)))
2176          (want    (ash-flo 1.0 (+ 2 dbl-mant-dig))     (* 2.0 want)))
2177         ((> i 100))
2178       (try-i i n want)))
2179
2180   ;; bit pattern: 1000....000100..001
2181   ;;              <-mantdig-> <--i->
2182   ;;
2183   (with-test-prefix "2^mantdig then 100..001, round up"
2184     (do ((i    0  (1+ i))
2185          (n    (- (ash     1   (+ 2 dbl-mant-dig)) 1)   (1- (* 2 n)))
2186          (want (+ (ash-flo 1.0 (+ 2 dbl-mant-dig)) 4.0) (* 2.0 want)))
2187         ((> i 100))
2188       (try-i i n want))))
2189
2190 ;;;
2191 ;;; floor
2192 ;;;
2193
2194 ;;;
2195 ;;; ceiling
2196 ;;;
2197
2198 ;;;
2199 ;;; expt
2200 ;;;
2201
2202 (with-test-prefix "expt"
2203   (pass-if "(= 1 (expt 0 0))" (= 1 (expt 0 0)))
2204   (pass-if "(= 1 (expt 0 0.0))" (= 1 (expt 0 0.0)))
2205   (pass-if "(= 1 (expt 0.0 0))" (= 1 (expt 0.0 0)))
2206   (pass-if "(= 1 (expt 0.0 0.0))" (= 1 (expt 0.0 0.0))))
2207
2208 ;;;
2209 ;;; asinh
2210 ;;;
2211
2212 (with-test-prefix "asinh"
2213   (pass-if (= 0 (asinh 0))))
2214
2215 ;;;
2216 ;;; acosh
2217 ;;;
2218
2219 (with-test-prefix "acosh"
2220   (pass-if (= 0 (acosh 1))))
2221
2222 ;;;
2223 ;;; atanh
2224 ;;;
2225
2226 (with-test-prefix "atanh"
2227   (pass-if (= 0 (atanh 0))))
2228
2229 ;;;
2230 ;;; make-rectangular
2231 ;;;
2232
2233 ;;;
2234 ;;; make-polar
2235 ;;;
2236
2237 (with-test-prefix "make-polar"
2238   (define pi 3.14159265358979323846)
2239   (define (almost= x y)
2240     (> 0.01 (magnitude (- x y))))
2241
2242   (pass-if (= 0 (make-polar 0 0)))
2243   (pass-if (= 0 (make-polar 0 123.456)))
2244   (pass-if (= 1 (make-polar 1 0)))
2245   (pass-if (= -1 (make-polar -1 0)))
2246
2247   (pass-if (almost= 0+i (make-polar 1 (* 0.5 pi))))
2248   (pass-if (almost= -1  (make-polar 1 (* 1.0 pi))))
2249   (pass-if (almost= 0-i (make-polar 1 (* 1.5 pi))))
2250   (pass-if (almost= 1   (make-polar 1 (* 2.0 pi)))))
2251
2252 ;;;
2253 ;;; real-part
2254 ;;;
2255
2256 ;;;
2257 ;;; imag-part
2258 ;;;
2259
2260 ;;;
2261 ;;; magnitude
2262 ;;;
2263
2264 (with-test-prefix "magnitude"
2265   (pass-if (= 0 (magnitude 0)))
2266   (pass-if (= 1 (magnitude 1)))
2267   (pass-if (= 1 (magnitude -1)))
2268   (pass-if (= 1 (magnitude 0+i)))
2269   (pass-if (= 1 (magnitude 0-i)))
2270   (pass-if (= 5 (magnitude 3+4i)))
2271   (pass-if (= 5 (magnitude 3-4i)))
2272   (pass-if (= 5 (magnitude -3+4i)))
2273   (pass-if (= 5 (magnitude -3-4i))))
2274
2275 ;;;
2276 ;;; angle
2277 ;;;
2278
2279 (with-test-prefix "angle"
2280   (define pi 3.14159265358979323846)
2281   (define (almost= x y)
2282     (> 0.01 (magnitude (- x y))))
2283
2284   (pass-if "inum +ve"   (=        0 (angle 1)))
2285   (pass-if "inum -ve"   (almost= pi (angle -1)))
2286
2287   (pass-if "bignum +ve" (=        0 (angle (1+ fixnum-max))))
2288   (pass-if "bignum -ve" (almost= pi (angle (1- fixnum-min))))
2289
2290   (pass-if "flonum +ve" (=        0 (angle 1.5)))
2291   (pass-if "flonum -ve" (almost= pi (angle -1.5))))
2292
2293 ;;;
2294 ;;; inexact->exact
2295 ;;;
2296
2297 (with-test-prefix "inexact->exact"
2298
2299   (pass-if-exception "+inf" exception:out-of-range
2300     (inexact->exact +inf.0))
2301
2302   (pass-if-exception "-inf" exception:out-of-range
2303     (inexact->exact -inf.0))
2304
2305   (pass-if-exception "nan" exception:out-of-range
2306     (inexact->exact +nan.0))
2307
2308   (with-test-prefix "2.0**i to exact and back"
2309     (do ((i 0   (1+ i))
2310          (n 1.0 (* 2.0 n)))
2311         ((> i 100))
2312       (pass-if (list i n)
2313         (= n (inexact->exact (exact->inexact n)))))))
2314
2315 ;;;
2316 ;;; integer-length
2317 ;;;
2318
2319 (with-test-prefix "integer-length"
2320
2321   (with-test-prefix "-2^i, ...11100..00"
2322     (do ((n -1 (ash n 1))
2323          (i 0  (1+ i)))
2324         ((> i 256))
2325       (pass-if (list n "expect" i)
2326         (= i (integer-length n)))))
2327
2328   (with-test-prefix "-2^i+1 ...11100..01"
2329     (do ((n -3 (logxor 3 (ash n 1)))
2330          (i 2  (1+ i)))
2331         ((> i 256))
2332       (pass-if n
2333         (= i (integer-length n)))))
2334
2335   (with-test-prefix "-2^i-1 ...111011..11"
2336     (do ((n -2 (1+ (ash n 1)))
2337          (i 1  (1+ i)))
2338         ((> i 256))
2339       (pass-if n
2340         (= i (integer-length n))))))
2341
2342 ;;;
2343 ;;; logcount
2344 ;;;
2345
2346 (with-test-prefix "logcount"
2347
2348   (with-test-prefix "-2^i, meaning ...11100..00"
2349     (do ((n -1 (ash n 1))
2350          (i 0  (1+ i)))
2351         ((> i 256))
2352       (pass-if n
2353         (= i (logcount n)))))
2354
2355   (with-test-prefix "2^i"
2356     (do ((n 1 (ash n 1))
2357          (i 0  (1+ i)))
2358         ((> i 256))
2359       (pass-if n
2360         (= 1 (logcount n)))))
2361
2362   (with-test-prefix "2^i-1"
2363     (do ((n 0 (1+ (ash n 1)))
2364          (i 0  (1+ i)))
2365         ((> i 256))
2366       (pass-if n
2367         (= i (logcount n))))))
2368
2369 ;;;
2370 ;;; lognot
2371 ;;;
2372
2373 (with-test-prefix "lognot"
2374   (pass-if (= -1 (lognot 0)))
2375   (pass-if (= 0  (lognot -1)))
2376   (pass-if (= -2 (lognot 1)))
2377   (pass-if (= 1  (lognot -2)))
2378
2379   (pass-if (= #x-100000000000000000000000000000000
2380               (lognot #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)))
2381   (pass-if (= #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
2382               (lognot #x-100000000000000000000000000000000))))