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