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