test-suite/tests/numbers.test

   1 ;;;; numbers.test --- tests guile's numbers     -*- scheme -*-
   2 ;;;; Copyright (C) 2000, 2001, 2003, 2004, 2005, 2006, 2009, 2010, 2011,
   3 ;;;;   2012, 2013 Free Software Foundation, Inc.
   4 ;;;;
   5 ;;;; This library is free software; you can redistribute it and/or
   6 ;;;; modify it under the terms of the GNU Lesser General Public
   7 ;;;; License as published by the Free Software Foundation; either
   8 ;;;; version 3 of the License, or (at your option) any later version.
   9 ;;;;
  10 ;;;; This library is distributed in the hope that it will be useful,
  11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 ;;;; Lesser General Public License for more details.
  14 ;;;;
  15 ;;;; You should have received a copy of the GNU Lesser General Public
  16 ;;;; License along with this library; if not, write to the Free Software
  17 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  18
  19 (define-module (test-suite test-numbers)
  20   #:use-module (test-suite lib)
  21   #:use-module (ice-9 documentation)
  22   #:use-module (srfi srfi-1)    ; list library
  23   #:use-module (srfi srfi-11))  ; let-values
  24
  25 ;;;
  26 ;;; miscellaneous
  27 ;;;
  28
  29 (define exception:numerical-overflow
  30   (cons 'numerical-overflow "^Numerical overflow"))
  31
  32 (define (documented? object)
  33   (not (not (object-documentation object))))
  34
  35 (define fixnum-bit
  36   (do ((i 0 (+ 1 i))
  37        (n 1 (* 2 n)))
  38       ((> n most-positive-fixnum)
  39        (+ 1 i))))
  40
  41 (define fixnum-min most-negative-fixnum)
  42 (define fixnum-max most-positive-fixnum)
  43
  44 ;; Divine the number of bits in the mantissa of a flonum.
  45 ;; We look for when 2.0^i+1.0 gets rounded, ie. the difference between that
  46 ;; value and 2.0^k is not 1.0.
  47 ;; Of course this assumes flonums have a fixed precision mantissa, but
  48 ;; that's the case now and probably into the forseeable future.
  49 ;; On an IEEE system, which means pretty much everywhere, the value here is
  50 ;; the usual 53.
  51 ;;
  52 (define dbl-mant-dig
  53   (do ((prec 0 (+ prec 1))
  54        (eps 1.0 (/ eps 2.0)))
  55       ((begin (when (> prec 1000000)
  56                 (error "Unable to determine dbl-mant-dig"))
  57               (= 1.0 (+ 1.0 eps)))
  58        prec)))
  59
  60 (define dbl-epsilon
  61   (expt 0.5 (- dbl-mant-dig 1)))
  62
  63 (define dbl-epsilon-exact
  64   (expt 1/2 (- dbl-mant-dig 1)))
  65
  66 (define dbl-min-exp
  67   (do ((x 1.0 (/ x 2.0))
  68        (y (+ 1.0 dbl-epsilon) (/ y 2.0))
  69        (e 2 (- e 1)))
  70       ((begin (when (< e -100000000)
  71                 (error "Unable to determine dbl-min-exp"))
  72               (= x y))
  73        e)))
  74
  75 (define dbl-max-exp
  76   (do ((x 1.0 (* x 2.0))
  77        (e 0 (+ e 1)))
  78       ((begin (when (> e 100000000)
  79                 (error "Unable to determine dbl-max-exp"))
  80               (inf? x))
  81        e)))
  82
  83 ;; like ash, but working on a flonum
  84 (define (ash-flo x n)
  85   (while (> n 0)
  86     (set! x (* 2.0 x))
  87     (set! n (1- n)))
  88   (while (< n 0)
  89     (set! x (* 0.5 x))
  90     (set! n (1+ n)))
  91   x)
  92
  93 ;; `quotient' but rounded towards -infinity, like `modulo' or `ash' do
  94 ;; note only positive D supported (that's all that's currently required)
  95 (define-public (quotient-floor n d)
  96   (if (negative? n)
  97       (quotient (- n d -1) d)  ;; neg/pos
  98       (quotient n d)))         ;; pos/pos
  99
 100 ;; return true of X is in the range LO to HI, inclusive
 101 (define (within-range? lo hi x)
 102   (and (>= x (min lo hi))
 103        (<= x (max lo hi))))
 104
 105 ;; return true if GOT is within +/- 0.01 of GOT
 106 ;; for a complex number both real and imaginary parts must be in that range
 107 (define (eqv-loosely? want got)
 108   (and (within-range? (- (real-part want) 0.01)
 109                       (+ (real-part want) 0.01)
 110                       (real-part got))
 111        (within-range? (- (imag-part want) 0.01)
 112                       (+ (imag-part want) 0.01)
 113                       (imag-part got))))
 114
 115 ;; return true if OBJ is negative infinity
 116 (define (negative-infinity? obj)
 117   (and (real? obj)
 118        (negative? obj)
 119        (inf? obj)))
 120
 121 ;;
 122 ;; Tolerance used by test-eqv? for inexact numbers.
 123 ;;
 124 (define test-epsilon 1e-10)
 125
 126 ;;
 127 ;; Like eqv?, except that inexact finite numbers need only be within
 128 ;; test-epsilon (1e-10) to be considered equal.  For non-real complex
 129 ;; numbers, each component is tested according to these rules.  The
 130 ;; intent is that the known-correct value will be the first parameter.
 131 ;;
 132 (define (test-eqv? x y)
 133   (cond ((real? x)
 134          (and (real? y) (test-real-eqv? x y)))
 135         ((complex? x)
 136          (and (not (real? y))
 137               (test-real-eqv? (real-part x) (real-part y))
 138               (test-real-eqv? (imag-part x) (imag-part y))))
 139         (else (eqv? x y))))
 140
 141 ;; Auxiliary predicate used by test-eqv?
 142 (define (test-real-eqv? x y)
 143   (cond ((or (exact? x) (nan? x) (inf? x))
 144          (eqv? x y))
 145         (else (and (inexact? y) (> test-epsilon (abs (- x y)))))))
 146
 147 ;; return true if OBJ is a real NaN
 148 (define (real-nan? obj)
 149   (and (real? obj)
 150        (nan? obj)))
 151
 152 ;; return true if OBJ is a non-real complex number
 153 ;; whose real part is a nan, and whose imaginary
 154 ;; part is an inexact zero.
 155 (define (almost-real-nan? obj)
 156   (and (not (real? obj))
 157        (nan?  (real-part obj))
 158        (zero? (imag-part obj))))
 159
 160 ;; return true if both the real and imaginary
 161 ;; parts of OBJ are NaNs
 162 (define (complex-nan? obj)
 163   (and (nan? (real-part obj))
 164        (nan? (imag-part obj))))
 165
 166 ;; return true if the real part of OBJ is zero
 167 ;; and the imaginary part is a NaN.
 168 (define (imaginary-nan? obj)
 169   (and (zero? (real-part obj))
 170        (nan?  (imag-part obj))))
 171
 172 ;; return true if OBJ is a non-real complex zero
 173 (define (complex-zero? obj)
 174   (and (zero? obj)
 175        (complex? obj)
 176        (not (real? obj))))
 177
 178 (define const-e    2.7182818284590452354)
 179 (define const-e^2  7.3890560989306502274)
 180 (define const-1/e  0.3678794411714423215)
 181
 182
 183 ;;;
 184 ;;; 1+
 185 ;;;
 186
 187 (with-test-prefix/c&e "1+"
 188
 189   (pass-if "documented?"
 190     (documented? 1+))
 191
 192   (pass-if "0"   (eqv? 1 (1+ 0)))
 193   (pass-if "-1"   (eqv? 0 (1+ -1)))
 194   (pass-if "100"  (eqv? 101 (1+ 100)))
 195   (pass-if "-100" (eqv? -99 (1+ -100)))
 196
 197   ;; The maximum fixnum on a 32-bit architecture: 2^29 - 1.
 198   (pass-if "1+ fixnum = bignum (32-bit)"
 199     (eqv? 536870912 (1+ 536870911)))
 200
 201   ;; The maximum fixnum on a 64-bit architecture: 2^61 - 1.
 202   (pass-if "1+ fixnum = bignum (64-bit)"
 203     (eqv? 2305843009213693952 (1+ 2305843009213693951))))
 204
 205 ;;;
 206 ;;; 1-
 207 ;;;
 208
 209 (with-test-prefix/c&e "1-"
 210
 211   (pass-if "documented?"
 212     (documented? 1-))
 213
 214   (pass-if "0"    (eqv? -1 (1- 0)))
 215   (pass-if "1"    (eqv? 0 (1- 1)))
 216   (pass-if "100"  (eqv? 99 (1- 100)))
 217   (pass-if "-100" (eqv? -101 (1- -100)))
 218
 219   ;; The minimum fixnum on a 32-bit architecture: -2^29.
 220   (pass-if "1- fixnum = bignum (32-bit)"
 221     (eqv? -536870913 (1- -536870912)))
 222
 223   ;; The minimum fixnum on a 64-bit architecture: -2^61.
 224   (pass-if "1- fixnum = bignum (64-bit)"
 225     (eqv? -2305843009213693953 (1- -2305843009213693952))))
 226
 227 ;;;
 228 ;;; exact?
 229 ;;;
 230
 231 (with-test-prefix "exact?"
 232
 233   (pass-if "documented?"
 234     (documented? exact?))
 235
 236   (with-test-prefix "integers"
 237
 238     (pass-if "0"
 239       (exact? 0))
 240
 241     (pass-if "fixnum-max"
 242       (exact? fixnum-max))
 243
 244     (pass-if "fixnum-max + 1"
 245       (exact? (+ fixnum-max 1)))
 246
 247     (pass-if "fixnum-min"
 248       (exact? fixnum-min))
 249
 250     (pass-if "fixnum-min - 1"
 251       (exact? (- fixnum-min 1))))
 252
 253   (with-test-prefix "reals"
 254
 255     ;; (FIXME: need better examples.)
 256
 257     (pass-if "sqrt (fixnum-max^2 - 1)"
 258       (eq? #f (exact? (sqrt (- (expt fixnum-max 2) 1)))))
 259
 260     (pass-if "sqrt ((fixnum-max+1)^2 - 1)"
 261       (eq? #f (exact? (sqrt (- (expt (+ fixnum-max 1) 2) 1)))))
 262
 263     (pass-if (not (exact? +inf.0)))
 264     (pass-if (not (exact? -inf.0)))
 265     (pass-if (not (exact? +nan.0)))))
 266
 267 ;;;
 268 ;;; exp
 269 ;;;
 270
 271 (with-test-prefix "exp"
 272   (pass-if (documented? exp))
 273
 274   (pass-if-exception "no args" exception:wrong-num-args
 275     (exp))
 276   (pass-if-exception "two args" exception:wrong-num-args
 277     (exp 123 456))
 278
 279   (pass-if (eqv? 0.0 (exp -inf.0)))
 280   (pass-if (eqv-loosely? 1.0 (exp 0)))
 281   (pass-if (eqv-loosely? 1.0 (exp 0.0)))
 282   (pass-if (eqv-loosely? const-e   (exp 1.0)))
 283   (pass-if (eqv-loosely? const-e^2 (exp 2.0)))
 284   (pass-if (eqv-loosely? const-1/e (exp -1)))
 285
 286   (pass-if "exp(pi*i) = -1"
 287     (eqv-loosely? -1.0 (exp 0+3.14159i)))
 288   (pass-if "exp(-pi*i) = -1"
 289     (eqv-loosely? -1.0 (exp 0-3.14159i)))
 290   (pass-if "exp(2*pi*i) = +1"
 291     (eqv-loosely? 1.0 (exp 0+6.28318i)))
 292
 293   (pass-if "exp(2-pi*i) = -e^2"
 294     (eqv-loosely? (- const-e^2) (exp 2.0-3.14159i))))
 295
 296 ;;;
 297 ;;; odd?
 298 ;;;
 299
 300 (with-test-prefix "odd?"
 301   (pass-if (documented? odd?))
 302   (pass-if (odd? 1))
 303   (pass-if (odd? -1))
 304   (pass-if (not (odd? 0)))
 305   (pass-if (not (odd? 2)))
 306   (pass-if (not (odd? -2)))
 307   (pass-if (odd? (+ (* 2 fixnum-max) 1)))
 308   (pass-if (not (odd? (* 2 fixnum-max))))
 309   (pass-if (odd? (- (* 2 fixnum-min) 1)))
 310   (pass-if (not (odd? (* 2 fixnum-min)))))
 311
 312 ;;;
 313 ;;; even?
 314 ;;;
 315
 316 (with-test-prefix "even?"
 317   (pass-if (documented? even?))
 318   (pass-if (even? 2))
 319   (pass-if (even? -2))
 320   (pass-if (even? 0))
 321   (pass-if (not (even? 1)))
 322   (pass-if (not (even? -1)))
 323   (pass-if (not (even? (+ (* 2 fixnum-max) 1))))
 324   (pass-if (even? (* 2 fixnum-max)))
 325   (pass-if (not (even? (- (* 2 fixnum-min) 1))))
 326   (pass-if (even? (* 2 fixnum-min))))
 327
 328 ;;;
 329 ;;; finite?
 330 ;;;
 331
 332 (with-test-prefix "finite?"
 333   (pass-if (documented? finite?))
 334   (pass-if (not (finite? (inf))))
 335   (pass-if (not (finite? +inf.0)))
 336   (pass-if (not (finite? -inf.0)))
 337   (pass-if-exception
 338    "complex numbers not in domain of finite?"
 339    exception:wrong-type-arg
 340    (finite? +inf.0+1i))
 341   (pass-if-exception
 342    "complex numbers not in domain of finite? (2)"
 343    exception:wrong-type-arg
 344    (finite? +1+inf.0i))
 345   (pass-if-exception
 346    "complex numbers not in domain of finite? (3)"
 347    exception:wrong-type-arg
 348    (finite? +1+1i))
 349   (pass-if (finite? 3+0i))
 350   (pass-if (not (finite? (nan))))
 351   (pass-if (not (finite? +nan.0)))
 352   (pass-if (finite? 0))
 353   (pass-if (finite? 0.0))
 354   (pass-if (finite? -0.0))
 355   (pass-if (finite? 42.0))
 356   (pass-if (finite? 1/2))
 357   (pass-if (finite? (+ fixnum-max 1)))
 358   (pass-if (finite? (- fixnum-min 1))))
 359
 360 ;;;
 361 ;;; inf? and inf
 362 ;;;
 363
 364 (with-test-prefix "inf?"
 365   (pass-if (documented? inf?))
 366   (pass-if (inf? (inf)))
 367   ;; FIXME: what are the expected behaviors?
 368   ;; (pass-if (inf? (/ 1.0 0.0))
 369   ;; (pass-if (inf? (/ 1 0.0))
 370   (pass-if-exception
 371    "complex numbers not in domain of inf?"
 372    exception:wrong-type-arg
 373    (inf? +1+inf.0i))
 374   (pass-if (inf? +inf.0+0i))
 375   (pass-if (not (inf? 0)))
 376   (pass-if (not (inf? 42.0)))
 377   (pass-if (not (inf? (+ fixnum-max 1))))
 378   (pass-if (not (inf? (- fixnum-min 1)))))
 379
 380 ;;;
 381 ;;; nan? and nan
 382 ;;;
 383
 384 (with-test-prefix "nan?"
 385   (pass-if (documented? nan?))
 386   (pass-if (nan? (nan)))
 387   ;; FIXME: other ways we should be able to generate NaN?
 388   (pass-if (not (nan? 0)))
 389   (pass-if (not (nan? 42.0)))
 390   (pass-if (not (nan? (+ fixnum-max 1))))
 391   (pass-if (not (nan? (- fixnum-min 1)))))
 392
 393 ;;;
 394 ;;; abs
 395 ;;;
 396
 397 (with-test-prefix "abs"
 398   (pass-if (documented? abs))
 399   (pass-if (eqv? 0 (abs 0)))
 400   (pass-if (eqv? 1 (abs 1)))
 401   (pass-if (eqv? 1 (abs -1)))
 402
 403   (with-test-prefix "double-negation of fixnum-min"
 404     (pass-if (eqv?   fixnum-min (- (abs fixnum-min)))))
 405
 406   (pass-if (eqv? (+    fixnum-max  1) (abs (+ fixnum-max 1))))
 407   (pass-if (eqv? (+ (- fixnum-min) 1) (abs (- fixnum-min 1))))
 408
 409   (pass-if (eqv? 0.0    (abs  0.0)))
 410   (pass-if (eqv? 0.0    (abs -0.0)))
 411   (pass-if (eqv? 1.0    (abs  1.0)))
 412   (pass-if (eqv? 1.0    (abs -1.0)))
 413   (pass-if (real-nan?   (abs +nan.0)))
 414   (pass-if (eqv? +inf.0 (abs +inf.0)))
 415   (pass-if (eqv? +inf.0 (abs -inf.0))))
 416
 417 ;;;
 418 ;;; quotient
 419 ;;;
 420
 421 (with-test-prefix "quotient"
 422   (pass-if (documented? quotient))
 423
 424   (with-test-prefix "0 / n"
 425
 426     (pass-if "n = 1"
 427       (eqv? 0 (quotient 0 1)))
 428
 429     (pass-if "n = -1"
 430       (eqv? 0 (quotient 0 -1)))
 431
 432     (pass-if "n = 2"
 433       (eqv? 0 (quotient 0 2)))
 434
 435     (pass-if "n = fixnum-max"
 436       (eqv? 0 (quotient 0 fixnum-max)))
 437
 438     (pass-if "n = fixnum-max + 1"
 439       (eqv? 0 (quotient 0 (+ fixnum-max 1))))
 440
 441     (pass-if "n = fixnum-min"
 442       (eqv? 0 (quotient 0 fixnum-min)))
 443
 444     (pass-if "n = fixnum-min - 1"
 445       (eqv? 0 (quotient 0 (- fixnum-min 1)))))
 446
 447   (with-test-prefix "1 / n"
 448
 449     (pass-if "n = 1"
 450       (eqv? 1 (quotient 1 1)))
 451
 452     (pass-if "n = -1"
 453       (eqv? -1 (quotient 1 -1)))
 454
 455     (pass-if "n = 2"
 456       (eqv? 0 (quotient 1 2)))
 457
 458     (pass-if "n = fixnum-max"
 459       (eqv? 0 (quotient 1 fixnum-max)))
 460
 461     (pass-if "n = fixnum-max + 1"
 462       (eqv? 0 (quotient 1 (+ fixnum-max 1))))
 463
 464     (pass-if "n = fixnum-min"
 465       (eqv? 0 (quotient 1 fixnum-min)))
 466
 467     (pass-if "n = fixnum-min - 1"
 468       (eqv? 0 (quotient 1 (- fixnum-min 1)))))
 469
 470   (with-test-prefix "-1 / n"
 471
 472     (pass-if "n = 1"
 473       (eqv? -1 (quotient -1 1)))
 474
 475     (pass-if "n = -1"
 476       (eqv? 1 (quotient -1 -1)))
 477
 478     (pass-if "n = 2"
 479       (eqv? 0 (quotient -1 2)))
 480
 481     (pass-if "n = fixnum-max"
 482       (eqv? 0 (quotient -1 fixnum-max)))
 483
 484     (pass-if "n = fixnum-max + 1"
 485       (eqv? 0 (quotient -1 (+ fixnum-max 1))))
 486
 487     (pass-if "n = fixnum-min"
 488       (eqv? 0 (quotient -1 fixnum-min)))
 489
 490     (pass-if "n = fixnum-min - 1"
 491       (eqv? 0 (quotient -1 (- fixnum-min 1)))))
 492
 493   (with-test-prefix "fixnum-max / n"
 494
 495     (pass-if "n = 1"
 496       (eqv? fixnum-max (quotient fixnum-max 1)))
 497
 498     (pass-if "n = -1"
 499       (eqv? (- fixnum-max) (quotient fixnum-max -1)))
 500
 501     (pass-if "n = 2"
 502       (eqv? fixnum-max (+ (* (quotient fixnum-max 2) 2) 1)))
 503
 504     (pass-if "n = fixnum-max"
 505       (eqv? 1 (quotient fixnum-max fixnum-max)))
 506
 507     (pass-if "n = fixnum-max + 1"
 508       (eqv? 0 (quotient fixnum-max (+ fixnum-max 1))))
 509
 510     (pass-if "n = fixnum-min"
 511       (eqv? 0 (quotient fixnum-max fixnum-min)))
 512
 513     (pass-if "n = fixnum-min - 1"
 514       (eqv? 0 (quotient fixnum-max (- fixnum-min 1)))))
 515
 516   (with-test-prefix "(fixnum-max + 1) / n"
 517
 518     (pass-if "n = 1"
 519       (eqv? (+ fixnum-max 1) (quotient (+ fixnum-max 1) 1)))
 520
 521     (pass-if "n = -1"
 522       (eqv? (- (+ fixnum-max 1)) (quotient (+ fixnum-max 1) -1)))
 523
 524     (pass-if "n = 2"
 525       (eqv? (+ fixnum-max 1) (* (quotient (+ fixnum-max 1) 2) 2)))
 526
 527     (pass-if "n = fixnum-max"
 528       (eqv? 1 (quotient (+ fixnum-max 1) fixnum-max)))
 529
 530     (pass-if "n = fixnum-max + 1"
 531       (eqv? 1 (quotient (+ fixnum-max 1) (+ fixnum-max 1))))
 532
 533     (pass-if "n = fixnum-min"
 534       (eqv? -1 (quotient (+ fixnum-max 1) fixnum-min)))
 535
 536     (pass-if "n = fixnum-min - 1"
 537       (eqv? 0 (quotient (+ fixnum-max 1) (- fixnum-min 1)))))
 538
 539   (with-test-prefix "fixnum-min / n"
 540
 541     (pass-if "n = 1"
 542       (eqv? fixnum-min (quotient fixnum-min 1)))
 543
 544     (pass-if "n = -1"
 545       (eqv? (- fixnum-min) (quotient fixnum-min -1)))
 546
 547     (pass-if "n = 2"
 548       (eqv? fixnum-min (* (quotient fixnum-min 2) 2)))
 549
 550     (pass-if "n = fixnum-max"
 551       (eqv? -1 (quotient fixnum-min fixnum-max)))
 552
 553     (pass-if "n = fixnum-max + 1"
 554       (eqv? -1 (quotient fixnum-min (+ fixnum-max 1))))
 555
 556     (pass-if "n = fixnum-min"
 557       (eqv? 1 (quotient fixnum-min fixnum-min)))
 558
 559     (pass-if "n = fixnum-min - 1"
 560       (eqv? 0 (quotient fixnum-min (- fixnum-min 1))))
 561
 562     (pass-if "n = - fixnum-min - 1"
 563       (eqv? -1 (quotient fixnum-min (1- (- fixnum-min)))))
 564
 565     ;; special case, normally inum/big is zero
 566     (pass-if "n = - fixnum-min"
 567       (eqv? -1 (quotient fixnum-min (- fixnum-min))))
 568
 569     (pass-if "n = - fixnum-min + 1"
 570       (eqv? 0 (quotient fixnum-min (1+ (- fixnum-min))))))
 571
 572   (with-test-prefix "(fixnum-min - 1) / n"
 573
 574     (pass-if "n = 1"
 575       (eqv? (- fixnum-min 1) (quotient (- fixnum-min 1) 1)))
 576
 577     (pass-if "n = -1"
 578       (eqv? (- (- fixnum-min 1)) (quotient (- fixnum-min 1) -1)))
 579
 580     (pass-if "n = 2"
 581       (eqv? fixnum-min (* (quotient (- fixnum-min 1) 2) 2)))
 582
 583     (pass-if "n = fixnum-max"
 584       (eqv? -1 (quotient (- fixnum-min 1) fixnum-max)))
 585
 586     (pass-if "n = fixnum-max + 1"
 587       (eqv? -1 (quotient (- fixnum-min 1) (+ fixnum-max 1))))
 588
 589     (pass-if "n = fixnum-min"
 590       (eqv? 1 (quotient (- fixnum-min 1) fixnum-min)))
 591
 592     (pass-if "n = fixnum-min - 1"
 593       (eqv? 1 (quotient (- fixnum-min 1) (- fixnum-min 1)))))
 594
 595   ;; Inexact integers
 596
 597   (pass-if (eqv? 5.0 (quotient 35.0 7.0)))
 598   (pass-if (eqv? 5.0 (quotient 35   7.0)))
 599   (pass-if (eqv? 5.0 (quotient 35.0 7  )))
 600
 601   ;; Positive dividend and divisor
 602
 603   (pass-if "35 / 7"
 604     (eqv? 5 (quotient 35 7)))
 605
 606   ;; Negative dividend, positive divisor
 607
 608   (pass-if "-35 / 7"
 609     (eqv? -5 (quotient -35 7)))
 610
 611   ;; Positive dividend, negative divisor
 612
 613   (pass-if "35 / -7"
 614     (eqv? -5 (quotient 35 -7)))
 615
 616   ;; Negative dividend and divisor
 617
 618   (pass-if "-35 / -7"
 619     (eqv? 5 (quotient -35 -7)))
 620
 621   ;; Are numerical overflows detected correctly?
 622
 623   (with-test-prefix "division by zero"
 624
 625     (pass-if-exception "(quotient 1 0)"
 626       exception:numerical-overflow
 627       (quotient 1 0))
 628
 629     (pass-if-exception "(quotient bignum 0)"
 630       exception:numerical-overflow
 631       (quotient (+ fixnum-max 1) 0)))
 632
 633   ;; Are wrong type arguments detected correctly?
 634
 635   )
 636
 637 ;;;
 638 ;;; remainder
 639 ;;;
 640
 641 (with-test-prefix "remainder"
 642   (pass-if (documented? remainder))
 643
 644   (with-test-prefix "0 / n"
 645
 646     (pass-if "n = 1"
 647       (eqv? 0 (remainder 0 1)))
 648
 649     (pass-if "n = -1"
 650       (eqv? 0 (remainder 0 -1)))
 651
 652     (pass-if "n = fixnum-max"
 653       (eqv? 0 (remainder 0 fixnum-max)))
 654
 655     (pass-if "n = fixnum-max + 1"
 656       (eqv? 0 (remainder 0 (+ fixnum-max 1))))
 657
 658     (pass-if "n = fixnum-min"
 659       (eqv? 0 (remainder 0 fixnum-min)))
 660
 661     (pass-if "n = fixnum-min - 1"
 662       (eqv? 0 (remainder 0 (- fixnum-min 1)))))
 663
 664   (with-test-prefix "1 / n"
 665
 666     (pass-if "n = 1"
 667       (eqv? 0 (remainder 1 1)))
 668
 669     (pass-if "n = -1"
 670       (eqv? 0 (remainder 1 -1)))
 671
 672     (pass-if "n = fixnum-max"
 673       (eqv? 1 (remainder 1 fixnum-max)))
 674
 675     (pass-if "n = fixnum-max + 1"
 676       (eqv? 1 (remainder 1 (+ fixnum-max 1))))
 677
 678     (pass-if "n = fixnum-min"
 679       (eqv? 1 (remainder 1 fixnum-min)))
 680
 681     (pass-if "n = fixnum-min - 1"
 682       (eqv? 1 (remainder 1 (- fixnum-min 1)))))
 683
 684   (with-test-prefix "-1 / n"
 685
 686     (pass-if "n = 1"
 687       (eqv? 0 (remainder -1 1)))
 688
 689     (pass-if "n = -1"
 690       (eqv? 0 (remainder -1 -1)))
 691
 692     (pass-if "n = fixnum-max"
 693       (eqv? -1 (remainder -1 fixnum-max)))
 694
 695     (pass-if "n = fixnum-max + 1"
 696       (eqv? -1 (remainder -1 (+ fixnum-max 1))))
 697
 698     (pass-if "n = fixnum-min"
 699       (eqv? -1 (remainder -1 fixnum-min)))
 700
 701     (pass-if "n = fixnum-min - 1"
 702       (eqv? -1 (remainder -1 (- fixnum-min 1)))))
 703
 704   (with-test-prefix "fixnum-max / n"
 705
 706     (pass-if "n = 1"
 707       (eqv? 0 (remainder fixnum-max 1)))
 708
 709     (pass-if "n = -1"
 710       (eqv? 0 (remainder fixnum-max -1)))
 711
 712     (pass-if "n = fixnum-max"
 713       (eqv? 0 (remainder fixnum-max fixnum-max)))
 714
 715     (pass-if "n = fixnum-max + 1"
 716       (eqv? fixnum-max (remainder fixnum-max (+ fixnum-max 1))))
 717
 718     (pass-if "n = fixnum-min"
 719       (eqv? fixnum-max (remainder fixnum-max fixnum-min)))
 720
 721     (pass-if "n = fixnum-min - 1"
 722       (eqv? fixnum-max (remainder fixnum-max (- fixnum-min 1)))))
 723
 724   (with-test-prefix "(fixnum-max + 1) / n"
 725
 726     (pass-if "n = 1"
 727       (eqv? 0 (remainder (+ fixnum-max 1) 1)))
 728
 729     (pass-if "n = -1"
 730       (eqv? 0 (remainder (+ fixnum-max 1) -1)))
 731
 732     (pass-if "n = fixnum-max"
 733       (eqv? 1 (remainder (+ fixnum-max 1) fixnum-max)))
 734
 735     (pass-if "n = fixnum-max + 1"
 736       (eqv? 0 (remainder (+ fixnum-max 1) (+ fixnum-max 1))))
 737
 738     (pass-if "n = fixnum-min"
 739       (eqv? 0 (remainder (+ fixnum-max 1) fixnum-min)))
 740
 741     (pass-if "n = fixnum-min - 1"
 742       (eqv? (+ fixnum-max 1) (remainder (+ fixnum-max 1) (- fixnum-min 1)))))
 743
 744   (with-test-prefix "fixnum-min / n"
 745
 746     (pass-if "n = 1"
 747       (eqv? 0 (remainder fixnum-min 1)))
 748
 749     (pass-if "n = -1"
 750       (eqv? 0 (remainder fixnum-min -1)))
 751
 752     (pass-if "n = fixnum-max"
 753       (eqv? -1 (remainder fixnum-min fixnum-max)))
 754
 755     (pass-if "n = fixnum-max + 1"
 756       (eqv? 0 (remainder fixnum-min (+ fixnum-max 1))))
 757
 758     (pass-if "n = fixnum-min"
 759       (eqv? 0 (remainder fixnum-min fixnum-min)))
 760
 761     (pass-if "n = fixnum-min - 1"
 762       (eqv? fixnum-min (remainder fixnum-min (- fixnum-min 1))))
 763
 764     (pass-if "n = - fixnum-min - 1"
 765       (eqv? -1 (remainder fixnum-min (1- (- fixnum-min)))))
 766
 767     ;; special case, normally inum%big is the inum
 768     (pass-if "n = - fixnum-min"
 769       (eqv? 0 (remainder fixnum-min (- fixnum-min))))
 770
 771     (pass-if "n = - fixnum-min + 1"
 772       (eqv? fixnum-min (remainder fixnum-min (1+ (- fixnum-min))))))
 773
 774   (with-test-prefix "(fixnum-min - 1) / n"
 775
 776     (pass-if "n = 1"
 777       (eqv? 0 (remainder (- fixnum-min 1) 1)))
 778
 779     (pass-if "n = -1"
 780       (eqv? 0 (remainder (- fixnum-min 1) -1)))
 781
 782     (pass-if "n = fixnum-max"
 783       (eqv? -2 (remainder (- fixnum-min 1) fixnum-max)))
 784
 785     (pass-if "n = fixnum-max + 1"
 786       (eqv? -1 (remainder (- fixnum-min 1) (+ fixnum-max 1))))
 787
 788     (pass-if "n = fixnum-min"
 789       (eqv? -1 (remainder (- fixnum-min 1) fixnum-min)))
 790
 791     (pass-if "n = fixnum-min - 1"
 792       (eqv? 0 (remainder (- fixnum-min 1) (- fixnum-min 1)))))
 793
 794   ;; Inexact integers
 795
 796   (pass-if (eqv? 2.0 (remainder 37.0 7.0)))
 797   (pass-if (eqv? 2.0 (remainder 37   7.0)))
 798   (pass-if (eqv? 2.0 (remainder 37.0 7  )))
 799
 800   ;; Positive dividend and divisor
 801
 802   (pass-if "35 / 7"
 803     (eqv? 0 (remainder 35 7)))
 804
 805   ;; Negative dividend, positive divisor
 806
 807   (pass-if "-35 / 7"
 808     (eqv? 0 (remainder -35 7)))
 809
 810   ;; Positive dividend, negative divisor
 811
 812   (pass-if "35 / -7"
 813     (eqv? 0 (remainder 35 -7)))
 814
 815   ;; Negative dividend and divisor
 816
 817   (pass-if "-35 / -7"
 818     (eqv? 0 (remainder -35 -7)))
 819
 820   ;; Are numerical overflows detected correctly?
 821
 822   (with-test-prefix "division by zero"
 823
 824     (pass-if-exception "(remainder 1 0)"
 825       exception:numerical-overflow
 826       (remainder 1 0))
 827
 828     (pass-if-exception "(remainder bignum 0)"
 829       exception:numerical-overflow
 830       (remainder (+ fixnum-max 1) 0)))
 831
 832   ;; Are wrong type arguments detected correctly?
 833
 834   )
 835
 836 ;;;
 837 ;;; modulo
 838 ;;;
 839
 840 (with-test-prefix "modulo"
 841   (pass-if (documented? modulo))
 842
 843   (with-test-prefix "0 % n"
 844
 845     (pass-if "n = 1"
 846       (eqv? 0 (modulo 0 1)))
 847
 848     (pass-if "n = -1"
 849       (eqv? 0 (modulo 0 -1)))
 850
 851     (pass-if "n = fixnum-max"
 852       (eqv? 0 (modulo 0 fixnum-max)))
 853
 854     (pass-if "n = fixnum-max + 1"
 855       (eqv? 0 (modulo 0 (+ fixnum-max 1))))
 856
 857     (pass-if "n = fixnum-min"
 858       (eqv? 0 (modulo 0 fixnum-min)))
 859
 860     (pass-if "n = fixnum-min - 1"
 861       (eqv? 0 (modulo 0 (- fixnum-min 1)))))
 862
 863   (with-test-prefix "1 % n"
 864
 865     (pass-if "n = 1"
 866       (eqv? 0 (modulo 1 1)))
 867
 868     (pass-if "n = -1"
 869       (eqv? 0 (modulo 1 -1)))
 870
 871     (pass-if "n = fixnum-max"
 872       (eqv? 1 (modulo 1 fixnum-max)))
 873
 874     (pass-if "n = fixnum-max + 1"
 875       (eqv? 1 (modulo 1 (+ fixnum-max 1))))
 876
 877     (pass-if "n = fixnum-min"
 878       (eqv? (+ fixnum-min 1) (modulo 1 fixnum-min)))
 879
 880     (pass-if "n = fixnum-min - 1"
 881       (eqv? fixnum-min (modulo 1 (- fixnum-min 1)))))
 882
 883   (with-test-prefix "-1 % n"
 884
 885     (pass-if "n = 1"
 886       (eqv? 0 (modulo -1 1)))
 887
 888     (pass-if "n = -1"
 889       (eqv? 0 (modulo -1 -1)))
 890
 891     (pass-if "n = fixnum-max"
 892       (eqv? (- fixnum-max 1) (modulo -1 fixnum-max)))
 893
 894     (pass-if "n = fixnum-max + 1"
 895       (eqv? fixnum-max (modulo -1 (+ fixnum-max 1))))
 896
 897     (pass-if "n = fixnum-min"
 898       (eqv? -1 (modulo -1 fixnum-min)))
 899
 900     (pass-if "n = fixnum-min - 1"
 901       (eqv? -1 (modulo -1 (- fixnum-min 1)))))
 902
 903   (with-test-prefix "fixnum-max % n"
 904
 905     (pass-if "n = 1"
 906       (eqv? 0 (modulo fixnum-max 1)))
 907
 908     (pass-if "n = -1"
 909       (eqv? 0 (modulo fixnum-max -1)))
 910
 911     (pass-if "n = fixnum-max"
 912       (eqv? 0 (modulo fixnum-max fixnum-max)))
 913
 914     (pass-if "n = fixnum-max + 1"
 915       (eqv? fixnum-max (modulo fixnum-max (+ fixnum-max 1))))
 916
 917     (pass-if "n = fixnum-min"
 918       (eqv? -1 (modulo fixnum-max fixnum-min)))
 919
 920     (pass-if "n = fixnum-min - 1"
 921       (eqv? -2 (modulo fixnum-max (- fixnum-min 1)))))
 922
 923   (with-test-prefix "(fixnum-max + 1) % n"
 924
 925     (pass-if "n = 1"
 926       (eqv? 0 (modulo (+ fixnum-max 1) 1)))
 927
 928     (pass-if "n = -1"
 929       (eqv? 0 (modulo (+ fixnum-max 1) -1)))
 930
 931     (pass-if "n = fixnum-max"
 932       (eqv? 1 (modulo (+ fixnum-max 1) fixnum-max)))
 933
 934     (pass-if "n = fixnum-max + 1"
 935       (eqv? 0 (modulo (+ fixnum-max 1) (+ fixnum-max 1))))
 936
 937     (pass-if "n = fixnum-min"
 938       (eqv? 0 (modulo (+ fixnum-max 1) fixnum-min)))
 939
 940     (pass-if "n = fixnum-min - 1"
 941       (eqv? -1 (modulo (+ fixnum-max 1) (- fixnum-min 1)))))
 942
 943   (with-test-prefix "fixnum-min % n"
 944
 945     (pass-if "n = 1"
 946       (eqv? 0 (modulo fixnum-min 1)))
 947
 948     (pass-if "n = -1"
 949       (eqv? 0 (modulo fixnum-min -1)))
 950
 951     (pass-if "n = fixnum-max"
 952       (eqv? (- fixnum-max 1) (modulo fixnum-min fixnum-max)))
 953
 954     (pass-if "n = fixnum-max + 1"
 955       (eqv? 0 (modulo fixnum-min (+ fixnum-max 1))))
 956
 957     (pass-if "n = fixnum-min"
 958       (eqv? 0 (modulo fixnum-min fixnum-min)))
 959
 960     (pass-if "n = fixnum-min - 1"
 961       (eqv? fixnum-min (modulo fixnum-min (- fixnum-min 1)))))
 962
 963   (with-test-prefix "(fixnum-min - 1) % n"
 964
 965     (pass-if "n = 1"
 966       (eqv? 0 (modulo (- fixnum-min 1) 1)))
 967
 968     (pass-if "n = -1"
 969       (eqv? 0 (modulo (- fixnum-min 1) -1)))
 970
 971     (pass-if "n = fixnum-max"
 972       (eqv? (- fixnum-max 2) (modulo (- fixnum-min 1) fixnum-max)))
 973
 974     (pass-if "n = fixnum-max + 1"
 975       (eqv? fixnum-max (modulo (- fixnum-min 1) (+ fixnum-max 1))))
 976
 977     (pass-if "n = fixnum-min"
 978       (eqv? -1 (modulo (- fixnum-min 1) fixnum-min)))
 979
 980     (pass-if "n = fixnum-min - 1"
 981       (eqv? 0 (modulo (- fixnum-min 1) (- fixnum-min 1)))))
 982
 983   ;; Inexact integers
 984
 985   (pass-if (eqv? 1.0 (modulo 13.0 4.0)))
 986   (pass-if (eqv? 1.0 (modulo 13   4.0)))
 987   (pass-if (eqv? 1.0 (modulo 13.0 4  )))
 988
 989   ;; Positive dividend and divisor
 990
 991   (pass-if "13 % 4"
 992     (eqv? 1 (modulo 13 4)))
 993
 994   (pass-if "2177452800 % 86400"
 995     (eqv? 0 (modulo 2177452800 86400)))
 996
 997   ;; Negative dividend, positive divisor
 998
 999   (pass-if "-13 % 4"
1000     (eqv? 3 (modulo -13 4)))
1001
1002   (pass-if "-2177452800 % 86400"
1003     (eqv? 0 (modulo -2177452800 86400)))
1004
1005   ;; Positive dividend, negative divisor
1006
1007   (pass-if "13 % -4"
1008     (eqv? -3 (modulo 13 -4)))
1009
1010   (pass-if "2177452800 % -86400"
1011     (eqv? 0 (modulo 2177452800 -86400)))
1012
1013   ;; Negative dividend and divisor
1014
1015   (pass-if "-13 % -4"
1016     (eqv? -1 (modulo -13 -4)))
1017
1018   (pass-if "-2177452800 % -86400"
1019     (eqv? 0 (modulo -2177452800 -86400)))
1020
1021   ;; Are numerical overflows detected correctly?
1022
1023   (with-test-prefix "division by zero"
1024
1025     (pass-if-exception "(modulo 1 0)"
1026       exception:numerical-overflow
1027       (modulo 1 0))
1028
1029     (pass-if-exception "(modulo bignum 0)"
1030       exception:numerical-overflow
1031       (modulo (+ fixnum-max 1) 0)))
1032
1033   ;; Are wrong type arguments detected correctly?
1034
1035   )
1036
1037 ;;;
1038 ;;; modulo-expt
1039 ;;;
1040
1041 (with-test-prefix "modulo-expt"
1042    (pass-if (= 1 (modulo-expt 17 23 47)))
1043
1044    (pass-if (= 1 (modulo-expt 17 -23 47)))
1045
1046    (pass-if (= 17 (modulo-expt 17 -22 47)))
1047
1048    (pass-if (= 36 (modulo-expt 17 22 47)))
1049
1050    (pass-if (= 183658794479969134816674175082294846241553725240 (modulo-expt 111122223333444455556666 111122223333444455556666 1153478690012629968439432872520758982731022934717)))
1051
1052    (pass-if-exception
1053     "Proper exception with 0 modulus"
1054     exception:numerical-overflow
1055     (modulo-expt 17 23 0))
1056
1057    (pass-if-exception
1058     "Proper exception when result not invertible"
1059     exception:numerical-overflow
1060     (modulo-expt 10 -1 48))
1061
1062    (pass-if-exception
1063     "Proper exception with wrong type argument"
1064     exception:wrong-type-arg
1065     (modulo-expt "Sam" 23 10))
1066
1067    (pass-if-exception
1068     "Proper exception with wrong type argument"
1069     exception:wrong-type-arg
1070     (modulo-expt 17 9.9 10))
1071
1072     (pass-if-exception
1073     "Proper exception with wrong type argument"
1074     exception:wrong-type-arg
1075     (modulo-expt 17 23 'Ethel)))
1076
1077 ;;;
1078 ;;; numerator
1079 ;;;
1080
1081 (with-test-prefix "numerator"
1082   (pass-if-equal "0" 0 (numerator 0))
1083   (pass-if-equal "1" 1 (numerator 1))
1084   (pass-if-equal "2" 2 (numerator 2))
1085   (pass-if-equal "-1" -1 (numerator -1))
1086   (pass-if-equal "-2" -2 (numerator -2))
1087
1088   (pass-if-equal "0.0" 0.0 (numerator 0.0))
1089   (pass-if-equal "1.0" 1.0 (numerator 1.0))
1090   (pass-if-equal "2.0" 2.0 (numerator 2.0))
1091   (pass-if-equal "-0.0" -0.0 (numerator -0.0))
1092   (pass-if-equal "-1.0" -1.0 (numerator -1.0))
1093   (pass-if-equal "-2.0" -2.0 (numerator -2.0))
1094
1095   (pass-if-equal "0.5" 1.0 (numerator 0.5))
1096   (pass-if-equal "0.25" 1.0 (numerator 0.25))
1097   (pass-if-equal "0.75" 3.0 (numerator 0.75))
1098
1099   (pass-if-equal "+inf.0" +inf.0 (numerator +inf.0))
1100   (pass-if-equal "-inf.0" -inf.0 (numerator -inf.0)))
1101
1102 ;;;
1103 ;;; denominator
1104 ;;;
1105
1106 (with-test-prefix "denominator"
1107   (pass-if-equal "0" 1 (denominator 0))
1108   (pass-if-equal "1" 1 (denominator 1))
1109   (pass-if-equal "2" 1 (denominator 2))
1110   (pass-if-equal "-1" 1 (denominator -1))
1111   (pass-if-equal "-2" 1 (denominator -2))
1112
1113   (pass-if-equal "0.0" 1.0 (denominator 0.0))
1114   (pass-if-equal "1.0" 1.0 (denominator 1.0))
1115   (pass-if-equal "2.0" 1.0 (denominator 2.0))
1116   (pass-if-equal "-0.0" 1.0 (denominator -0.0))
1117   (pass-if-equal "-1.0" 1.0 (denominator -1.0))
1118   (pass-if-equal "-2.0" 1.0 (denominator -2.0))
1119
1120   (pass-if-equal "0.5" 2.0 (denominator 0.5))
1121   (pass-if-equal "0.25" 4.0 (denominator 0.25))
1122   (pass-if-equal "0.75" 4.0 (denominator 0.75))
1123
1124   (pass-if-equal "+inf.0" 1.0 (denominator +inf.0))
1125   (pass-if-equal "-inf.0" 1.0 (denominator -inf.0)))
1126
1127 ;;;
1128 ;;; gcd
1129 ;;;
1130
1131 (with-test-prefix "gcd"
1132
1133   (pass-if "documented?"
1134     (documented? gcd))
1135
1136   (with-test-prefix "(n)"
1137
1138     (pass-if "n = -2"
1139       (eqv? 2 (gcd -2))))
1140
1141   (with-test-prefix "(0 n)"
1142
1143     (pass-if "n = 0"
1144       (eqv? 0 (gcd 0 0)))
1145
1146     (pass-if "n = 1"
1147       (eqv? 1 (gcd 0 1)))
1148
1149     (pass-if "n = -1"
1150       (eqv? 1 (gcd 0 -1)))
1151
1152     (pass-if "n = fixnum-max"
1153       (eqv? fixnum-max (gcd 0 fixnum-max)))
1154
1155     (pass-if "n = fixnum-max + 1"
1156       (eqv? (+ fixnum-max 1) (gcd 0 (+ fixnum-max 1))))
1157
1158     (pass-if "n = fixnum-min"
1159       (eqv? (- fixnum-min) (gcd 0 fixnum-min)))
1160
1161     (pass-if "n = fixnum-min - 1"
1162       (eqv? (- (- fixnum-min 1)) (gcd 0 (- fixnum-min 1)))))
1163
1164   (with-test-prefix "(n 0)"
1165
1166     (pass-if "n = 2^128 * fixnum-max"
1167       (eqv? (ash fixnum-max 128) (gcd (ash fixnum-max 128) 0))))
1168
1169   (with-test-prefix "(1 n)"
1170
1171     (pass-if "n = 0"
1172       (eqv? 1 (gcd 1 0)))
1173
1174     (pass-if "n = 1"
1175       (eqv? 1 (gcd 1 1)))
1176
1177     (pass-if "n = -1"
1178       (eqv? 1 (gcd 1 -1)))
1179
1180     (pass-if "n = fixnum-max"
1181       (eqv? 1 (gcd 1 fixnum-max)))
1182
1183     (pass-if "n = fixnum-max + 1"
1184       (eqv? 1 (gcd 1 (+ fixnum-max 1))))
1185
1186     (pass-if "n = fixnum-min"
1187       (eqv? 1 (gcd 1 fixnum-min)))
1188
1189     (pass-if "n = fixnum-min - 1"
1190       (eqv? 1 (gcd 1 (- fixnum-min 1)))))
1191
1192   (with-test-prefix "(-1 n)"
1193
1194     (pass-if "n = 0"
1195       (eqv? 1 (gcd -1 0)))
1196
1197     (pass-if "n = 1"
1198       (eqv? 1 (gcd -1 1)))
1199
1200     (pass-if "n = -1"
1201       (eqv? 1 (gcd -1 -1)))
1202
1203     (pass-if "n = fixnum-max"
1204       (eqv? 1 (gcd -1 fixnum-max)))
1205
1206     (pass-if "n = fixnum-max + 1"
1207       (eqv? 1 (gcd -1 (+ fixnum-max 1))))
1208
1209     (pass-if "n = fixnum-min"
1210       (eqv? 1 (gcd -1 fixnum-min)))
1211
1212     (pass-if "n = fixnum-min - 1"
1213       (eqv? 1 (gcd -1 (- fixnum-min 1)))))
1214
1215   (with-test-prefix "(fixnum-max n)"
1216
1217     (pass-if "n = 0"
1218       (eqv? fixnum-max (gcd fixnum-max 0)))
1219
1220     (pass-if "n = 1"
1221       (eqv? 1 (gcd fixnum-max 1)))
1222
1223     (pass-if "n = -1"
1224       (eqv? 1 (gcd fixnum-max -1)))
1225
1226     (pass-if "n = fixnum-max"
1227       (eqv? fixnum-max (gcd fixnum-max fixnum-max)))
1228
1229     (pass-if "n = fixnum-max + 1"
1230       (eqv? 1 (gcd fixnum-max (+ fixnum-max 1))))
1231
1232     (pass-if "n = fixnum-min"
1233       (eqv? 1 (gcd fixnum-max fixnum-min)))
1234
1235     (pass-if "n = fixnum-min - 1"
1236       (eqv? 1 (gcd fixnum-max (- fixnum-min 1)))))
1237
1238   (with-test-prefix "((+ fixnum-max 1) n)"
1239
1240     (pass-if "n = 0"
1241       (eqv? (+ fixnum-max 1) (gcd (+ fixnum-max 1) 0)))
1242
1243     (pass-if "n = 1"
1244       (eqv? 1 (gcd (+ fixnum-max 1) 1)))
1245
1246     (pass-if "n = -1"
1247       (eqv? 1 (gcd (+ fixnum-max 1) -1)))
1248
1249     (pass-if "n = fixnum-max"
1250       (eqv? 1 (gcd (+ fixnum-max 1) fixnum-max)))
1251
1252     (pass-if "n = fixnum-max + 1"
1253       (eqv? (+ fixnum-max 1) (gcd (+ fixnum-max 1) (+ fixnum-max 1))))
1254
1255     (pass-if "n = fixnum-min"
1256       (eqv? (+ fixnum-max 1) (gcd (+ fixnum-max 1) fixnum-min)))
1257
1258     (pass-if "n = fixnum-min - 1"
1259       (eqv? 1 (gcd (+ fixnum-max 1) (- fixnum-min 1)))))
1260
1261   (with-test-prefix "(fixnum-min n)"
1262
1263     (pass-if "n = 0"
1264       (eqv? (- fixnum-min) (gcd fixnum-min 0)))
1265
1266     (pass-if "n = 1"
1267       (eqv? 1 (gcd fixnum-min 1)))
1268
1269     (pass-if "n = -1"
1270       (eqv? 1 (gcd fixnum-min -1)))
1271
1272     (pass-if "n = fixnum-max"
1273       (eqv? 1 (gcd fixnum-min fixnum-max)))
1274
1275     (pass-if "n = fixnum-max + 1"
1276       (eqv? (+ fixnum-max 1) (gcd fixnum-min (+ fixnum-max 1))))
1277
1278     (pass-if "n = fixnum-min"
1279       (eqv? (- fixnum-min) (gcd fixnum-min fixnum-min)))
1280
1281     (pass-if "n = fixnum-min - 1"
1282       (eqv? 1 (gcd fixnum-min (- fixnum-min 1)))))
1283
1284   (with-test-prefix "((- fixnum-min 1) n)"
1285
1286     (pass-if "n = 0"
1287       (eqv? (- (- fixnum-min 1)) (gcd (- fixnum-min 1) 0)))
1288
1289     (pass-if "n = 1"
1290       (eqv? 1 (gcd (- fixnum-min 1) 1)))
1291
1292     (pass-if "n = -1"
1293       (eqv? 1 (gcd (- fixnum-min 1) -1)))
1294
1295     (pass-if "n = fixnum-max"
1296       (eqv? 1 (gcd (- fixnum-min 1) fixnum-max)))
1297
1298     (pass-if "n = fixnum-max + 1"
1299       (eqv? 1 (gcd (- fixnum-min 1) (+ fixnum-max 1))))
1300
1301     (pass-if "n = fixnum-min"
1302       (eqv? 1 (gcd (- fixnum-min 1) fixnum-min)))
1303
1304     (pass-if "n = fixnum-min - 1"
1305       (eqv? (- (- fixnum-min 1)) (gcd (- fixnum-min 1) (- fixnum-min 1)))))
1306
1307   (with-test-prefix "flonum arguments"
1308
1309     (pass-if-equal "flonum"
1310         15.0
1311       (gcd -15.0))
1312
1313     (pass-if-equal "flonum/flonum"
1314         3.0
1315       (gcd 6.0 -15.0))
1316
1317     (pass-if-equal "flonum/fixnum"
1318         3.0
1319       (gcd 6.0 -15))
1320
1321     (pass-if-equal "fixnum/flonum"
1322         3.0
1323       (gcd -6 15.0))
1324
1325     (pass-if-equal "flonum/bignum"
1326         2.0
1327       (gcd -6.0 (expt 2 fixnum-bit)))
1328
1329     (pass-if-equal "bignum/flonum"
1330         3.0
1331       (gcd (- (expt 3 fixnum-bit)) 6.0)))
1332
1333   ;; Are wrong type arguments detected correctly?
1334
1335   )
1336
1337 ;;;
1338 ;;; lcm
1339 ;;;
1340
1341 (with-test-prefix "lcm"
1342   ;; FIXME: more tests?
1343   ;; (some of these are already in r4rs.test)
1344   (pass-if (documented? lcm))
1345   (pass-if-equal 1 (lcm))
1346   (pass-if-equal 15 (lcm -15))
1347   (pass-if-equal 288 (lcm 32 -36))
1348
1349   (with-test-prefix "flonum arguments"
1350
1351     (pass-if-equal "flonum"
1352         15.0
1353       (lcm -15.0))
1354
1355     (pass-if-equal "flonum/flonum"
1356         30.0
1357       (lcm 6.0 -15.0))
1358
1359     (pass-if-equal "flonum/fixnum"
1360         30.0
1361       (lcm 6.0 -15))
1362
1363     (pass-if-equal "fixnum/flonum"
1364         30.0
1365       (lcm -6 15.0))
1366
1367     (pass-if "flonum/bignum"
1368       (let ((want (* 3.0 (expt 2 fixnum-bit)))
1369             (got (lcm -6.0 (expt 2 fixnum-bit))))
1370         (and (inexact? got)
1371              (test-eqv? 1.0 (/ want got)))))
1372
1373     (pass-if "bignum/flonum"
1374       (let ((want (* 2.0 (expt 3 fixnum-bit)))
1375             (got (lcm (- (expt 3 fixnum-bit)) 6.0)))
1376         (and (inexact? got)
1377              (test-eqv? 1.0 (/ want got))))))
1378
1379   (let ((big-n 115792089237316195423570985008687907853269984665640564039457584007913129639936) ; 2 ^ 256
1380         (lcm-of-big-n-and-11 1273712981610478149659280835095566986385969831322046204434033424087044426039296))
1381     (pass-if (= lcm-of-big-n-and-11 (lcm big-n 11)))
1382     (pass-if (= lcm-of-big-n-and-11 (lcm 11 big-n 11)))))
1383
1384 ;;;
1385 ;;; rationalize
1386 ;;;
1387 (with-test-prefix "rationalize"
1388   (pass-if (documented? rationalize))
1389   (pass-if (eqv?  2     (rationalize  4   2  )))
1390   (pass-if (eqv? -2     (rationalize -4   2  )))
1391   (pass-if (eqv?  2.0   (rationalize  4   2.0)))
1392   (pass-if (eqv? -2.0   (rationalize -4.0 2  )))
1393
1394   (pass-if (eqv?  0     (rationalize  4   8  )))
1395   (pass-if (eqv?  0     (rationalize -4   8  )))
1396   (pass-if (eqv?  0.0   (rationalize  4   8.0)))
1397   (pass-if (eqv?  0.0   (rationalize -4.0 8  )))
1398
1399   (pass-if (eqv?  0.0   (rationalize  3   +inf.0)))
1400   (pass-if (eqv?  0.0   (rationalize -3   +inf.0)))
1401
1402   (pass-if (real-nan?   (rationalize +inf.0 +inf.0)))
1403   (pass-if (real-nan?   (rationalize +nan.0 +inf.0)))
1404   (pass-if (real-nan?   (rationalize +nan.0 4)))
1405   (pass-if (eqv? +inf.0 (rationalize +inf.0 3)))
1406
1407   (pass-if (eqv?  3/10  (rationalize  3/10 0)))
1408   (pass-if (eqv? -3/10  (rationalize -3/10 0)))
1409
1410   (pass-if (eqv?  1/3   (rationalize  3/10 1/10)))
1411   (pass-if (eqv? -1/3   (rationalize -3/10 1/10)))
1412
1413   (pass-if (eqv?  1/3   (rationalize  3/10 -1/10)))
1414   (pass-if (eqv? -1/3   (rationalize -3/10 -1/10)))
1415
1416   ;; Prior to Guile 2.0.10, rationalize used a faulty algorithm that
1417   ;; incorrectly returned 2/3 and -2/3 in the following cases.
1418   (pass-if (eqv?  1/2   (rationalize #e+0.67 1/4)))
1419   (pass-if (eqv? -1/2   (rationalize #e-0.67 1/4)))
1420
1421   (pass-if (eqv?  1     (rationalize #e+0.67 1/3)))
1422   (pass-if (eqv? -1     (rationalize #e-0.67 1/3)))
1423
1424   (pass-if (eqv?  1/2   (rationalize #e+0.66 1/3)))
1425   (pass-if (eqv? -1/2   (rationalize #e-0.66 1/3)))
1426
1427   (pass-if (eqv?  1     (rationalize #e+0.67 2/3)))
1428   (pass-if (eqv? -1     (rationalize #e-0.67 2/3)))
1429
1430   (pass-if (eqv?  0     (rationalize #e+0.66 2/3)))
1431   (pass-if (eqv?  0     (rationalize #e-0.66 2/3)))
1432
1433   ;; Prior to Guile 2.0.10, rationalize used a faulty algorithm that
1434   ;; incorrectly computed the following approximations of PI.
1435   (with-test-prefix "pi"
1436     (define *pi* #e3.1415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170679)
1437     (pass-if (eqv? 16/5 (rationalize *pi* 1/10)))
1438     (pass-if (eqv? 201/64 (rationalize *pi* 1/1000)))
1439     (pass-if (eqv? 75948/24175 (rationalize *pi* (expt 10 -7))))
1440     (pass-if (eqv? 100798/32085 (rationalize *pi* (expt 10 -8))))
1441     (pass-if (eqv? 58466453/18610450 (rationalize *pi* (expt 10 -14))))
1442     (pass-if (eqv? 2307954651196778721982809475299879198775111361078/734644782339796933783743757007944508986600750685
1443                    (rationalize *pi* (expt 10 -95)))))
1444
1445   (pass-if (test-eqv? (/  1.0 3) (rationalize  0.3  1/10)))
1446   (pass-if (test-eqv? (/ -1.0 3) (rationalize -0.3  1/10)))
1447   (pass-if (test-eqv? (/  1.0 3) (rationalize  0.3 -1/10)))
1448   (pass-if (test-eqv? (/ -1.0 3) (rationalize -0.3 -1/10))))
1449
1450 ;;;
1451 ;;; number->string
1452 ;;;
1453
1454 (with-test-prefix "number->string"
1455   (let ((num->str->num
1456          (lambda (n radix)
1457            (string->number (number->string n radix) radix))))
1458
1459     (define (test num)
1460       (pass-if-equal (list num 'pos)
1461           num
1462         (num->str->num num 10))
1463       (pass-if-equal (list num 'neg)
1464           (- num)
1465         (num->str->num (- num) 10)))
1466
1467     (pass-if (documented? number->string))
1468     (pass-if (string=? (number->string 0) "0"))
1469     (pass-if (string=? (number->string 171) "171"))
1470     (pass-if (= (+ fixnum-max 1) (num->str->num (+ fixnum-max 1) 10)))
1471     (pass-if (= (- fixnum-min 1) (num->str->num (- fixnum-min 1) 10)))
1472
1473     (test (inf))
1474     (test 1.3)
1475     (test (acos -1))  ; pi
1476     (test (exp 1))    ; e
1477     (test (/ 3.0))
1478     (test (/ 7.0))
1479     (test 2.2250738585072011e-308)
1480     (test 2.2250738585072012e-308)
1481
1482     ;; Largest finite inexact
1483     (test (* (- (expt 2.0 dbl-mant-dig) 1)
1484              (expt 2.0 (- dbl-max-exp dbl-mant-dig))))
1485
1486     (pass-if (string=? "0.0" (number->string 0.0)))
1487     (pass-if (or (eqv? 0.0 -0.0)
1488                  (string=? "-0.0" (number->string -0.0))))
1489
1490     (pass-if (string=? (number->string 35.25 36) "z.9"))
1491     (pass-if (string=? (number->string 0.25 2) "0.01"))
1492     (pass-if (string=? (number->string 255.0625 16) "ff.1"))
1493     (pass-if (string=? (number->string (/ 1 3) 3) "1/10"))
1494
1495     (pass-if (string=? (number->string 10) "10"))
1496     (pass-if (string=? (number->string 10 11) "a"))
1497     (pass-if (string=? (number->string 36 36) "10"))
1498     (pass-if (= (num->str->num 36 36) 36))
1499     (pass-if (= (string->number "z" 36) 35))
1500     (pass-if (= (string->number "Z" 36) 35))
1501     (pass-if (not (string->number "Z" 35)))
1502     (pass-if (string=? (number->string 35 36) "z"))
1503     (pass-if (= (num->str->num 35 36) 35))
1504
1505     (pass-if (string=? (number->string 12342342340000.0) "1.234234234e13"))
1506     (pass-if (string=? (number->string 1234234234000.0) "1234234234000.0"))
1507     (pass-if (string=? (number->string 1240000.0) "1240000.0"))
1508
1509     (with-test-prefix "powers of radix"
1510       (for-each
1511        (lambda (radix)
1512          (for-each (lambda (k)
1513                      (let ((val (exact->inexact (expt radix k)))
1514                            (str (if (<= -3 k 6)
1515                                     (assoc-ref '((-3 . "0.001")
1516                                                  (-2 . "0.01")
1517                                                  (-1 . "0.1")
1518                                                  ( 0 . "1.0")
1519                                                  ( 1 . "10.0")
1520                                                  ( 2 . "100.0")
1521                                                  ( 3 . "1000.0")
1522                                                  ( 4 . "10000.0")
1523                                                  ( 5 . "100000.0")
1524                                                  ( 6 . "1000000.0"))
1525                                                k)
1526                                     (string-append "1.0e"
1527                                                    (number->string k radix)))))
1528                        (pass-if-equal (list radix k 'pos)
1529                            str
1530                          (number->string val radix))
1531                        (pass-if-equal (list radix k 'neg)
1532                            (string-append "-" str)
1533                          (number->string (- val) radix))))
1534                    (iota 41 -20)))
1535        (iota 35 2)))
1536
1537     (with-test-prefix "multiples of smallest inexact"
1538       (for-each (lambda (k)
1539                   (let ((val (* k (expt 2.0 (- dbl-min-exp dbl-mant-dig)))))
1540                     (test val)))
1541                 (iota 40 1)))
1542
1543     (with-test-prefix "one plus multiples of epsilon"
1544       (for-each (lambda (k)
1545                   (let ((val (+ 1.0 (* k dbl-epsilon))))
1546                     (test val)))
1547                 (iota 40 1)))
1548
1549     (with-test-prefix "one minus multiples of 1/2 epsilon"
1550       (for-each (lambda (k)
1551                   (let ((val (- 1.0 (* k 1/2 dbl-epsilon))))
1552                     (test val)))
1553                 (iota 40 1)))
1554
1555     ;; Before Guile 2.0.1, even in the presence of a #e forced exactness
1556     ;; specifier, negative exponents were applied inexactly and then
1557     ;; later coerced to exact, yielding an incorrect fraction.
1558     (pass-if (eqv? (string->number "#e1e-10") 1/10000000000))
1559
1560     (pass-if (string=? (number->string 11.33333333333333333 12)
1561                        "b.4"))
1562     (pass-if (string=? (number->string 1.324e44 16)
1563                        "5.efe0a14fafdf8e24"))))
1564
1565 ;;;
1566 ;;; string->number
1567 ;;;
1568
1569 (with-test-prefix "string->number"
1570
1571   (pass-if "documented?"
1572     (documented? string->number))
1573
1574   (pass-if "non number strings"
1575     (for-each (lambda (x) (if (string->number x) (throw 'fail)))
1576               '("" "q" "1q" "6+7iq" "8+9q" "10+11" "13+" "18@19q" "20@q" "23@"
1577                 "+25iq" "26i" "-q" "-iq" "i" "5#.0" "8/" "10#11" ".#" "."
1578                 "#o.2" "3.4q" "15.16e17q" "18.19e+q" ".q" ".17#18" "10q" "#b2"
1579                 "#b3" "#b4" "#b5" "#b6" "#b7" "#b8" "#b9" "#ba" "#bb" "#bc"
1580                 "#bd" "#be" "#bf" "#q" "#b#b1" "#o#o1" "#d#d1" "#x#x1" "#e#e1"
1581                 "#i#i1" "12@12+0i" "3/0" "0/0" "4+3/0i" "4/0-3i" "2+0/0i"
1582                 "nan.0" "inf.0" "#e+nan.0" "#e+inf.0" "#e-inf.0"
1583                 "3@inf.0" "4@nan.0"))
1584     #t)
1585
1586   (pass-if "valid number strings"
1587     (for-each (lambda (couple)
1588                 (apply
1589                  (lambda (x y)
1590                    (let ((xx (string->number x)))
1591                      (if (or (eq? xx #f) (not (eqv? xx y)))
1592                          (begin
1593                            (pk x y)
1594                            (throw 'fail)))))
1595                  couple))
1596               `(;; Radix:
1597                 ("#b0" 0) ("#B0" 0) ("#b1" 1) ("#B1" 1) ("#o0" 0) ("#O0" 0)
1598                 ("#o1" 1) ("#O1" 1) ("#o2" 2) ("#O2" 2) ("#o3" 3) ("#O3" 3)
1599                 ("#o4" 4) ("#O4" 4) ("#o5" 5) ("#O5" 5) ("#o6" 6) ("#O6" 6)
1600                 ("#o7" 7) ("#O7" 7) ("#d0" 0) ("#D0" 0) ("#d1" 1) ("#D1" 1)
1601                 ("#d2" 2) ("#D2" 2) ("#d3" 3) ("#D3" 3) ("#d4" 4) ("#D4" 4)
1602                 ("#d5" 5) ("#D5" 5) ("#d6" 6) ("#D6" 6) ("#d7" 7) ("#D7" 7)
1603                 ("#d8" 8) ("#D8" 8) ("#d9" 9) ("#D9" 9)
1604                 ("#xa" 10) ("#Xa" 10) ("#xb" 11) ("#Xb" 11)
1605                 ("#xc" 12) ("#Xc" 12) ("#xd" 13) ("#Xd" 13)
1606                 ("#xe" 14) ("#Xe" 14) ("#xf" 15) ("#Xf" 15)
1607                 ("#b1010" 10)
1608                 ("#o12345670" 2739128)
1609                 ("#d1234567890" 1234567890)
1610                 ("#x1234567890abcdef" 1311768467294899695)
1611                 ;; Exactness:
1612                 ("#e1" 1) ("#e1.2" 12/10)
1613                 ("#i1.1" 1.1) ("#i1" 1.0)
1614                 ;; Integers:
1615                 ("1" ,(1+ 0)) ("23" ,(+ 9 9 5)) ("-1" ,(- 0 1))
1616                 ("-45" ,(- 0 45)) ("2#" 20.0) ("2##" 200.0) ("12##" 1200.0)
1617                 ("#b#i100" 4.0)
1618                 ;; Fractions:
1619                 ("1/1" 1) ("1/2" 1/2) ("-1/2" -1/2) ("1#/1" 10.0)
1620                 ("10/1#" 1.0) ("1#/1#" 1.0) ("#e9/10" 9/10) ("#e10/1#" 1)
1621                 ("#i6/8" 0.75) ("#i1/1" 1.0)
1622                 ;; Infinities and NaNs:
1623                 ("+inf.0" ,(inf)) ("-inf.0" ,(- (inf)))
1624                 ("+Inf.0" ,(inf)) ("-Inf.0" ,(- (inf)))
1625                 ("+InF.0" ,(inf)) ("-InF.0" ,(- (inf)))
1626                 ("+INF.0" ,(inf)) ("-INF.0" ,(- (inf)))
1627                 ("#i+InF.0" ,(inf)) ("#i-InF.0" ,(- (inf)))
1628                 ("+nan.0" ,(nan)) ("-nan.0" ,(nan))
1629                 ("#i+nan.0" ,(nan)) ("#i-nan.0" ,(nan))
1630                 ;; Decimal numbers:
1631                 ;; * <uinteger 10> <suffix>
1632                 ("1e2" 100.0) ("1E2" 100.0) ("1s2" 100.0) ("1S2" 100.0)
1633                 ("1f2" 100.0) ("1F2" 100.0) ("1d2" 100.0) ("1D2" 100.0)
1634                 ("1l2" 100.0) ("1L2" 100.0) ("1e+2" 100.0) ("1e-2" 0.01)
1635                 ;; * . <digit 10>+ #* <suffix>
1636                 (".1" .1) (".0123456789" 123456789e-10) (".16#" 0.16)
1637                 (".0123456789e10" 123456789.0) (".16#e3" 160.0) ("#d.3" 0.3)
1638                 ;; * <digit 10>+ . <digit 10>* #* <suffix>
1639                 ("3." ,(exact->inexact 3)) ("3.e0" ,(exact->inexact 3))
1640                 ("3.1" ,(exact->inexact 31/10)) ("3.1e0" 3.1) ("3.1#" 3.1)
1641                 ("3.1#e0" 3.1)
1642                 ;; * <digit 10>+ #+ . #* <suffix>
1643                 ("3#." 30.0) ("3#.e0" 30.0) ("3#.#" 30.0) ("3#.#e0" 30.0)
1644                 ))
1645     #t)
1646
1647   (pass-if "valid complex number strings"
1648     (for-each (lambda (triple)
1649                 (apply
1650                  (lambda (str re im)
1651                    (let ((z (string->number str)))
1652                      (if (or (eq? z #f)
1653                              (not (and (eqv? (real-part z) re)
1654                                        (eqv? (imag-part z) im))))
1655                          (begin
1656                            (pk str re im)
1657                            (throw 'fail)))))
1658                  triple))
1659               `(("1@0" 1 0) ("1@+0" 1 0) ("1@-0" 1 0) ("1/2@0" 1/2 0)
1660                 ("1.0@0" 1.0 0) ("1.0@-0" 1.0 0)
1661                 ("#e1@0" 1 0) ("#e1@+0" 1 0) ("#e1@-0" 1 0) ("#e0.5@0.0" 1/2 0)
1662                 ("#e1.0@0" 1 0) ("#e1.0@-0" 1 0)
1663                 ("#i1@0" 1.0 0.0) ("#i1@+0" 1.0 0.0) ("#i1@-0" 1.0 -0.0) ("#i1/2@0" 0.5 0.0)
1664                 ("#i1.0@0" 1.0 0.0) ("#i1.0@-0" 1.0 -0.0)
1665                 ("1@+0.0" 1.0 0.0) ("1.0@-0.0" 1.0 -0.0)
1666                 ("2+3i" 2.0 3.0) ("4-5i" 4.0 -5.0)
1667                 ("1+i" 1.0 1.0) ("1-i" 1.0 -1.0) ("+1i" 0.0 1.0) ("-1i" 0.0 -1.0)
1668                 ("+i" 0.0 1.0) ("-i" 0.0 -1.0)
1669                 ("1.0+.1i" 1.0 0.1) ("1.0-.1i" 1.0 -0.1)
1670                 (".1+.0i" 0.1 0.0) ("1.+.0i" 1.0 0.0) (".1+.1i" 0.1 0.1)
1671                 ("1e1+.1i" 10.0 0.1)
1672                 ("0@+nan.0" 0 0) ("0@+inf.0" 0 0) ("0@-inf.0" 0 0)
1673                 ("0.0@+nan.0" 0.0 0.0) ("0.0@+inf.0" 0.0 0.0) ("0.0@-inf.0" 0.0 0.0)
1674                 ("#i0@+nan.0" 0.0 0.0) ("#i0@+inf.0" 0.0 0.0) ("#i0@-inf.0" 0.0 0.0)
1675                 ("0.0@1" 0.0 0.0) ("0.0@2" -0.0 0.0) ("0.0@4" -0.0 -0.0) ("0.0@5" 0.0 -0.0)
1676                 ))
1677     #t)
1678
1679   (pass-if-exception "exponent too big"
1680     exception:out-of-range
1681     (string->number "12.13e141414"))
1682
1683   ;; in guile 1.6.7 and earlier, bad polar forms (where the conversion of
1684   ;; the angle gave #f) caused a segv
1685   (pass-if "1@a"
1686     (eq? #f (string->number "1@a"))))
1687
1688 ;;;
1689 ;;; number?
1690 ;;;
1691
1692 (with-test-prefix "number?"
1693   (pass-if (documented? number?))
1694   (pass-if (number? 0))
1695   (pass-if (number? 7))
1696   (pass-if (number? -7))
1697   (pass-if (number? 1.3))
1698   (pass-if (number? (+ 1 fixnum-max)))
1699   (pass-if (number? (- 1 fixnum-min)))
1700   (pass-if (number? 3+4i))
1701   (pass-if (not (number? #\a)))
1702   (pass-if (not (number? "a")))
1703   (pass-if (not (number? (make-vector 0))))
1704   (pass-if (not (number? (cons 1 2))))
1705   (pass-if (not (number? #t)))
1706   (pass-if (not (number? (lambda () #t))))
1707   (pass-if (not (number? (current-input-port)))))
1708
1709 ;;;
1710 ;;; complex?
1711 ;;;
1712
1713 (with-test-prefix "complex?"
1714   (pass-if (documented? complex?))
1715   (pass-if (complex? 0))
1716   (pass-if (complex? 7))
1717   (pass-if (complex? -7))
1718   (pass-if (complex? (+ 1 fixnum-max)))
1719   (pass-if (complex? (- 1 fixnum-min)))
1720   (pass-if (complex? 1.3))
1721   (pass-if (complex? 3+4i))
1722   (pass-if (not (complex? #\a)))
1723   (pass-if (not (complex? "a")))
1724   (pass-if (not (complex? (make-vector 0))))
1725   (pass-if (not (complex? (cons 1 2))))
1726   (pass-if (not (complex? #t)))
1727   (pass-if (not (complex? (lambda () #t))))
1728   (pass-if (not (complex? (current-input-port)))))
1729
1730 ;;;
1731 ;;; real?
1732 ;;;
1733
1734 (with-test-prefix "real?"
1735   (pass-if (documented? real?))
1736   (pass-if (real? 0))
1737   (pass-if (real? 7))
1738   (pass-if (real? -7))
1739   (pass-if (real? (+ 1 fixnum-max)))
1740   (pass-if (real? (- 1 fixnum-min)))
1741   (pass-if (real? 1.3))
1742   (pass-if (real? +inf.0))
1743   (pass-if (real? -inf.0))
1744   (pass-if (real? +nan.0))
1745   (pass-if (not (real? +inf.0-inf.0i)))
1746   (pass-if (not (real? +nan.0+nan.0i)))
1747   (pass-if (not (real? 3+4i)))
1748   (pass-if (not (real? #\a)))
1749   (pass-if (not (real? "a")))
1750   (pass-if (not (real? (make-vector 0))))
1751   (pass-if (not (real? (cons 1 2))))
1752   (pass-if (not (real? #t)))
1753   (pass-if (not (real? (lambda () #t))))
1754   (pass-if (not (real? (current-input-port)))))
1755
1756 ;;;
1757 ;;; rational?
1758 ;;;
1759
1760 (with-test-prefix "rational?"
1761   (pass-if (documented? rational?))
1762   (pass-if (rational? 0))
1763   (pass-if (rational? 7))
1764   (pass-if (rational? -7))
1765   (pass-if (rational? (+ 1 fixnum-max)))
1766   (pass-if (rational? (- 1 fixnum-min)))
1767   (pass-if (rational? 1.3))
1768   (pass-if (not (rational? +inf.0)))
1769   (pass-if (not (rational? -inf.0)))
1770   (pass-if (not (rational? +nan.0)))
1771   (pass-if (not (rational? +inf.0-inf.0i)))
1772   (pass-if (not (rational? +nan.0+nan.0i)))
1773   (pass-if (not (rational? 3+4i)))
1774   (pass-if (not (rational? #\a)))
1775   (pass-if (not (rational? "a")))
1776   (pass-if (not (rational? (make-vector 0))))
1777   (pass-if (not (rational? (cons 1 2))))
1778   (pass-if (not (rational? #t)))
1779   (pass-if (not (rational? (lambda () #t))))
1780   (pass-if (not (rational? (current-input-port)))))
1781
1782 ;;;
1783 ;;; integer?
1784 ;;;
1785
1786 (with-test-prefix "integer?"
1787   (pass-if (documented? integer?))
1788   (pass-if (integer? 0))
1789   (pass-if (integer? 7))
1790   (pass-if (integer? -7))
1791   (pass-if (integer? (+ 1 fixnum-max)))
1792   (pass-if (integer? (- 1 fixnum-min)))
1793   (pass-if (and (= 3+0i (round 3+0i)) (integer? 3+0i)))
1794   (pass-if (and (= 1.0 (round 1.0)) (integer? 1.0)))
1795   (pass-if (not (integer? 1.3)))
1796   (pass-if (not (integer? +inf.0)))
1797   (pass-if (not (integer? -inf.0)))
1798   (pass-if (not (integer? +nan.0)))
1799   (pass-if (not (integer? +inf.0-inf.0i)))
1800   (pass-if (not (integer? +nan.0+nan.0i)))
1801   (pass-if (not (integer? 3+4i)))
1802   (pass-if (not (integer? #\a)))
1803   (pass-if (not (integer? "a")))
1804   (pass-if (not (integer? (make-vector 0))))
1805   (pass-if (not (integer? (cons 1 2))))
1806   (pass-if (not (integer? #t)))
1807   (pass-if (not (integer? (lambda () #t))))
1808   (pass-if (not (integer? (current-input-port)))))
1809
1810 ;;;
1811 ;;; integer?
1812 ;;;
1813
1814 (with-test-prefix "exact-integer?"
1815   (pass-if (documented? exact-integer?))
1816   (pass-if (exact-integer? 0))
1817   (pass-if (exact-integer? 7))
1818   (pass-if (exact-integer? -7))
1819   (pass-if (exact-integer? (+ 1 fixnum-max)))
1820   (pass-if (exact-integer? (- 1 fixnum-min)))
1821   (pass-if (and (= 1.0 (round 1.0))
1822                 (not (exact-integer? 1.0))))
1823   (pass-if (not (exact-integer? 1.3)))
1824   (pass-if (not (exact-integer? +inf.0)))
1825   (pass-if (not (exact-integer? -inf.0)))
1826   (pass-if (not (exact-integer? +nan.0)))
1827   (pass-if (not (exact-integer? +inf.0-inf.0i)))
1828   (pass-if (not (exact-integer? +nan.0+nan.0i)))
1829   (pass-if (not (exact-integer? 3+4i)))
1830   (pass-if (not (exact-integer? #\a)))
1831   (pass-if (not (exact-integer? "a")))
1832   (pass-if (not (exact-integer? (make-vector 0))))
1833   (pass-if (not (exact-integer? (cons 1 2))))
1834   (pass-if (not (exact-integer? #t)))
1835   (pass-if (not (exact-integer? (lambda () #t))))
1836   (pass-if (not (exact-integer? (current-input-port)))))
1837
1838 ;;;
1839 ;;; inexact?
1840 ;;;
1841
1842 (with-test-prefix "inexact?"
1843   (pass-if (documented? inexact?))
1844   (pass-if (not (inexact? 0)))
1845   (pass-if (not (inexact? 7)))
1846   (pass-if (not (inexact? -7)))
1847   (pass-if (not (inexact? (+ 1 fixnum-max))))
1848   (pass-if (not (inexact? (- 1 fixnum-min))))
1849   (pass-if (inexact? 1.3))
1850   (pass-if (inexact? 3.1+4.2i))
1851   (pass-if (inexact? +inf.0))
1852   (pass-if (inexact? -inf.0))
1853   (pass-if (inexact? +nan.0))
1854   (pass-if-exception "char"
1855                      exception:wrong-type-arg
1856                      (not (inexact? #\a)))
1857   (pass-if-exception "string"
1858                      exception:wrong-type-arg
1859                      (not (inexact? "a")))
1860   (pass-if-exception "vector"
1861                      exception:wrong-type-arg
1862                      (not (inexact? (make-vector 0))))
1863   (pass-if-exception "cons"
1864                      exception:wrong-type-arg
1865                      (not (inexact? (cons 1 2))))
1866   (pass-if-exception "bool"
1867                      exception:wrong-type-arg
1868                      (not (inexact? #t)))
1869   (pass-if-exception "procedure"
1870                      exception:wrong-type-arg
1871                      (not (inexact? (lambda () #t))))
1872   (pass-if-exception "port"
1873                      exception:wrong-type-arg
1874                      (not (inexact? (current-input-port)))))
1875
1876 ;;;
1877 ;;; equal?
1878 ;;;
1879
1880 (with-test-prefix "equal?"
1881   (pass-if (documented? equal?))
1882
1883   ;; The following test will fail on platforms
1884   ;; without distinct signed zeroes 0.0 and -0.0.
1885   (pass-if (not (equal? 0.0 -0.0)))
1886
1887   (pass-if (equal? 0 0))
1888   (pass-if (equal? 7 7))
1889   (pass-if (equal? -7 -7))
1890   (pass-if (equal? (+ 1 fixnum-max) (+ 1 fixnum-max)))
1891   (pass-if (equal? (- fixnum-min 1) (- fixnum-min 1)))
1892   (pass-if (equal?  0.0  0.0))
1893   (pass-if (equal? -0.0 -0.0))
1894   (pass-if (equal?  0.0+0.0i  0.0+0.0i))
1895   (pass-if (equal?  0.0-0.0i  0.0-0.0i))
1896   (pass-if (equal? -0.0+0.0i -0.0+0.0i))
1897   (pass-if (not (equal? 0 1)))
1898   (pass-if (not (equal? 0 0.0)))
1899   (pass-if (not (equal? 1 1.0)))
1900   (pass-if (not (equal? 0.0 0)))
1901   (pass-if (not (equal? 1.0 1)))
1902   (pass-if (not (equal? -1.0 -1)))
1903   (pass-if (not (equal? 1.0 1.0+0.0i)))
1904   (pass-if (not (equal? 0.0 0.0+0.0i)))
1905   (pass-if (not (equal? 0.0+0.0i  0.0-0.0i)))
1906   (pass-if (not (equal? 0.0+0.0i -0.0+0.0i)))
1907   (pass-if (not (equal? fixnum-max (+ 1 fixnum-max))))
1908   (pass-if (not (equal? (+ 1 fixnum-max) fixnum-max)))
1909   (pass-if (not (equal? (+ 1 fixnum-max) (+ 2 fixnum-max))))
1910   (pass-if (not (equal? fixnum-min (- fixnum-min 1))))
1911   (pass-if (not (equal? (- fixnum-min 1) fixnum-min)))
1912   (pass-if (not (equal? (- fixnum-min 1) (- fixnum-min 2))))
1913   (pass-if (not (equal? (+ fixnum-max 1) (- fixnum-min 1))))
1914
1915   (pass-if (not (equal? (ash 1 256) +inf.0)))
1916   (pass-if (not (equal? +inf.0 (ash 1 256))))
1917   (pass-if (not (equal? (ash 1 256) -inf.0)))
1918   (pass-if (not (equal? -inf.0 (ash 1 256))))
1919
1920   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
1921   ;; sure we've avoided that
1922   (pass-if (not (equal? (ash 1 1024) +inf.0)))
1923   (pass-if (not (equal? +inf.0 (ash 1 1024))))
1924   (pass-if (not (equal? (- (ash 1 1024)) -inf.0)))
1925   (pass-if (not (equal? -inf.0 (- (ash 1 1024)))))
1926
1927   (pass-if (equal? +nan.0 +nan.0))
1928   (pass-if (equal? +nan.0 +nan.0))
1929   (pass-if (not (equal? +nan.0 0.0+nan.0i)))
1930
1931   (pass-if (not (equal? 0 +nan.0)))
1932   (pass-if (not (equal? +nan.0 0)))
1933   (pass-if (not (equal? 1 +nan.0)))
1934   (pass-if (not (equal? +nan.0 1)))
1935   (pass-if (not (equal? -1 +nan.0)))
1936   (pass-if (not (equal? +nan.0 -1)))
1937
1938   (pass-if (not (equal? (ash 1 256) +nan.0)))
1939   (pass-if (not (equal? +nan.0 (ash 1 256))))
1940   (pass-if (not (equal? (- (ash 1 256)) +nan.0)))
1941   (pass-if (not (equal? +nan.0 (- (ash 1 256)))))
1942
1943   (pass-if (not (equal? (ash 1 8192) +nan.0)))
1944   (pass-if (not (equal? +nan.0 (ash 1 8192))))
1945   (pass-if (not (equal? (- (ash 1 8192)) +nan.0)))
1946   (pass-if (not (equal? +nan.0 (- (ash 1 8192)))))
1947
1948   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
1949   ;; sure we've avoided that
1950   (pass-if (not (equal? (ash 3 1023) +nan.0)))
1951   (pass-if (not (equal? +nan.0 (ash 3 1023)))))
1952
1953 ;;;
1954 ;;; eqv?
1955 ;;;
1956
1957 (with-test-prefix "eqv?"
1958   (pass-if (documented? eqv?))
1959
1960   ;; The following test will fail on platforms
1961   ;; without distinct signed zeroes 0.0 and -0.0.
1962   (pass-if (not (eqv? 0.0 -0.0)))
1963
1964   (pass-if (eqv? 0 0))
1965   (pass-if (eqv? 7 7))
1966   (pass-if (eqv? -7 -7))
1967   (pass-if (eqv? (+ 1 fixnum-max) (+ 1 fixnum-max)))
1968   (pass-if (eqv? (- fixnum-min 1) (- fixnum-min 1)))
1969   (pass-if (eqv?  0.0  0.0))
1970   (pass-if (eqv? -0.0 -0.0))
1971   (pass-if (eqv?  0.0+0.0i  0.0+0.0i))
1972   (pass-if (eqv?  0.0-0.0i  0.0-0.0i))
1973   (pass-if (eqv? -0.0+0.0i -0.0+0.0i))
1974   (pass-if (not (eqv? 0.0 -0.0)))
1975   (pass-if (not (eqv? 0.0  0.0+0.0i)))
1976   (pass-if (not (eqv? 0.0+0.0i  0.0-0.0i)))
1977   (pass-if (not (eqv? 0.0+0.0i -0.0+0.0i)))
1978   (pass-if (not (eqv? 0 1)))
1979   (pass-if (not (eqv? 0 0.0)))
1980   (pass-if (not (eqv? 1 1.0)))
1981   (pass-if (not (eqv? 0.0 0)))
1982   (pass-if (not (eqv? 1.0 1)))
1983   (pass-if (not (eqv? -1.0 -1)))
1984   (pass-if (not (eqv? 1.0 1.0+0.0i)))
1985   (pass-if (not (eqv? 0.0 0.0+0.0i)))
1986   (pass-if (not (eqv? fixnum-max (+ 1 fixnum-max))))
1987   (pass-if (not (eqv? (+ 1 fixnum-max) fixnum-max)))
1988   (pass-if (not (eqv? (+ 1 fixnum-max) (+ 2 fixnum-max))))
1989   (pass-if (not (eqv? fixnum-min (- fixnum-min 1))))
1990   (pass-if (not (eqv? (- fixnum-min 1) fixnum-min)))
1991   (pass-if (not (eqv? (- fixnum-min 1) (- fixnum-min 2))))
1992   (pass-if (not (eqv? (+ fixnum-max 1) (- fixnum-min 1))))
1993
1994   (pass-if (not (eqv? (ash 1 256) +inf.0)))
1995   (pass-if (not (eqv? +inf.0 (ash 1 256))))
1996   (pass-if (not (eqv? (ash 1 256) -inf.0)))
1997   (pass-if (not (eqv? -inf.0 (ash 1 256))))
1998
1999   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
2000   ;; sure we've avoided that
2001   (pass-if (not (eqv? (ash 1 1024) +inf.0)))
2002   (pass-if (not (eqv? +inf.0 (ash 1 1024))))
2003   (pass-if (not (eqv? (- (ash 1 1024)) -inf.0)))
2004   (pass-if (not (eqv? -inf.0 (- (ash 1 1024)))))
2005
2006   (pass-if (eqv? +nan.0 +nan.0))
2007   (pass-if (not (eqv? +nan.0 0.0+nan.0i)))
2008
2009   (pass-if (not (eqv? 0 +nan.0)))
2010   (pass-if (not (eqv? +nan.0 0)))
2011   (pass-if (not (eqv? 1 +nan.0)))
2012   (pass-if (not (eqv? +nan.0 1)))
2013   (pass-if (not (eqv? -1 +nan.0)))
2014   (pass-if (not (eqv? +nan.0 -1)))
2015
2016   (pass-if (not (eqv? (ash 1 256) +nan.0)))
2017   (pass-if (not (eqv? +nan.0 (ash 1 256))))
2018   (pass-if (not (eqv? (- (ash 1 256)) +nan.0)))
2019   (pass-if (not (eqv? +nan.0 (- (ash 1 256)))))
2020
2021   (pass-if (not (eqv? (ash 1 8192) +nan.0)))
2022   (pass-if (not (eqv? +nan.0 (ash 1 8192))))
2023   (pass-if (not (eqv? (- (ash 1 8192)) +nan.0)))
2024   (pass-if (not (eqv? +nan.0 (- (ash 1 8192)))))
2025
2026   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
2027   ;; sure we've avoided that
2028   (pass-if (not (eqv? (ash 3 1023) +nan.0)))
2029   (pass-if (not (eqv? +nan.0 (ash 3 1023)))))
2030
2031 ;;;
2032 ;;; =
2033 ;;;
2034
2035 (with-test-prefix "="
2036   (pass-if (documented? =))
2037   (pass-if (= 7 7))
2038   (pass-if (= -7 -7))
2039   (pass-if (= 1.0 1))
2040   (pass-if (= 1 1.0))
2041   (pass-if (= -1 -1.0))
2042   (pass-if (= 0.0  0.0))
2043   (pass-if (= 0.0 -0.0))
2044   (pass-if (= 1 1.0+0.0i))
2045
2046   (pass-if (= 0  0))
2047   (pass-if (= 0  0.0))
2048   (pass-if (= 0 -0.0))
2049   (pass-if (= 0  0.0+0.0i))
2050   (pass-if (= 0  0.0-0.0i))
2051   (pass-if (= 0  0.0+0.0i))
2052   (pass-if (= 0 -0.0-0.0i))
2053
2054   (pass-if (=  0        0))
2055   (pass-if (=  0.0      0))
2056   (pass-if (= -0.0      0))
2057   (pass-if (=  0.0+0.0i 0))
2058   (pass-if (=  0.0-0.0i 0))
2059   (pass-if (=  0.0+0.0i 0))
2060   (pass-if (= -0.0-0.0i 0))
2061
2062   (pass-if (= 0.0+0.0i  0.0-0.0i))
2063   (pass-if (= 0.0+0.0i -0.0+0.0i))
2064
2065   (pass-if (= (+ 1 fixnum-max) (+ 1 fixnum-max)))
2066   (pass-if (= (- fixnum-min 1) (- fixnum-min 1)))
2067   (pass-if (not (= 0 1)))
2068   (pass-if (not (= fixnum-max (+ 1 fixnum-max))))
2069   (pass-if (not (= (+ 1 fixnum-max) fixnum-max)))
2070   (pass-if (not (= (+ 1 fixnum-max) (+ 2 fixnum-max))))
2071   (pass-if (not (= fixnum-min (- fixnum-min 1))))
2072   (pass-if (not (= (- fixnum-min 1) fixnum-min)))
2073   (pass-if (not (= (- fixnum-min 1) (- fixnum-min 2))))
2074   (pass-if (not (= (+ fixnum-max 1) (- fixnum-min 1))))
2075
2076   (pass-if (not (= (ash 1 256) +inf.0)))
2077   (pass-if (not (= +inf.0 (ash 1 256))))
2078   (pass-if (not (= (ash 1 256) -inf.0)))
2079   (pass-if (not (= -inf.0 (ash 1 256))))
2080
2081   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
2082   ;; sure we've avoided that
2083   (pass-if (not (= (ash 1 1024) +inf.0)))
2084   (pass-if (not (= +inf.0 (ash 1 1024))))
2085   (pass-if (not (= (- (ash 1 1024)) -inf.0)))
2086   (pass-if (not (= -inf.0 (- (ash 1 1024)))))
2087
2088   (pass-if (not (= +nan.0 +nan.0)))
2089   (pass-if (not (= 0 +nan.0)))
2090   (pass-if (not (= +nan.0 0)))
2091   (pass-if (not (= 1 +nan.0)))
2092   (pass-if (not (= +nan.0 1)))
2093   (pass-if (not (= -1 +nan.0)))
2094   (pass-if (not (= +nan.0 -1)))
2095
2096   (pass-if (not (= (ash 1 256) +nan.0)))
2097   (pass-if (not (= +nan.0 (ash 1 256))))
2098   (pass-if (not (= (- (ash 1 256)) +nan.0)))
2099   (pass-if (not (= +nan.0 (- (ash 1 256)))))
2100
2101   (pass-if (not (= (ash 1 8192) +nan.0)))
2102   (pass-if (not (= +nan.0 (ash 1 8192))))
2103   (pass-if (not (= (- (ash 1 8192)) +nan.0)))
2104   (pass-if (not (= +nan.0 (- (ash 1 8192)))))
2105
2106   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
2107   ;; sure we've avoided that
2108   (pass-if (not (= (ash 3 1023) +nan.0)))
2109   (pass-if (not (= +nan.0 (ash 3 1023))))
2110
2111   (pass-if (= 1/2 0.5))
2112   (pass-if (not (= 1/3 0.333333333333333333333333333333333)))
2113   (pass-if (not (= 2/3 0.5)))
2114   (pass-if (not (= 0.5 (+ 1/2 (/ 1 (ash 1 1000))))))
2115
2116   (pass-if (= 1/2 0.5+0i))
2117   (pass-if (not (= 0.333333333333333333333333333333333 1/3)))
2118   (pass-if (not (= 2/3 0.5+0i)))
2119   (pass-if (not (= 1/2 0+0.5i)))
2120
2121   (pass-if (= 0.5 1/2))
2122   (pass-if (not (= 0.5 2/3)))
2123   (pass-if (not (= (+ 1/2 (/ 1 (ash 1 1000))) 0.5)))
2124
2125   (pass-if (= 0.5+0i 1/2))
2126   (pass-if (not (= 0.5+0i 2/3)))
2127   (pass-if (not (= 0+0.5i 1/2)))
2128
2129   ;; prior to guile 1.8, inum/flonum comparisons were done just by
2130   ;; converting the inum to a double, which on a 64-bit would round making
2131   ;; say inexact 2^58 appear equal to exact 2^58+1
2132   (pass-if (= (ash-flo 1.0 58) (ash 1 58)))
2133   (pass-if (not (= (ash-flo 1.0 58) (1+ (ash 1 58)))))
2134   (pass-if (not (= (ash-flo 1.0 58) (1- (ash 1 58)))))
2135   (pass-if (= (ash 1 58) (ash-flo 1.0 58)))
2136   (pass-if (not (= (1+ (ash 1 58)) (ash-flo 1.0 58))))
2137   (pass-if (not (= (1- (ash 1 58)) (ash-flo 1.0 58))))
2138
2139   ;; prior to guile 2.0.10, inum/complex comparisons were done just by
2140   ;; converting the inum to a double, which on a 64-bit would round making
2141   ;; say inexact 2^58 appear equal to exact 2^58+1
2142   (pass-if (= (+ +0.0i (ash-flo 1.0 58)) (ash 1 58)))
2143   (pass-if (not (= (+ +0.0i (ash-flo 1.0 58)) (1+ (ash 1 58)))))
2144   (pass-if (not (= (+ +0.0i (ash-flo 1.0 58)) (1- (ash 1 58)))))
2145   (pass-if (= (ash 1 58) (+ +0.0i (ash-flo 1.0 58))))
2146   (pass-if (not (= (1+ (ash 1 58)) (+ +0.0i (ash-flo 1.0 58)))))
2147   (pass-if (not (= (1- (ash 1 58)) (+ +0.0i (ash-flo 1.0 58)))))
2148
2149   ;; prior to guile 2.0.10, fraction/flonum and fraction/complex
2150   ;; comparisons mishandled infinities.
2151   (pass-if (not (= 1/2 +inf.0)))
2152   (pass-if (not (= 1/2 -inf.0)))
2153   (pass-if (not (= +inf.0 1/2)))
2154   (pass-if (not (= -inf.0 1/2)))
2155   (pass-if (not (= 1/2 +inf.0+0.0i)))
2156   (pass-if (not (= 1/2 -inf.0+0.0i)))
2157   (pass-if (not (= +inf.0+0.0i 1/2)))
2158   (pass-if (not (= -inf.0+0.0i 1/2))))
2159
2160 ;;;
2161 ;;; <
2162 ;;;
2163
2164 (with-test-prefix "<"
2165
2166   (pass-if "documented?"
2167     (documented? <))
2168
2169   (with-test-prefix "(< 0 n)"
2170
2171     (pass-if "n = 0"
2172       (not (< 0 0)))
2173
2174     (pass-if "n = 0.0"
2175       (not (< 0 0.0)))
2176
2177     (pass-if "n = 1"
2178       (< 0 1))
2179
2180     (pass-if "n = 1.0"
2181       (< 0 1.0))
2182
2183     (pass-if "n = -1"
2184       (not (< 0 -1)))
2185
2186     (pass-if "n = -1.0"
2187       (not (< 0 -1.0)))
2188
2189     (pass-if "n = fixnum-max"
2190       (< 0 fixnum-max))
2191
2192     (pass-if "n = fixnum-max + 1"
2193       (< 0 (+ fixnum-max 1)))
2194
2195     (pass-if "n = fixnum-min"
2196       (not (< 0 fixnum-min)))
2197
2198     (pass-if "n = fixnum-min - 1"
2199       (not (< 0 (- fixnum-min 1)))))
2200
2201   (with-test-prefix "(< 0.0 n)"
2202
2203     (pass-if "n = 0"
2204       (not (< 0.0 0)))
2205
2206     (pass-if "n = 0.0"
2207       (not (< 0.0 0.0)))
2208
2209     (pass-if "n = -0.0"
2210       (not (< 0.0 -0.0)))
2211
2212     (pass-if "n = 1"
2213       (< 0.0 1))
2214
2215     (pass-if "n = 1.0"
2216       (< 0.0 1.0))
2217
2218     (pass-if "n = -1"
2219       (not (< 0.0 -1)))
2220
2221     (pass-if "n = -1.0"
2222       (not (< 0.0 -1.0)))
2223
2224     (pass-if "n = fixnum-max"
2225       (< 0.0 fixnum-max))
2226
2227     (pass-if "n = fixnum-max + 1"
2228       (< 0.0 (+ fixnum-max 1)))
2229
2230     (pass-if "n = fixnum-min"
2231       (not (< 0.0 fixnum-min)))
2232
2233     (pass-if "n = fixnum-min - 1"
2234       (not (< 0.0 (- fixnum-min 1)))))
2235
2236   (pass-if (not (< -0.0 0.0)))
2237   (pass-if (not (< -0.0 -0.0)))
2238
2239   (with-test-prefix "(< 1 n)"
2240
2241     (pass-if "n = 0"
2242       (not (< 1 0)))
2243
2244     (pass-if "n = 0.0"
2245       (not (< 1 0.0)))
2246
2247     (pass-if "n = 1"
2248       (not (< 1 1)))
2249
2250     (pass-if "n = 1.0"
2251       (not (< 1 1.0)))
2252
2253     (pass-if "n = -1"
2254       (not (< 1 -1)))
2255
2256     (pass-if "n = -1.0"
2257       (not (< 1 -1.0)))
2258
2259     (pass-if "n = fixnum-max"
2260       (< 1 fixnum-max))
2261
2262     (pass-if "n = fixnum-max + 1"
2263       (< 1 (+ fixnum-max 1)))
2264
2265     (pass-if "n = fixnum-min"
2266       (not (< 1 fixnum-min)))
2267
2268     (pass-if "n = fixnum-min - 1"
2269       (not (< 1 (- fixnum-min 1)))))
2270
2271   (with-test-prefix "(< 1.0 n)"
2272
2273     (pass-if "n = 0"
2274       (not (< 1.0 0)))
2275
2276     (pass-if "n = 0.0"
2277       (not (< 1.0 0.0)))
2278
2279     (pass-if "n = 1"
2280       (not (< 1.0 1)))
2281
2282     (pass-if "n = 1.0"
2283       (not (< 1.0 1.0)))
2284
2285     (pass-if "n = -1"
2286       (not (< 1.0 -1)))
2287
2288     (pass-if "n = -1.0"
2289       (not (< 1.0 -1.0)))
2290
2291     (pass-if "n = fixnum-max"
2292       (< 1.0 fixnum-max))
2293
2294     (pass-if "n = fixnum-max + 1"
2295       (< 1.0 (+ fixnum-max 1)))
2296
2297     (pass-if "n = fixnum-min"
2298       (not (< 1.0 fixnum-min)))
2299
2300     (pass-if "n = fixnum-min - 1"
2301       (not (< 1.0 (- fixnum-min 1)))))
2302
2303   (with-test-prefix "(< -1 n)"
2304
2305     (pass-if "n = 0"
2306       (< -1 0))
2307
2308     (pass-if "n = 0.0"
2309       (< -1 0.0))
2310
2311     (pass-if "n = 1"
2312       (< -1 1))
2313
2314     (pass-if "n = 1.0"
2315       (< -1 1.0))
2316
2317     (pass-if "n = -1"
2318       (not (< -1 -1)))
2319
2320     (pass-if "n = -1.0"
2321       (not (< -1 -1.0)))
2322
2323     (pass-if "n = fixnum-max"
2324       (< -1 fixnum-max))
2325
2326     (pass-if "n = fixnum-max + 1"
2327       (< -1 (+ fixnum-max 1)))
2328
2329     (pass-if "n = fixnum-min"
2330       (not (< -1 fixnum-min)))
2331
2332     (pass-if "n = fixnum-min - 1"
2333       (not (< -1 (- fixnum-min 1)))))
2334
2335   (with-test-prefix "(< -1.0 n)"
2336
2337     (pass-if "n = 0"
2338       (< -1.0 0))
2339
2340     (pass-if "n = 0.0"
2341       (< -1.0 0.0))
2342
2343     (pass-if "n = 1"
2344       (< -1.0 1))
2345
2346     (pass-if "n = 1.0"
2347       (< -1.0 1.0))
2348
2349     (pass-if "n = -1"
2350       (not (< -1.0 -1)))
2351
2352     (pass-if "n = -1.0"
2353       (not (< -1.0 -1.0)))
2354
2355     (pass-if "n = fixnum-max"
2356       (< -1.0 fixnum-max))
2357
2358     (pass-if "n = fixnum-max + 1"
2359       (< -1.0 (+ fixnum-max 1)))
2360
2361     (pass-if "n = fixnum-min"
2362       (not (< -1.0 fixnum-min)))
2363
2364     (pass-if "n = fixnum-min - 1"
2365       (not (< -1.0 (- fixnum-min 1)))))
2366
2367   (with-test-prefix "(< fixnum-max n)"
2368
2369     (pass-if "n = 0"
2370       (not (< fixnum-max 0)))
2371
2372     (pass-if "n = 0.0"
2373       (not (< fixnum-max 0.0)))
2374
2375     (pass-if "n = 1"
2376       (not (< fixnum-max 1)))
2377
2378     (pass-if "n = 1.0"
2379       (not (< fixnum-max 1.0)))
2380
2381     (pass-if "n = -1"
2382       (not (< fixnum-max -1)))
2383
2384     (pass-if "n = -1.0"
2385       (not (< fixnum-max -1.0)))
2386
2387     (pass-if "n = fixnum-max"
2388       (not (< fixnum-max fixnum-max)))
2389
2390     (pass-if "n = fixnum-max + 1"
2391       (< fixnum-max (+ fixnum-max 1)))
2392
2393     (pass-if "n = fixnum-min"
2394       (not (< fixnum-max fixnum-min)))
2395
2396     (pass-if "n = fixnum-min - 1"
2397       (not (< fixnum-max (- fixnum-min 1)))))
2398
2399   (with-test-prefix "(< (+ fixnum-max 1) n)"
2400
2401     (pass-if "n = 0"
2402       (not (< (+ fixnum-max 1) 0)))
2403
2404     (pass-if "n = 0.0"
2405       (not (< (+ fixnum-max 1) 0.0)))
2406
2407     (pass-if "n = 1"
2408       (not (< (+ fixnum-max 1) 1)))
2409
2410     (pass-if "n = 1.0"
2411       (not (< (+ fixnum-max 1) 1.0)))
2412
2413     (pass-if "n = -1"
2414       (not (< (+ fixnum-max 1) -1)))
2415
2416     (pass-if "n = -1.0"
2417       (not (< (+ fixnum-max 1) -1.0)))
2418
2419     (pass-if "n = fixnum-max"
2420       (not (< (+ fixnum-max 1) fixnum-max)))
2421
2422     (pass-if "n = fixnum-max + 1"
2423       (not (< (+ fixnum-max 1) (+ fixnum-max 1))))
2424
2425     (pass-if "n = fixnum-min"
2426       (not (< (+ fixnum-max 1) fixnum-min)))
2427
2428     (pass-if "n = fixnum-min - 1"
2429       (not (< (+ fixnum-max 1) (- fixnum-min 1)))))
2430
2431   (with-test-prefix "(< fixnum-min n)"
2432
2433     (pass-if "n = 0"
2434       (< fixnum-min 0))
2435
2436     (pass-if "n = 0.0"
2437       (< fixnum-min 0.0))
2438
2439     (pass-if "n = 1"
2440       (< fixnum-min 1))
2441
2442     (pass-if "n = 1.0"
2443       (< fixnum-min 1.0))
2444
2445     (pass-if "n = -1"
2446       (< fixnum-min -1))
2447
2448     (pass-if "n = -1.0"
2449       (< fixnum-min -1.0))
2450
2451     (pass-if "n = fixnum-max"
2452       (< fixnum-min fixnum-max))
2453
2454     (pass-if "n = fixnum-max + 1"
2455       (< fixnum-min (+ fixnum-max 1)))
2456
2457     (pass-if "n = fixnum-min"
2458       (not (< fixnum-min fixnum-min)))
2459
2460     (pass-if "n = fixnum-min - 1"
2461       (not (< fixnum-min (- fixnum-min 1)))))
2462
2463   (with-test-prefix "(< (- fixnum-min 1) n)"
2464
2465     (pass-if "n = 0"
2466       (< (- fixnum-min 1) 0))
2467
2468     (pass-if "n = 0.0"
2469       (< (- fixnum-min 1) 0.0))
2470
2471     (pass-if "n = 1"
2472       (< (- fixnum-min 1) 1))
2473
2474     (pass-if "n = 1.0"
2475       (< (- fixnum-min 1) 1.0))
2476
2477     (pass-if "n = -1"
2478       (< (- fixnum-min 1) -1))
2479
2480     (pass-if "n = -1.0"
2481       (< (- fixnum-min 1) -1.0))
2482
2483     (pass-if "n = fixnum-max"
2484       (< (- fixnum-min 1) fixnum-max))
2485
2486     (pass-if "n = fixnum-max + 1"
2487       (< (- fixnum-min 1) (+ fixnum-max 1)))
2488
2489     (pass-if "n = fixnum-min"
2490       (< (- fixnum-min 1) fixnum-min))
2491
2492     (pass-if "n = fixnum-min - 1"
2493       (not (< (- fixnum-min 1) (- fixnum-min 1)))))
2494
2495   (pass-if (< (ash 1 256) +inf.0))
2496   (pass-if (not (< +inf.0 (ash 1 256))))
2497   (pass-if (not (< (ash 1 256) -inf.0)))
2498   (pass-if (< -inf.0 (ash 1 256)))
2499
2500   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
2501   ;; sure we've avoided that
2502   (pass-if (< (1- (ash 1 1024)) +inf.0))
2503   (pass-if (<     (ash 1 1024)  +inf.0))
2504   (pass-if (< (1+ (ash 1 1024)) +inf.0))
2505   (pass-if (not (< +inf.0 (1- (ash 1 1024)))))
2506   (pass-if (not (< +inf.0     (ash 1 1024))))
2507   (pass-if (not (< +inf.0 (1+ (ash 1 1024)))))
2508   (pass-if (< -inf.0 (- (1- (ash 1 1024)))))
2509   (pass-if (< -inf.0 (-     (ash 1 1024))))
2510   (pass-if (< -inf.0 (- (1+ (ash 1 1024)))))
2511   (pass-if (not (< (- (1- (ash 1 1024))) -inf.0)))
2512   (pass-if (not (< (-     (ash 1 1024))  -inf.0)))
2513   (pass-if (not (< (- (1+ (ash 1 1024))) -inf.0)))
2514
2515   (pass-if (not (< +nan.0 +nan.0)))
2516   (pass-if (not (< 0 +nan.0)))
2517   (pass-if (not (< +nan.0 0)))
2518   (pass-if (not (< 1 +nan.0)))
2519   (pass-if (not (< +nan.0 1)))
2520   (pass-if (not (< -1 +nan.0)))
2521   (pass-if (not (< +nan.0 -1)))
2522
2523   (pass-if (not (< (ash 1 256) +nan.0)))
2524   (pass-if (not (< +nan.0 (ash 1 256))))
2525   (pass-if (not (< (- (ash 1 256)) +nan.0)))
2526   (pass-if (not (< +nan.0 (- (ash 1 256)))))
2527
2528   (pass-if (not (< (ash 1 8192) +nan.0)))
2529   (pass-if (not (< +nan.0 (ash 1 8192))))
2530   (pass-if (not (< (- (ash 1 8192)) +nan.0)))
2531   (pass-if (not (< +nan.0 (- (ash 1 8192)))))
2532
2533   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
2534   ;; sure we've avoided that
2535   (pass-if (not (< (ash 3 1023) +nan.0)))
2536   (pass-if (not (< (1+ (ash 3 1023)) +nan.0)))
2537   (pass-if (not (< (1- (ash 3 1023)) +nan.0)))
2538   (pass-if (not (< +nan.0 (ash 3 1023))))
2539   (pass-if (not (< +nan.0 (1+ (ash 3 1023)))))
2540   (pass-if (not (< +nan.0 (1- (ash 3 1023)))))
2541
2542   (with-test-prefix "inum/frac"
2543     (pass-if (< 2 9/4))
2544     (pass-if (< -2 9/4))
2545     (pass-if (< -2 7/4))
2546     (pass-if (< -2 -7/4))
2547     (pass-if (eq? #f (< 2 7/4)))
2548     (pass-if (eq? #f (< 2 -7/4)))
2549     (pass-if (eq? #f (< 2 -9/4)))
2550     (pass-if (eq? #f (< -2 -9/4))))
2551
2552   (with-test-prefix "bignum/frac"
2553     (let ((x (ash 1 2048)))
2554       (pass-if (< x (* 4/3 x)))
2555       (pass-if (< (- x) (* 4/3 x)))
2556       (pass-if (< (- x) (* 2/3 x)))
2557       (pass-if (< (- x) (* -2/3 x)))
2558       (pass-if (eq? #f (< x (* 2/3 x))))
2559       (pass-if (eq? #f (< x (* -2/3 x))))
2560       (pass-if (eq? #f (< x (* -4/3 x))))
2561       (pass-if (eq? #f (< (- x) (* -4/3 x))))))
2562
2563   (with-test-prefix "inum/flonum"
2564     (pass-if (< 4 4.5))
2565     (pass-if (< 4.5 5))
2566     (pass-if (< -5 -4.5))
2567     (pass-if (< -4.5 4))
2568     (pass-if (not (< 4.5 4)))
2569     (pass-if (not (< 5 4.5)))
2570     (pass-if (not (< -4.5 -5)))
2571     (pass-if (not (< 4 -4.5)))
2572
2573     (pass-if (< 4 +inf.0))
2574     (pass-if (< -4 +inf.0))
2575     (pass-if (< -inf.0 4))
2576     (pass-if (< -inf.0 -4))
2577     (pass-if (not (< +inf.0 4)))
2578     (pass-if (not (< +inf.0 -4)))
2579     (pass-if (not (< 4 -inf.0)))
2580     (pass-if (not (< -4 -inf.0)))
2581
2582     (pass-if (not (< +nan.0 4)))
2583     (pass-if (not (< +nan.0 -4)))
2584     (pass-if (not (< 4 +nan.0)))
2585     (pass-if (not (< -4 +nan.0)))
2586
2587     (pass-if (< most-positive-fixnum (expt 2.0 fixnum-bit)))
2588     (pass-if (not (< (expt 2.0 fixnum-bit) most-positive-fixnum)))
2589
2590     (pass-if (< (- (expt 2.0 fixnum-bit)) most-negative-fixnum))
2591     (pass-if (not (< most-negative-fixnum (- (expt 2.0 fixnum-bit)))))
2592
2593     ;; Prior to guile 2.0.10, we would unconditionally convert the inum
2594     ;; to a double, which on a 64-bit system could result in a
2595     ;; significant change in its value, thus corrupting the comparison.
2596     (pass-if (< most-positive-fixnum (exact->inexact (+ 1 most-positive-fixnum))))
2597     (pass-if (< (exact->inexact (- (+ 1 most-positive-fixnum))) (- most-positive-fixnum))))
2598
2599   (with-test-prefix "flonum/frac"
2600     (pass-if (< 0.75 4/3))
2601     (pass-if (< -0.75 4/3))
2602     (pass-if (< -0.75 2/3))
2603     (pass-if (< -0.75 -2/3))
2604     (pass-if (eq? #f (< 0.75 2/3)))
2605     (pass-if (eq? #f (< 0.75 -2/3)))
2606     (pass-if (eq? #f (< 0.75 -4/3)))
2607     (pass-if (eq? #f (< -0.75 -4/3)))
2608
2609     (pass-if (< -inf.0 4/3))
2610     (pass-if (< -inf.0 -4/3))
2611     (pass-if (eq? #f (< +inf.0 4/3)))
2612     (pass-if (eq? #f (< +inf.0 -4/3)))
2613
2614     (pass-if (eq? #f (< +nan.0 4/3)))
2615     (pass-if (eq? #f (< +nan.0 -4/3))))
2616
2617   (with-test-prefix "frac/inum"
2618     (pass-if (< 7/4 2))
2619     (pass-if (< -7/4 2))
2620     (pass-if (< -9/4 2))
2621     (pass-if (< -9/4 -2))
2622     (pass-if (eq? #f (< 9/4 2)))
2623     (pass-if (eq? #f (< 9/4 -2)))
2624     (pass-if (eq? #f (< 7/4 -2)))
2625     (pass-if (eq? #f (< -7/4 -2))))
2626
2627   (with-test-prefix "frac/bignum"
2628     (let ((x (ash 1 2048)))
2629       (pass-if (< (* 2/3 x) x))
2630       (pass-if (< (* -2/3 x) x))
2631       (pass-if (< (* -4/3 x) x))
2632       (pass-if (< (* -4/3 x) (- x)))
2633       (pass-if (eq? #f (< (* 4/3 x) x)))
2634       (pass-if (eq? #f (< (* 4/3 x) (- x))))
2635       (pass-if (eq? #f (< (* 2/3 x) (- x))))
2636       (pass-if (eq? #f (< (* -2/3 x) (- x))))))
2637
2638   (with-test-prefix "frac/flonum"
2639     (pass-if (< 2/3 0.75))
2640     (pass-if (< -2/3 0.75))
2641     (pass-if (< -4/3 0.75))
2642     (pass-if (< -4/3 -0.75))
2643     (pass-if (eq? #f (< 4/3 0.75)))
2644     (pass-if (eq? #f (< 4/3 -0.75)))
2645     (pass-if (eq? #f (< 2/3 -0.75)))
2646     (pass-if (eq? #f (< -2/3 -0.75)))
2647
2648     (pass-if (< 4/3 +inf.0))
2649     (pass-if (< -4/3 +inf.0))
2650     (pass-if (eq? #f (< 4/3 -inf.0)))
2651     (pass-if (eq? #f (< -4/3 -inf.0)))
2652
2653     (pass-if (eq? #f (< 4/3 +nan.0)))
2654     (pass-if (eq? #f (< -4/3 +nan.0))))
2655
2656   (with-test-prefix "frac/frac"
2657     (pass-if (< 2/3 6/7))
2658     (pass-if (< -2/3 6/7))
2659     (pass-if (< -4/3 6/7))
2660     (pass-if (< -4/3 -6/7))
2661     (pass-if (eq? #f (< 4/3 6/7)))
2662     (pass-if (eq? #f (< 4/3 -6/7)))
2663     (pass-if (eq? #f (< 2/3 -6/7)))
2664     (pass-if (eq? #f (< -2/3 -6/7)))))
2665
2666 ;;;
2667 ;;; >
2668 ;;;
2669
2670 ;; currently not tested -- implementation is trivial
2671 ;; (> x y) is implemented as (< y x)
2672 ;; FIXME: tests should probably be added in case we change implementation.
2673
2674 ;;;
2675 ;;; <=
2676 ;;;
2677
2678 ;; currently not tested -- implementation is trivial
2679 ;; (<= x y) is implemented as (not (< y x))
2680 ;; FIXME: tests should probably be added in case we change implementation.
2681
2682 ;;;
2683 ;;; >=
2684 ;;;
2685
2686 ;; currently not tested -- implementation is trivial
2687 ;; (>= x y) is implemented as (not (< x y))
2688 ;; FIXME: tests should probably be added in case we change implementation.
2689
2690 ;;;
2691 ;;; zero?
2692 ;;;
2693
2694 (with-test-prefix "zero?"
2695   (pass-if (documented? zero?))
2696
2697   (pass-if (zero?  0))
2698   (pass-if (zero?  0.0))
2699   (pass-if (zero? -0.0))
2700
2701   (pass-if (zero?  0.0+0.0i))
2702   (pass-if (zero?  0.0-0.0i))
2703   (pass-if (zero?  0.0+0.0i))
2704   (pass-if (zero? -0.0-0.0i))
2705
2706   (pass-if (not (zero?  7)))
2707   (pass-if (not (zero? -7)))
2708   (pass-if (not (zero? 1/7)))
2709   (pass-if (not (zero? -inf.0)))
2710   (pass-if (not (zero? +inf.0)))
2711   (pass-if (not (zero? +nan.0)))
2712   (pass-if (not (zero? (+ 1 fixnum-max))))
2713   (pass-if (not (zero? (- 1 fixnum-min))))
2714   (pass-if (not (zero? 1.3)))
2715   (pass-if (not (zero? 3.1+4.2i)))
2716   (pass-if (not (zero? 1.0+0.0i)))
2717   (pass-if (not (zero? 0.0-1.0i))))
2718
2719 ;;;
2720 ;;; positive?
2721 ;;;
2722
2723 (with-test-prefix "positive?"
2724   (pass-if (documented? positive?))
2725   (pass-if (positive? 1))
2726   (pass-if (positive? (+ fixnum-max 1)))
2727   (pass-if (positive? 1.3))
2728   (pass-if (not (positive? 0)))
2729   (pass-if (not (positive? -1)))
2730   (pass-if (not (positive? (- fixnum-min 1))))
2731   (pass-if (not (positive? -1.3))))
2732
2733 ;;;
2734 ;;; negative?
2735 ;;;
2736
2737 (with-test-prefix "negative?"
2738   (pass-if (documented? negative?))
2739   (pass-if (not (negative? 1)))
2740   (pass-if (not (negative? (+ fixnum-max 1))))
2741   (pass-if (not (negative? 1.3)))
2742   (pass-if (not (negative? 0)))
2743   (pass-if (negative? -1))
2744   (pass-if (negative? (- fixnum-min 1)))
2745   (pass-if (negative? -1.3)))
2746
2747 ;;;
2748 ;;; max
2749 ;;;
2750
2751 (with-test-prefix "max"
2752   (pass-if-exception "no args" exception:wrong-num-args
2753     (max))
2754
2755   (pass-if-exception "one complex" exception:wrong-type-arg
2756     (max 1+i))
2757
2758   (pass-if-exception "inum/complex" exception:wrong-type-arg
2759     (max 123 1+i))
2760   (pass-if-exception "big/complex" exception:wrong-type-arg
2761     (max 9999999999999999999999999999999999999999 1+i))
2762   (pass-if-exception "real/complex" exception:wrong-type-arg
2763     (max 123.0 1+i))
2764   (pass-if-exception "frac/complex" exception:wrong-type-arg
2765     (max 123/456 1+i))
2766
2767   (pass-if-exception "complex/inum" exception:wrong-type-arg
2768     (max 1+i 123))
2769   (pass-if-exception "complex/big" exception:wrong-type-arg
2770     (max 1+i 9999999999999999999999999999999999999999))
2771   (pass-if-exception "complex/real" exception:wrong-type-arg
2772     (max 1+i 123.0))
2773   (pass-if-exception "complex/frac" exception:wrong-type-arg
2774     (max 1+i 123/456))
2775
2776   (let ((big*2 (* fixnum-max 2))
2777         (big*3 (* fixnum-max 3))
2778         (big*4 (* fixnum-max 4))
2779         (big*5 (* fixnum-max 5)))
2780
2781     (with-test-prefix "inum / frac"
2782       (pass-if (eqv? 3 (max 3 5/2)))
2783       (pass-if (eqv? 5/2 (max 2 5/2))))
2784
2785     (with-test-prefix "frac / inum"
2786       (pass-if (eqv? 3 (max 5/2 3)))
2787       (pass-if (eqv? 5/2 (max 5/2 2))))
2788
2789     (with-test-prefix "infinities and NaNs"
2790       ;; +inf.0 beats everything except NaNs
2791       (pass-if (eqv?  +inf.0   (max   +inf.0    123   )))
2792       (pass-if (eqv?  +inf.0   (max    123     +inf.0 )))
2793       (pass-if (eqv?  +inf.0   (max   +inf.0   -123.3 )))
2794       (pass-if (eqv?  +inf.0   (max   -123.3   +inf.0 )))
2795       (pass-if (eqv?  +inf.0   (max   +inf.0   -7/2   )))
2796       (pass-if (eqv?  +inf.0   (max   -7/2     +inf.0 )))
2797       (pass-if (eqv?  +inf.0   (max   +inf.0  -1e20   )))
2798       (pass-if (eqv?  +inf.0   (max  -1e20     +inf.0 )))
2799       (pass-if (eqv?  +inf.0   (max   +inf.0 (- big*2))))
2800       (pass-if (eqv?  +inf.0   (max (- big*2)  +inf.0 )))
2801       (pass-if (eqv?  +inf.0   (max   +inf.0   +inf.0 )))
2802       (pass-if (eqv?  +inf.0   (max   +inf.0   +inf.0 )))
2803       (pass-if (eqv?  +inf.0   (max   +inf.0   +inf.0 )))
2804
2805       ;; NaNs beat everything
2806       (pass-if (real-nan?      (max   +nan.0    123   )))
2807       (pass-if (real-nan?      (max    123     +nan.0 )))
2808       (pass-if (real-nan?      (max   +nan.0    123.3 )))
2809       (pass-if (real-nan?      (max    123.3   +nan.0 )))
2810       (pass-if (real-nan?      (max   +nan.0   -7/2   )))
2811       (pass-if (real-nan?      (max   -7/2     +nan.0 )))
2812       (pass-if (real-nan?      (max   +nan.0  -1e20   )))
2813       (pass-if (real-nan?      (max  -1e20     +nan.0 )))
2814       (pass-if (real-nan?      (max   +nan.0 (- big*2))))
2815       (pass-if (real-nan?      (max (- big*2)  +nan.0 )))
2816       (pass-if (real-nan?      (max   +nan.0   -inf.0 )))
2817       (pass-if (real-nan?      (max   -inf.0   +nan.0 )))
2818       (pass-if (real-nan?      (max   +nan.0   +nan.0 )))
2819       (pass-if (real-nan?      (max   +inf.0   +nan.0 )))
2820       (pass-if (real-nan?      (max   +nan.0   +inf.0 )))
2821
2822       ;; -inf.0 always loses, except against itself
2823       (pass-if (eqv?   -inf.0  (max   -inf.0   -inf.0 )))
2824       (pass-if (eqv?   -123.0  (max   -inf.0   -123   )))
2825       (pass-if (eqv?   -123.0  (max   -123     -inf.0 )))
2826       (pass-if (eqv?   -123.3  (max   -inf.0   -123.3 )))
2827       (pass-if (eqv?   -123.3  (max   -123.3   -inf.0 )))
2828       (pass-if (eqv?     -3.5  (max   -inf.0   -7/2   )))
2829       (pass-if (eqv?     -3.5  (max   -7/2     -inf.0 )))
2830       (pass-if (eqv?  -1.0e20  (max   -inf.0  -1e20   )))
2831       (pass-if (eqv?  -1.0e20  (max  -1e20     -inf.0 )))
2832       (pass-if (eqv? (exact->inexact (- big*2))
2833                      (max   -inf.0 (- big*2))))
2834       (pass-if (eqv? (exact->inexact (- big*2))
2835                      (max (- big*2)  -inf.0 ))))
2836
2837     (with-test-prefix "signed zeroes"
2838       (pass-if (eqv?  0.0  (max  0.0  0.0)))
2839       (pass-if (eqv?  0.0  (max  0.0 -0.0)))
2840       (pass-if (eqv?  0.0  (max -0.0  0.0)))
2841       (pass-if (eqv? -0.0  (max -0.0 -0.0)))
2842       (pass-if (eqv?  0.0  (max -0.0  0  )))
2843       (pass-if (eqv?  0.0  (max  0.0  0  )))
2844       (pass-if (eqv?  0.0  (max  0   -0.0)))
2845       (pass-if (eqv?  0.0  (max  0    0.0)))
2846       (pass-if (eqv?  0    (min  0    0  ))))
2847
2848     (with-test-prefix "big / frac"
2849       (pass-if (eqv? big*2 (max big*2 5/2)))
2850       (pass-if (eqv? 5/2 (max (- big*2) 5/2))))
2851
2852     (with-test-prefix "frac / big"
2853       (pass-if (eqv? big*2 (max 5/2 big*2)))
2854       (pass-if (eqv? 5/2 (max 5/2 (- big*2)))))
2855
2856     (with-test-prefix "big / real"
2857       (pass-if (real-nan? (max big*5 +nan.0)))
2858       (pass-if (eqv? (exact->inexact big*5)  (max big*5 -inf.0)))
2859       (pass-if (eqv? (exact->inexact big*5)  (max big*5 1.0)))
2860       (pass-if (eqv? +inf.0                  (max big*5 +inf.0)))
2861       (pass-if (eqv? 1.0                     (max (- big*5) 1.0))))
2862
2863     (with-test-prefix "real / big"
2864       (pass-if (real-nan? (max +nan.0 big*5)))
2865       (pass-if (eqv? (exact->inexact big*5)  (max -inf.0 big*5)))
2866       (pass-if (eqv? (exact->inexact big*5)  (max 1.0 big*5)))
2867       (pass-if (eqv? +inf.0                  (max +inf.0 big*5)))
2868       (pass-if (eqv? 1.0                     (max 1.0 (- big*5)))))
2869
2870     (with-test-prefix "frac / frac"
2871       (pass-if (eqv? 2/3 (max 1/2 2/3)))
2872       (pass-if (eqv? 2/3 (max 2/3 1/2)))
2873       (pass-if (eqv? -1/2 (max -1/2 -2/3)))
2874       (pass-if (eqv? -1/2 (max -2/3 -1/2))))
2875
2876     (with-test-prefix "real / real"
2877       (pass-if (real-nan? (max 123.0 +nan.0)))
2878       (pass-if (real-nan? (max +nan.0 123.0)))
2879       (pass-if (real-nan? (max +nan.0 +nan.0)))
2880       (pass-if (eqv? 456.0 (max 123.0 456.0)))
2881       (pass-if (eqv? 456.0 (max 456.0 123.0)))))
2882
2883   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
2884   ;; sure we've avoided that
2885   (for-each (lambda (b)
2886               (pass-if (list b +inf.0)
2887                 (eqv? +inf.0 (max b +inf.0)))
2888               (pass-if (list +inf.0 b)
2889                 (eqv? +inf.0 (max b +inf.0)))
2890               (pass-if (list b -inf.0)
2891                 (eqv? (exact->inexact b) (max b -inf.0)))
2892               (pass-if (list -inf.0 b)
2893                 (eqv? (exact->inexact b) (max b -inf.0))))
2894             (list (1- (ash 1 1024))
2895                   (ash 1 1024)
2896                   (1+ (ash 1 1024))
2897                   (- (1- (ash 1 1024)))
2898                   (- (ash 1 1024))
2899                   (- (1+ (ash 1 1024)))))
2900
2901   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
2902   ;; sure we've avoided that
2903   (pass-if (real-nan? (max (ash 1 2048) +nan.0)))
2904   (pass-if (real-nan? (max +nan.0 (ash 1 2048)))))
2905
2906 ;;;
2907 ;;; min
2908 ;;;
2909
2910 ;; FIXME: unfinished...
2911
2912 (with-test-prefix "min"
2913   (pass-if-exception "no args" exception:wrong-num-args
2914     (min))
2915
2916   (pass-if-exception "one complex" exception:wrong-type-arg
2917     (min 1+i))
2918
2919   (pass-if-exception "inum/complex" exception:wrong-type-arg
2920     (min 123 1+i))
2921   (pass-if-exception "big/complex" exception:wrong-type-arg
2922     (min 9999999999999999999999999999999999999999 1+i))
2923   (pass-if-exception "real/complex" exception:wrong-type-arg
2924     (min 123.0 1+i))
2925   (pass-if-exception "frac/complex" exception:wrong-type-arg
2926     (min 123/456 1+i))
2927
2928   (pass-if-exception "complex/inum" exception:wrong-type-arg
2929     (min 1+i 123))
2930   (pass-if-exception "complex/big" exception:wrong-type-arg
2931     (min 1+i 9999999999999999999999999999999999999999))
2932   (pass-if-exception "complex/real" exception:wrong-type-arg
2933     (min 1+i 123.0))
2934   (pass-if-exception "complex/frac" exception:wrong-type-arg
2935     (min 1+i 123/456))
2936
2937   (let ((big*2 (* fixnum-max 2))
2938         (big*3 (* fixnum-max 3))
2939         (big*4 (* fixnum-max 4))
2940         (big*5 (* fixnum-max 5)))
2941
2942     (pass-if (documented? min))
2943     (pass-if (eqv? 1 (min 7 3 1 5)))
2944     (pass-if (eqv? 1 (min 1 7 3 5)))
2945     (pass-if (eqv? 1 (min 7 3 5 1)))
2946     (pass-if (eqv? -7 (min 2 3 4 -2 5 -7 1 -1 4 2)))
2947     (pass-if (eqv? -7 (min -7 2 3 4 -2 5 1 -1 4 2)))
2948     (pass-if (eqv? -7 (min 2 3 4 -2 5 1 -1 4 2 -7)))
2949     (pass-if (eqv? big*2 (min big*3 big*5 big*2 big*4)))
2950     (pass-if (eqv? big*2 (min big*2 big*3 big*5 big*4)))
2951     (pass-if (eqv? big*2 (min big*3 big*5 big*4 big*2)))
2952     (pass-if
2953         (eqv? (- fixnum-min 1) (min 2 4 (- fixnum-min 1) 3 (* 2 fixnum-max))))
2954     (pass-if
2955         (eqv? (- fixnum-min 1) (min (- fixnum-min 1) 2 4 3 (* 2 fixnum-max))))
2956     (pass-if
2957         (eqv? (- fixnum-min 1) (min 2 4 3 (* 2 fixnum-max) (- fixnum-min 1))))
2958
2959     (with-test-prefix "inum / frac"
2960       (pass-if (eqv? 5/2 (min 3 5/2)))
2961       (pass-if (eqv? 2   (min 2 5/2))))
2962
2963     (with-test-prefix "frac / inum"
2964       (pass-if (eqv? 5/2 (min 5/2 3)))
2965       (pass-if (eqv? 2   (min 5/2 2))))
2966
2967     (with-test-prefix "infinities and NaNs"
2968       ;; -inf.0 beats everything except NaNs
2969       (pass-if (eqv?  -inf.0   (min   -inf.0    123   )))
2970       (pass-if (eqv?  -inf.0   (min    123     -inf.0 )))
2971       (pass-if (eqv?  -inf.0   (min   -inf.0   -123.3 )))
2972       (pass-if (eqv?  -inf.0   (min   -123.3   -inf.0 )))
2973       (pass-if (eqv?  -inf.0   (min   -inf.0   -7/2   )))
2974       (pass-if (eqv?  -inf.0   (min   -7/2     -inf.0 )))
2975       (pass-if (eqv?  -inf.0   (min   -inf.0  -1e20   )))
2976       (pass-if (eqv?  -inf.0   (min  -1e20     -inf.0 )))
2977       (pass-if (eqv?  -inf.0   (min   -inf.0 (- big*2))))
2978       (pass-if (eqv?  -inf.0   (min (- big*2)  -inf.0 )))
2979       (pass-if (eqv?  -inf.0   (min   -inf.0   +inf.0 )))
2980       (pass-if (eqv?  -inf.0   (min   +inf.0   -inf.0 )))
2981       (pass-if (eqv?  -inf.0   (min   -inf.0   -inf.0 )))
2982
2983       ;; NaNs beat everything
2984       (pass-if (real-nan?      (min   +nan.0    123   )))
2985       (pass-if (real-nan?      (min    123     +nan.0 )))
2986       (pass-if (real-nan?      (min   +nan.0    123.3 )))
2987       (pass-if (real-nan?      (min    123.3   +nan.0 )))
2988       (pass-if (real-nan?      (min   +nan.0   -7/2   )))
2989       (pass-if (real-nan?      (min   -7/2     +nan.0 )))
2990       (pass-if (real-nan?      (min   +nan.0  -1e20   )))
2991       (pass-if (real-nan?      (min  -1e20     +nan.0 )))
2992       (pass-if (real-nan?      (min   +nan.0 (- big*2))))
2993       (pass-if (real-nan?      (min (- big*2)  +nan.0 )))
2994       (pass-if (real-nan?      (min   +nan.0   +inf.0 )))
2995       (pass-if (real-nan?      (min   +inf.0   +nan.0 )))
2996       (pass-if (real-nan?      (min   +nan.0   +nan.0 )))
2997       (pass-if (real-nan?      (min   -inf.0   +nan.0 )))
2998       (pass-if (real-nan?      (min   +nan.0   -inf.0 )))
2999
3000       ;; +inf.0 always loses, except against itself
3001       (pass-if (eqv?   +inf.0  (min   +inf.0   +inf.0 )))
3002       (pass-if (eqv?   -123.0  (min   +inf.0   -123   )))
3003       (pass-if (eqv?   -123.0  (min   -123     +inf.0 )))
3004       (pass-if (eqv?   -123.3  (min   +inf.0   -123.3 )))
3005       (pass-if (eqv?   -123.3  (min   -123.3   +inf.0 )))
3006       (pass-if (eqv?     -3.5  (min   +inf.0   -7/2   )))
3007       (pass-if (eqv?     -3.5  (min   -7/2     +inf.0 )))
3008       (pass-if (eqv?  -1.0e20  (min   +inf.0  -1e20   )))
3009       (pass-if (eqv?  -1.0e20  (min  -1e20     +inf.0 )))
3010       (pass-if (eqv? (exact->inexact (- big*2))
3011                      (min   +inf.0 (- big*2))))
3012       (pass-if (eqv? (exact->inexact (- big*2))
3013                      (min (- big*2)  +inf.0 ))))
3014
3015     (with-test-prefix "signed zeroes"
3016       (pass-if (eqv?  0.0  (min  0.0  0.0)))
3017       (pass-if (eqv? -0.0  (min  0.0 -0.0)))
3018       (pass-if (eqv? -0.0  (min -0.0  0.0)))
3019       (pass-if (eqv? -0.0  (min -0.0 -0.0)))
3020       (pass-if (eqv? -0.0  (min -0.0  0  )))
3021       (pass-if (eqv?  0.0  (min  0.0  0  )))
3022       (pass-if (eqv? -0.0  (min  0   -0.0)))
3023       (pass-if (eqv?  0.0  (min  0    0.0)))
3024       (pass-if (eqv?  0    (min  0    0  ))))
3025
3026     (with-test-prefix "big / frac"
3027       (pass-if (eqv? 5/2       (min big*2 5/2)))
3028       (pass-if (eqv? (- big*2) (min (- big*2) 5/2))))
3029
3030     (with-test-prefix "frac / big"
3031       (pass-if (eqv? 5/2       (min 5/2 big*2)))
3032       (pass-if (eqv? (- big*2) (min 5/2 (- big*2)))))
3033
3034     (with-test-prefix "big / real"
3035       (pass-if (real-nan? (min big*5 +nan.0)))
3036       (pass-if (eqv? (exact->inexact big*5)      (min big*5  +inf.0)))
3037       (pass-if (eqv? -inf.0                      (min big*5  -inf.0)))
3038       (pass-if (eqv? 1.0                         (min big*5 1.0)))
3039       (pass-if (eqv? (exact->inexact (- big*5))  (min (- big*5) 1.0))))
3040
3041     (with-test-prefix "real / big"
3042       (pass-if (real-nan? (min +nan.0 big*5)))
3043       (pass-if (eqv? (exact->inexact big*5)      (min +inf.0 big*5)))
3044       (pass-if (eqv? -inf.0                      (min -inf.0 big*5)))
3045       (pass-if (eqv? 1.0                         (min 1.0 big*5)))
3046       (pass-if (eqv? (exact->inexact (- big*5))  (min 1.0 (- big*5)))))
3047
3048     (with-test-prefix "frac / frac"
3049       (pass-if (eqv? 1/2 (min 1/2 2/3)))
3050       (pass-if (eqv? 1/2 (min 2/3 1/2)))
3051       (pass-if (eqv? -2/3 (min -1/2 -2/3)))
3052       (pass-if (eqv? -2/3 (min -2/3 -1/2))))
3053
3054     (with-test-prefix "real / real"
3055       (pass-if (real-nan? (min 123.0 +nan.0)))
3056       (pass-if (real-nan? (min +nan.0 123.0)))
3057       (pass-if (real-nan? (min +nan.0 +nan.0)))
3058       (pass-if (eqv? 123.0 (min 123.0 456.0)))
3059       (pass-if (eqv? 123.0 (min 456.0 123.0)))))
3060
3061
3062   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
3063   ;; sure we've avoided that
3064   (for-each (lambda (b)
3065               (pass-if (list b +inf.0)
3066                 (eqv? (exact->inexact b) (min b +inf.0)))
3067               (pass-if (list +inf.0 b)
3068                 (eqv? (exact->inexact b) (min b +inf.0)))
3069               (pass-if (list b -inf.0)
3070                 (eqv? -inf.0 (min b -inf.0)))
3071               (pass-if (list -inf.0 b)
3072                 (eqv? -inf.0 (min b -inf.0))))
3073             (list (1- (ash 1 1024))
3074                   (ash 1 1024)
3075                   (1+ (ash 1 1024))
3076                   (- (1- (ash 1 1024)))
3077                   (- (ash 1 1024))
3078                   (- (1+ (ash 1 1024)))))
3079
3080   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
3081   ;; sure we've avoided that
3082   (pass-if (real-nan? (min (- (ash 1 2048)) (- +nan.0))))
3083   (pass-if (real-nan? (min (- +nan.0) (- (ash 1 2048))))))
3084
3085 ;;;
3086 ;;; +
3087 ;;;
3088
3089 (with-test-prefix/c&e "+"
3090
3091   (pass-if "documented?"
3092     (documented? +))
3093
3094   (pass-if "simple"
3095     (and (eqv?  7 (+ 3 4))
3096          (eqv?  3 (+ 3))
3097          (eqv?  0 (+))))
3098
3099   (pass-if "exactness propagation"
3100     (and (eqv?  8   (+ 3 5))
3101          (eqv?  8.0 (+ 3 5.0))
3102          (eqv?  8.0 (+ 3.0 5))
3103          (eqv?  8.0 (+ 3.0 5.0))
3104
3105          (eqv?  5/6  (+ 1/2 1/3))
3106          (eqv?  5.5  (+ 1/2 5.0))
3107          (eqv?  3.25 (+ 3.0 1/4))))
3108
3109   (pass-if "signed zeroes"
3110     (and (eqv?  0.0 (+  0.0))
3111          (eqv? -0.0 (+ -0.0))
3112          (eqv?  0.0 (+  0.0  0.0))
3113          (eqv?  0.0 (+  0.0 -0.0))
3114          (eqv?  0.0 (+ -0.0  0.0))
3115          (eqv? -0.0 (+ -0.0 -0.0))))
3116
3117   (pass-if "NaNs"
3118     (and (real-nan?  (+ +nan.0 +nan.0))
3119          (real-nan?  (+ 0 +nan.0))
3120          (real-nan?  (+ +nan.0 0))
3121          (real-nan?  (+ 1 +nan.0))
3122          (real-nan?  (+ +nan.0 1))
3123          (real-nan?  (+ -1 +nan.0))
3124          (real-nan?  (+ +nan.0 -1))
3125          (real-nan?  (+ -7/2 +nan.0))
3126          (real-nan?  (+ +nan.0 -7/2))
3127          (real-nan?  (+ 1e20 +nan.0))
3128          (real-nan?  (+ +nan.0 1e20))
3129          (real-nan?  (+ +inf.0 +nan.0))
3130          (real-nan?  (+ +nan.0 +inf.0))
3131          (real-nan?  (+ -inf.0 +nan.0))
3132          (real-nan?  (+ +nan.0 -inf.0))
3133          (real-nan?  (+ (* fixnum-max 2) +nan.0))
3134          (real-nan?  (+ +nan.0 (* fixnum-max 2)))))
3135
3136   (pass-if "infinities"
3137     (and (eqv? +inf.0 (+ +inf.0 +inf.0))
3138          (eqv? -inf.0 (+ -inf.0 -inf.0))
3139          (real-nan?   (+ +inf.0 -inf.0))
3140          (real-nan?   (+ -inf.0 +inf.0))))
3141
3142   ;; The maximum fixnum on a 32-bit architecture: 2^29 - 1.
3143   (pass-if "fixnum + fixnum = bignum (32-bit)"
3144     (eqv? 536870912 (+ 536870910 2)))
3145
3146   ;; The maximum fixnum on a 64-bit architecture: 2^61 - 1.
3147   (pass-if "fixnum + fixnum = bignum (64-bit)"
3148     (eqv? 2305843009213693952 (+ 2305843009213693950 2)))
3149
3150   (pass-if "bignum + fixnum = fixnum"
3151     (eqv? 0 (+ (1+ most-positive-fixnum) most-negative-fixnum))))
3152
3153 ;;;
3154 ;;; -
3155 ;;;
3156
3157 (with-test-prefix/c&e "-"
3158
3159   (pass-if "double-negation of fixnum-min: ="
3160     (=      fixnum-min (- (- fixnum-min))))
3161   (pass-if "double-negation of fixnum-min: eqv?"
3162     (eqv?   fixnum-min (- (- fixnum-min))))
3163   (pass-if "double-negation of fixnum-min: equal?"
3164     (equal? fixnum-min (- (- fixnum-min))))
3165
3166   (pass-if "binary double-negation of fixnum-min: ="
3167     (=      fixnum-min (- 0 (- 0 fixnum-min))))
3168   (pass-if "binary double-negation of fixnum-min: eqv?"
3169     (eqv?   fixnum-min (- 0 (- 0 fixnum-min))))
3170   (pass-if "binary double-negation of fixnum-min: equal?"
3171     (equal? fixnum-min (- 0 (- 0 fixnum-min))))
3172
3173   (pass-if "signed zeroes"
3174     (and (eqv? +0.0 (- -0.0))
3175          (eqv? -0.0 (- +0.0))
3176          (eqv?  0.0 (-  0.0  0.0))
3177          (eqv?  0.0 (-  0.0 -0.0))
3178          (eqv?  0.0 (- -0.0 -0.0))
3179          (eqv? -0.0 (- -0.0  0.0))))
3180
3181   (pass-if "exactness propagation"
3182     (and (eqv?  3   (- 8 5))
3183          (eqv?  3.0 (- 8 5.0))
3184          (eqv?  3.0 (- 8.0 5))
3185          (eqv?  3.0 (- 8.0 5.0))
3186          (eqv? -1/6  (- 1/3 1/2))
3187          (eqv? -4.5  (- 1/2 5.0))
3188          (eqv?  2.75 (- 3.0 1/4))))
3189
3190   (pass-if "infinities"
3191     (and (eqv? +inf.0 (- +inf.0 -inf.0))
3192          (eqv? -inf.0 (- -inf.0 +inf.0))
3193          (real-nan?   (- +inf.0 +inf.0))
3194          (real-nan?   (- -inf.0 -inf.0))))
3195
3196   (pass-if "NaNs"
3197     (and (real-nan?  (- +nan.0 +nan.0))
3198          (real-nan?  (- 0 +nan.0))
3199          (real-nan?  (- +nan.0 0))
3200          (real-nan?  (- 1 +nan.0))
3201          (real-nan?  (- +nan.0 1))
3202          (real-nan?  (- -1 +nan.0))
3203          (real-nan?  (- +nan.0 -1))
3204          (real-nan?  (- -7/2 +nan.0))
3205          (real-nan?  (- +nan.0 -7/2))
3206          (real-nan?  (- 1e20 +nan.0))
3207          (real-nan?  (- +nan.0 1e20))
3208          (real-nan?  (- +inf.0 +nan.0))
3209          (real-nan?  (- +nan.0 +inf.0))
3210          (real-nan?  (- -inf.0 +nan.0))
3211          (real-nan?  (- +nan.0 -inf.0))
3212          (real-nan?  (- (* fixnum-max 2) +nan.0))
3213          (real-nan?  (- +nan.0 (* fixnum-max 2)))))
3214
3215   (pass-if "(eqv? fixnum-min (- (- fixnum-min)))"
3216     (eqv? fixnum-min (- (- fixnum-min))))
3217   (pass-if "(eqv? fixnum-min (- 0 (- 0 fixnum-min)))"
3218     (eqv? fixnum-min (- 0 (- 0 fixnum-min))))
3219   (pass-if "(eqv? fixnum-num (apply - (list (apply - (list fixnum-min)))))"
3220     (eqv? fixnum-min (apply - (list (apply - (list fixnum-min))))))
3221
3222   (pass-if "-inum - +bignum"
3223     (= #x-100000000000000000000000000000001
3224        (- -1 #x100000000000000000000000000000000)))
3225
3226   (pass-if "big - inum"
3227     (= #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
3228        (- #x100000000000000000000000000000000 1)))
3229
3230   (pass-if "big - -inum"
3231     (= #x100000000000000000000000000000001
3232        (- #x100000000000000000000000000000000 -1)))
3233
3234   ;; The mininum fixnum on a 32-bit architecture: -2^29.
3235   (pass-if "fixnum - fixnum = bignum (32-bit)"
3236     (eqv? -536870912 (- -536870910 2)))
3237
3238   ;; The minimum fixnum on a 64-bit architecture: -2^61.
3239   (pass-if "fixnum - fixnum = bignum (64-bit)"
3240     (eqv? -2305843009213693952 (- -2305843009213693950 2)))
3241
3242   (pass-if "bignum - fixnum = fixnum"
3243     (eqv? most-positive-fixnum (- (1+ most-positive-fixnum) 1))))
3244
3245 ;;;
3246 ;;; *
3247 ;;;
3248
3249 (with-test-prefix "*"
3250
3251   (with-test-prefix "double-negation of fixnum-min"
3252     (pass-if (=      fixnum-min (* -1 (* -1 fixnum-min))))
3253     (pass-if (eqv?   fixnum-min (* -1 (* -1 fixnum-min))))
3254     (pass-if (equal? fixnum-min (* -1 (* -1 fixnum-min))))
3255     (pass-if (=      fixnum-min (* (* fixnum-min -1) -1)))
3256     (pass-if (eqv?   fixnum-min (* (* fixnum-min -1) -1)))
3257     (pass-if (equal? fixnum-min (* (* fixnum-min -1) -1))))
3258
3259   (with-test-prefix "signed fixnum overflow"
3260     (pass-if (eqv? (* 65536 65536) 4294967296))
3261     (pass-if (eqv? (* -65536 65536) -4294967296))
3262     (pass-if (eqv? (* 65536 -65536) -4294967296))
3263     (pass-if (eqv? (* -65536 -65536) 4294967296))
3264     (pass-if (eqv? (* 4294967296 4294967296) 18446744073709551616))
3265     (pass-if (eqv? (* -4294967296 4294967296) -18446744073709551616))
3266     (pass-if (eqv? (* 4294967296 -4294967296) -18446744073709551616))
3267     (pass-if (eqv? (* -4294967296 -4294967296) 18446744073709551616)))
3268
3269   (with-test-prefix "signed zeroes"
3270     (pass-if (eqv? +0.0 (* +0.0 +0.0)))
3271     (pass-if (eqv? -0.0 (* -0.0 +0.0)))
3272     (pass-if (eqv? +0.0 (* -0.0 -0.0)))
3273     (pass-if (eqv? -0.0 (* +0.0 -0.0)))
3274     (pass-if (eqv? +0.0+0.0i (* +i +0.0)))
3275     (pass-if (eqv? +0.0-0.0i (* -i +0.0)))
3276     (pass-if (eqv? -0.0-0.0i (* +i -0.0)))
3277     (pass-if (eqv? -0.0+0.0i (* -i -0.0))))
3278
3279   (with-test-prefix "exactness propagation"
3280     (pass-if (eqv? -0.0 (*  0 -1.0 )))
3281     (pass-if (eqv?  0.0 (*  0  1.0 )))
3282     (pass-if (eqv? -0.0 (* -1.0  0 )))
3283     (pass-if (eqv?  0.0 (*  1.0  0 )))
3284     (pass-if (eqv?  0   (*  0  1/2 )))
3285     (pass-if (eqv?  0   (*  1/2  0 )))
3286     (pass-if (eqv?  0.0+0.0i (*  0  1+i )))
3287     (pass-if (eqv?  0.0+0.0i (*  1+i  0 )))
3288     (pass-if (eqv? -1.0 (*  1 -1.0 )))
3289     (pass-if (eqv?  1.0 (*  1  1.0 )))
3290     (pass-if (eqv? -1.0 (* -1.0  1 )))
3291     (pass-if (eqv?  1.0 (*  1.0  1 )))
3292     (pass-if (eqv?  1/2 (*  1  1/2 )))
3293     (pass-if (eqv?  1/2 (*  1/2  1 )))
3294     (pass-if (eqv?  1+i (*  1  1+i )))
3295     (pass-if (eqv?  1+i (*  1+i  1 ))))
3296
3297   (with-test-prefix "propagation of NaNs"
3298     (pass-if (real-nan?      (* +nan.0 +nan.0)))
3299     (pass-if (real-nan?      (* +nan.0    1  )))
3300     (pass-if (real-nan?      (* +nan.0   -1  )))
3301     (pass-if (real-nan?      (* +nan.0 -7/2  )))
3302     (pass-if (real-nan?      (* +nan.0 1e20  )))
3303     (pass-if (real-nan?      (*  1     +nan.0)))
3304     (pass-if (real-nan?      (* -1     +nan.0)))
3305     (pass-if (real-nan?      (* -7/2   +nan.0)))
3306     (pass-if (real-nan?      (* 1e20   +nan.0)))
3307     (pass-if (real-nan?      (* +inf.0 +nan.0)))
3308     (pass-if (real-nan?      (* +nan.0 +inf.0)))
3309     (pass-if (real-nan?      (* -inf.0 +nan.0)))
3310     (pass-if (real-nan?      (* +nan.0 -inf.0)))
3311     (pass-if (real-nan?      (* (* fixnum-max 2) +nan.0)))
3312     (pass-if (real-nan?      (* +nan.0 (* fixnum-max 2))))
3313
3314     (pass-if (real-nan?        (*     0     +nan.0  )))
3315     (pass-if (real-nan?        (*  +nan.0      0    )))
3316     (pass-if (almost-real-nan? (*     0     +nan.0+i)))
3317     (pass-if (almost-real-nan? (*  +nan.0+i    0    )))
3318
3319     (pass-if (imaginary-nan? (*     0     +nan.0i )))
3320     (pass-if (imaginary-nan? (*  +nan.0i     0    )))
3321     (pass-if (imaginary-nan? (*     0    1+nan.0i )))
3322     (pass-if (imaginary-nan? (* 1+nan.0i     0    )))
3323
3324     (pass-if (complex-nan?   (* 0   +nan.0+nan.0i )))
3325     (pass-if (complex-nan?   (* +nan.0+nan.0i   0 ))))
3326
3327   (with-test-prefix "infinities"
3328     (pass-if (eqv?   +inf.0  (* +inf.0  5  )))
3329     (pass-if (eqv?   -inf.0  (* +inf.0 -5  )))
3330     (pass-if (eqv?   +inf.0  (* +inf.0 73.1)))
3331     (pass-if (eqv?   -inf.0  (* +inf.0 -9.2)))
3332     (pass-if (eqv?   +inf.0  (* +inf.0  5/2)))
3333     (pass-if (eqv?   -inf.0  (* +inf.0 -5/2)))
3334     (pass-if (eqv?   -inf.0  (* -5   +inf.0)))
3335     (pass-if (eqv?   +inf.0  (* 73.1 +inf.0)))
3336     (pass-if (eqv?   -inf.0  (* -9.2 +inf.0)))
3337     (pass-if (eqv?   +inf.0  (*  5/2 +inf.0)))
3338     (pass-if (eqv?   -inf.0  (* -5/2 +inf.0)))
3339
3340     (pass-if (eqv?   -inf.0  (* -inf.0  5  )))
3341     (pass-if (eqv?   +inf.0  (* -inf.0 -5  )))
3342     (pass-if (eqv?   -inf.0  (* -inf.0 73.1)))
3343     (pass-if (eqv?   +inf.0  (* -inf.0 -9.2)))
3344     (pass-if (eqv?   -inf.0  (* -inf.0  5/2)))
3345     (pass-if (eqv?   +inf.0  (* -inf.0 -5/2)))
3346     (pass-if (eqv?   +inf.0  (* -5   -inf.0)))
3347     (pass-if (eqv?   -inf.0  (* 73.1 -inf.0)))
3348     (pass-if (eqv?   +inf.0  (* -9.2 -inf.0)))
3349     (pass-if (eqv?   -inf.0  (* 5/2  -inf.0)))
3350     (pass-if (eqv?   +inf.0  (* -5/2 -inf.0)))
3351
3352     (pass-if (real-nan?      (*    0.0 +inf.0)))
3353     (pass-if (real-nan?      (*   -0.0 +inf.0)))
3354     (pass-if (real-nan?      (* +inf.0    0.0)))
3355     (pass-if (real-nan?      (* +inf.0   -0.0)))
3356
3357     (pass-if (real-nan?      (*    0.0 -inf.0)))
3358     (pass-if (real-nan?      (*   -0.0 -inf.0)))
3359     (pass-if (real-nan?      (* -inf.0    0.0)))
3360     (pass-if (real-nan?      (* -inf.0   -0.0)))
3361
3362     (pass-if (real-nan?      (*     0     +inf.0  )))
3363     (pass-if (real-nan?      (*  +inf.0      0    )))
3364     (pass-if (real-nan?      (*     0     -inf.0  )))
3365     (pass-if (real-nan?      (*  -inf.0      0    )))
3366
3367     (pass-if (almost-real-nan? (*     0     +inf.0+i)))
3368     (pass-if (almost-real-nan? (*  +inf.0+i    0    )))
3369     (pass-if (almost-real-nan? (*     0     -inf.0+i)))
3370     (pass-if (almost-real-nan? (*  -inf.0+i    0    )))
3371
3372     (pass-if (imaginary-nan? (*     0     +inf.0i )))
3373     (pass-if (imaginary-nan? (*  +inf.0i     0    )))
3374     (pass-if (imaginary-nan? (*     0    1+inf.0i )))
3375     (pass-if (imaginary-nan? (* 1+inf.0i     0    )))
3376
3377     (pass-if (imaginary-nan? (*     0     -inf.0i )))
3378     (pass-if (imaginary-nan? (*  -inf.0i     0    )))
3379     (pass-if (imaginary-nan? (*     0    1-inf.0i )))
3380     (pass-if (imaginary-nan? (* 1-inf.0i     0    )))
3381
3382     (pass-if (complex-nan?   (* 0   +inf.0+inf.0i )))
3383     (pass-if (complex-nan?   (* +inf.0+inf.0i   0 )))
3384
3385     (pass-if (complex-nan?   (* 0   +inf.0-inf.0i )))
3386     (pass-if (complex-nan?   (* -inf.0+inf.0i   0 ))))
3387
3388   (with-test-prefix "inum * bignum"
3389
3390     (pass-if "0 * 2^256 = 0"
3391       (eqv? 0 (* 0 (ash 1 256)))))
3392
3393   (with-test-prefix "inum * flonum"
3394
3395     (pass-if "0 * 1.0 = 0.0"
3396       (eqv? 0.0 (* 0 1.0))))
3397
3398   (with-test-prefix "inum * complex"
3399
3400     (pass-if "0 * 1+1i = 0.0+0.0i"
3401       (eqv? 0.0+0.0i (* 0 1+1i))))
3402
3403   (with-test-prefix "inum * frac"
3404
3405     (pass-if "0 * 2/3 = 0"
3406       (eqv? 0 (* 0 2/3))))
3407
3408   (with-test-prefix "bignum * inum"
3409
3410     (pass-if "2^256 * 0 = 0"
3411       (eqv? 0 (* (ash 1 256) 0))))
3412
3413   (with-test-prefix "flonum * inum"
3414     (pass-if "1.0 * 0 = 0.0"
3415       (eqv? 0.0 (* 1.0 0))))
3416
3417   (with-test-prefix "complex * inum"
3418     (pass-if "1+1i * 0 = 0.0+0.0i"
3419       (eqv? 0.0+0.0i (* 1+1i 0))))
3420
3421   (pass-if "complex * bignum"
3422     (let ((big (ash 1 90)))
3423       (= (make-rectangular big big)
3424          (* 1+1i big))))
3425
3426   (with-test-prefix "frac * inum"
3427
3428     (pass-if "2/3 * 0 = 0"
3429       (eqv? 0 (* 2/3 0)))))
3430
3431 ;;;
3432 ;;; /
3433 ;;;
3434
3435 (with-test-prefix "/"
3436
3437   (with-test-prefix "double-negation of fixnum-min"
3438     (pass-if (=      fixnum-min (/ (/ fixnum-min -1) -1)))
3439     (pass-if (eqv?   fixnum-min (/ (/ fixnum-min -1) -1)))
3440     (pass-if (equal? fixnum-min (/ (/ fixnum-min -1) -1))))
3441
3442   (pass-if "documented?"
3443     (documented? /))
3444
3445   (with-test-prefix "division by zero"
3446
3447     (pass-if-exception "(/ 0)"
3448         exception:numerical-overflow
3449       (/ 0))
3450
3451     (pass-if "(/ 0.0)"
3452       (= +inf.0 (/ 0.0)))
3453
3454     (pass-if-exception "(/ 1 0)"
3455         exception:numerical-overflow
3456       (/ 1 0))
3457
3458     (pass-if "(/ 1 0.0)"
3459       (= +inf.0 (/ 1 0.0)))
3460
3461     (pass-if-exception "(/ bignum 0)"
3462         exception:numerical-overflow
3463       (/ (+ fixnum-max 1) 0))
3464
3465     (pass-if "(/ bignum 0.0)"
3466       (= +inf.0 (/ (+ fixnum-max 1) 0.0)))
3467
3468     (pass-if-exception "(/ 1.0 0)"
3469         exception:numerical-overflow
3470       (/ 1.0 0))
3471
3472     (pass-if "(/ 1.0 0.0)"
3473       (= +inf.0 (/ 1.0 0.0)))
3474
3475     (pass-if-exception "(/ +i 0)"
3476         exception:numerical-overflow
3477       (/ +i 0))
3478
3479     (pass-if "(/ +i 0.0)"
3480       (= +inf.0 (imag-part (/ +i 0.0)))))
3481
3482   (with-test-prefix "1/complex"
3483
3484     (pass-if "0+1i"
3485       (eqv? 0-1i (/ 0+1i)))
3486
3487     ;; in guile 1.6 through 1.6.7 this incorrectly resulted in nans
3488     (pass-if "0-1i"
3489       (eqv? 0+1i (/ 0-1i)))
3490
3491     (pass-if "1+1i"
3492       (eqv? 0.5-0.5i (/ 1+1i)))
3493
3494     (pass-if "1-1i"
3495       (eqv? 0.5+0.5i (/ 1-1i)))
3496
3497     (pass-if "-1+1i"
3498       (eqv? -0.5-0.5i (/ -1+1i)))
3499
3500     (pass-if "-1-1i"
3501       (eqv? -0.5+0.5i (/ -1-1i)))
3502
3503     (pass-if "(/ 3+4i)"
3504       (= (/ 3+4i) 0.12-0.16i))
3505
3506     (pass-if "(/ 4+3i)"
3507       (= (/ 4+3i) 0.16-0.12i))
3508
3509     (pass-if "(/ 1e200+1e200i)"
3510       (= (/ 1e200+1e200i) 5.0e-201-5.0e-201i)))
3511
3512   (with-test-prefix "inum/complex"
3513
3514     (pass-if "(/ 25 3+4i)"
3515       (= (/ 25 3+4i) 3.0-4.0i))
3516
3517     (pass-if "(/ 25 4+3i)"
3518       (= (/ 25 4+3i) 4.0-3.0i)))
3519
3520   (with-test-prefix "complex/complex"
3521
3522     (pass-if "(/ 25+125i 3+4i)"
3523       (= (/ 25+125i 3+4i) 23.0+11.0i))
3524
3525     (pass-if "(/ 25+125i 4+3i)"
3526       (= (/ 25+125i 4+3i) 19.0+17.0i))))
3527
3528 ;;;
3529 ;;; floor
3530 ;;;
3531
3532 (with-test-prefix "floor"
3533   (pass-if (=  1 (floor  1.75)))
3534   (pass-if (=  1 (floor  1.5)))
3535   (pass-if (=  1 (floor  1.25)))
3536   (pass-if (=  0 (floor  0.75)))
3537   (pass-if (=  0 (floor  0.5)))
3538   (pass-if (=  0 (floor  0.0)))
3539   (pass-if (= -1 (floor -0.5)))
3540   (pass-if (= -2 (floor -1.25)))
3541   (pass-if (= -2 (floor -1.5)))
3542
3543   (with-test-prefix "inum"
3544     (pass-if "0"
3545       (and (= 0    (floor 0))
3546            (exact? (floor 0))))
3547
3548     (pass-if "1"
3549       (and (= 1    (floor 1))
3550            (exact? (floor 1))))
3551
3552     (pass-if "-1"
3553       (and (= -1   (floor -1))
3554            (exact? (floor -1)))))
3555
3556   (with-test-prefix "bignum"
3557     (let ((x (1+ most-positive-fixnum)))
3558       (pass-if "(1+ most-positive-fixnum)"
3559         (and (= x    (floor x))
3560              (exact? (floor x)))))
3561
3562     (let ((x (1- most-negative-fixnum)))
3563       (pass-if "(1- most-negative-fixnum)"
3564         (and (= x    (floor x))
3565              (exact? (floor x))))))
3566
3567   (with-test-prefix "frac"
3568     (define (=exact x y)
3569       (and (= x y)
3570            (exact? y)))
3571
3572     (pass-if (=exact -3 (floor -7/3)))
3573     (pass-if (=exact -2 (floor -5/3)))
3574     (pass-if (=exact -2 (floor -4/3)))
3575     (pass-if (=exact -1 (floor -2/3)))
3576     (pass-if (=exact -1 (floor -1/3)))
3577     (pass-if (=exact  0 (floor  1/3)))
3578     (pass-if (=exact  0 (floor  2/3)))
3579     (pass-if (=exact  1 (floor  4/3)))
3580     (pass-if (=exact  1 (floor  5/3)))
3581     (pass-if (=exact  2 (floor  7/3)))
3582
3583     (pass-if (=exact -3 (floor -17/6)))
3584     (pass-if (=exact -3 (floor -16/6)))
3585     (pass-if (=exact -3 (floor -15/6)))
3586     (pass-if (=exact -3 (floor -14/6)))
3587     (pass-if (=exact -3 (floor -13/6)))
3588     (pass-if (=exact -2 (floor -11/6)))
3589     (pass-if (=exact -2 (floor -10/6)))
3590     (pass-if (=exact -2 (floor  -9/6)))
3591     (pass-if (=exact -2 (floor  -8/6)))
3592     (pass-if (=exact -2 (floor  -7/6)))
3593     (pass-if (=exact -1 (floor  -5/6)))
3594     (pass-if (=exact -1 (floor  -4/6)))
3595     (pass-if (=exact -1 (floor  -3/6)))
3596     (pass-if (=exact -1 (floor  -2/6)))
3597     (pass-if (=exact -1 (floor  -1/6)))
3598     (pass-if (=exact  0 (floor   1/6)))
3599     (pass-if (=exact  0 (floor   2/6)))
3600     (pass-if (=exact  0 (floor   3/6)))
3601     (pass-if (=exact  0 (floor   4/6)))
3602     (pass-if (=exact  0 (floor   5/6)))
3603     (pass-if (=exact  1 (floor   7/6)))
3604     (pass-if (=exact  1 (floor   8/6)))
3605     (pass-if (=exact  1 (floor   9/6)))
3606     (pass-if (=exact  1 (floor  10/6)))
3607     (pass-if (=exact  1 (floor  11/6)))
3608     (pass-if (=exact  2 (floor  13/6)))
3609     (pass-if (=exact  2 (floor  14/6)))
3610     (pass-if (=exact  2 (floor  15/6)))
3611     (pass-if (=exact  2 (floor  16/6)))
3612     (pass-if (=exact  2 (floor  17/6))))
3613
3614   (with-test-prefix "real"
3615     (pass-if "0.0"
3616       (and (= 0.0    (floor 0.0))
3617            (inexact? (floor 0.0))))
3618
3619     (pass-if "1.0"
3620       (and (= 1.0    (floor 1.0))
3621            (inexact? (floor 1.0))))
3622
3623     (pass-if "-1.0"
3624       (and (= -1.0   (floor -1.0))
3625            (inexact? (floor -1.0))))
3626
3627     (pass-if "-3.1"
3628       (and (= -4.0   (floor -3.1))
3629            (inexact? (floor -3.1))))
3630
3631     (pass-if "3.1"
3632       (and (= 3.0    (floor 3.1))
3633            (inexact? (floor 3.1))))
3634
3635     (pass-if "3.9"
3636       (and (= 3.0    (floor 3.9))
3637            (inexact? (floor 3.9))))
3638
3639     (pass-if "-3.9"
3640       (and (= -4.0   (floor -3.9))
3641            (inexact? (floor -3.9))))
3642
3643     (pass-if "1.5"
3644       (and (= 1.0    (floor 1.5))
3645            (inexact? (floor 1.5))))
3646
3647     (pass-if "2.5"
3648       (and (= 2.0    (floor 2.5))
3649            (inexact? (floor 2.5))))
3650
3651     (pass-if "3.5"
3652       (and (= 3.0    (floor 3.5))
3653            (inexact? (floor 3.5))))
3654
3655     (pass-if "-1.5"
3656       (and (= -2.0   (floor -1.5))
3657            (inexact? (floor -1.5))))
3658
3659     (pass-if "-2.5"
3660       (and (= -3.0   (floor -2.5))
3661            (inexact? (floor -2.5))))
3662
3663     (pass-if "-3.5"
3664       (and (= -4.0   (floor -3.5))
3665            (inexact? (floor -3.5))))))
3666
3667 ;;;
3668 ;;; ceiling
3669 ;;;
3670
3671 (with-test-prefix "ceiling"
3672   (pass-if (=  2 (ceiling  1.75)))
3673   (pass-if (=  2 (ceiling  1.5)))
3674   (pass-if (=  2 (ceiling  1.25)))
3675   (pass-if (=  1 (ceiling  0.75)))
3676   (pass-if (=  1 (ceiling  0.5)))
3677   (pass-if (=  0 (ceiling  0.0)))
3678   (pass-if (=  0 (ceiling -0.5)))
3679   (pass-if (= -1 (ceiling -1.25)))
3680   (pass-if (= -1 (ceiling -1.5)))
3681
3682   (with-test-prefix "inum"
3683     (pass-if "0"
3684       (and (= 0    (ceiling 0))
3685            (exact? (ceiling 0))))
3686
3687     (pass-if "1"
3688       (and (= 1    (ceiling 1))
3689            (exact? (ceiling 1))))
3690
3691     (pass-if "-1"
3692       (and (= -1   (ceiling -1))
3693            (exact? (ceiling -1)))))
3694
3695   (with-test-prefix "bignum"
3696     (let ((x (1+ most-positive-fixnum)))
3697       (pass-if "(1+ most-positive-fixnum)"
3698         (and (= x    (ceiling x))
3699              (exact? (ceiling x)))))
3700
3701     (let ((x (1- most-negative-fixnum)))
3702       (pass-if "(1- most-negative-fixnum)"
3703         (and (= x    (ceiling x))
3704              (exact? (ceiling x))))))
3705
3706   (with-test-prefix "frac"
3707     (define (=exact x y)
3708       (and (= x y)
3709            (exact? y)))
3710
3711     (pass-if (=exact -2 (ceiling -7/3)))
3712     (pass-if (=exact -1 (ceiling -5/3)))
3713     (pass-if (=exact -1 (ceiling -4/3)))
3714     (pass-if (=exact  0 (ceiling -2/3)))
3715     (pass-if (=exact  0 (ceiling -1/3)))
3716     (pass-if (=exact  1 (ceiling  1/3)))
3717     (pass-if (=exact  1 (ceiling  2/3)))
3718     (pass-if (=exact  2 (ceiling  4/3)))
3719     (pass-if (=exact  2 (ceiling  5/3)))
3720     (pass-if (=exact  3 (ceiling  7/3)))
3721
3722     (pass-if (=exact -2 (ceiling -17/6)))
3723     (pass-if (=exact -2 (ceiling -16/6)))
3724     (pass-if (=exact -2 (ceiling -15/6)))
3725     (pass-if (=exact -2 (ceiling -14/6)))
3726     (pass-if (=exact -2 (ceiling -13/6)))
3727     (pass-if (=exact -1 (ceiling -11/6)))
3728     (pass-if (=exact -1 (ceiling -10/6)))
3729     (pass-if (=exact -1 (ceiling  -9/6)))
3730     (pass-if (=exact -1 (ceiling  -8/6)))
3731     (pass-if (=exact -1 (ceiling  -7/6)))
3732     (pass-if (=exact  0 (ceiling  -5/6)))
3733     (pass-if (=exact  0 (ceiling  -4/6)))
3734     (pass-if (=exact  0 (ceiling  -3/6)))
3735     (pass-if (=exact  0 (ceiling  -2/6)))
3736     (pass-if (=exact  0 (ceiling  -1/6)))
3737     (pass-if (=exact  1 (ceiling   1/6)))
3738     (pass-if (=exact  1 (ceiling   2/6)))
3739     (pass-if (=exact  1 (ceiling   3/6)))
3740     (pass-if (=exact  1 (ceiling   4/6)))
3741     (pass-if (=exact  1 (ceiling   5/6)))
3742     (pass-if (=exact  2 (ceiling   7/6)))
3743     (pass-if (=exact  2 (ceiling   8/6)))
3744     (pass-if (=exact  2 (ceiling   9/6)))
3745     (pass-if (=exact  2 (ceiling  10/6)))
3746     (pass-if (=exact  2 (ceiling  11/6)))
3747     (pass-if (=exact  3 (ceiling  13/6)))
3748     (pass-if (=exact  3 (ceiling  14/6)))
3749     (pass-if (=exact  3 (ceiling  15/6)))
3750     (pass-if (=exact  3 (ceiling  16/6)))
3751     (pass-if (=exact  3 (ceiling  17/6))))
3752
3753   (with-test-prefix "real"
3754     (pass-if "0.0"
3755       (and (= 0.0    (ceiling 0.0))
3756            (inexact? (ceiling 0.0))))
3757
3758     (pass-if "1.0"
3759       (and (= 1.0    (ceiling 1.0))
3760            (inexact? (ceiling 1.0))))
3761
3762     (pass-if "-1.0"
3763       (and (= -1.0   (ceiling -1.0))
3764            (inexact? (ceiling -1.0))))
3765
3766     (pass-if "-3.1"
3767       (and (= -3.0   (ceiling -3.1))
3768            (inexact? (ceiling -3.1))))
3769
3770     (pass-if "3.1"
3771       (and (= 4.0    (ceiling 3.1))
3772            (inexact? (ceiling 3.1))))
3773
3774     (pass-if "3.9"
3775       (and (= 4.0    (ceiling 3.9))
3776            (inexact? (ceiling 3.9))))
3777
3778     (pass-if "-3.9"
3779       (and (= -3.0   (ceiling -3.9))
3780            (inexact? (ceiling -3.9))))
3781
3782     (pass-if "1.5"
3783       (and (= 2.0    (ceiling 1.5))
3784            (inexact? (ceiling 1.5))))
3785
3786     (pass-if "2.5"
3787       (and (= 3.0    (ceiling 2.5))
3788            (inexact? (ceiling 2.5))))
3789
3790     (pass-if "3.5"
3791       (and (= 4.0    (ceiling 3.5))
3792            (inexact? (ceiling 3.5))))
3793
3794     (pass-if "-1.5"
3795       (and (= -1.0   (ceiling -1.5))
3796            (inexact? (ceiling -1.5))))
3797
3798     (pass-if "-2.5"
3799       (and (= -2.0   (ceiling -2.5))
3800            (inexact? (ceiling -2.5))))
3801
3802     (pass-if "-3.5"
3803       (and (= -3.0   (ceiling -3.5))
3804            (inexact? (ceiling -3.5))))))
3805
3806 ;;;
3807 ;;; truncate
3808 ;;;
3809
3810 (with-test-prefix "truncate"
3811   (pass-if (=  1 (truncate  1.75)))
3812   (pass-if (=  1 (truncate  1.5)))
3813   (pass-if (=  1 (truncate  1.25)))
3814   (pass-if (=  0 (truncate  0.75)))
3815   (pass-if (=  0 (truncate  0.5)))
3816   (pass-if (=  0 (truncate  0.0)))
3817   (pass-if (=  0 (truncate -0.5)))
3818   (pass-if (= -1 (truncate -1.25)))
3819   (pass-if (= -1 (truncate -1.5)))
3820
3821   (with-test-prefix "inum"
3822     (pass-if "0"
3823       (and (= 0    (truncate 0))
3824            (exact? (truncate 0))))
3825
3826     (pass-if "1"
3827       (and (= 1    (truncate 1))
3828            (exact? (truncate 1))))
3829
3830     (pass-if "-1"
3831       (and (= -1   (truncate -1))
3832            (exact? (truncate -1)))))
3833
3834   (with-test-prefix "bignum"
3835     (let ((x (1+ most-positive-fixnum)))
3836       (pass-if "(1+ most-positive-fixnum)"
3837         (and (= x    (truncate x))
3838              (exact? (truncate x)))))
3839
3840     (let ((x (1- most-negative-fixnum)))
3841       (pass-if "(1- most-negative-fixnum)"
3842         (and (= x    (truncate x))
3843              (exact? (truncate x))))))
3844
3845   (with-test-prefix "frac"
3846     (define (=exact x y)
3847       (and (= x y)
3848            (exact? y)))
3849
3850     (pass-if (=exact -2 (truncate -7/3)))
3851     (pass-if (=exact -1 (truncate -5/3)))
3852     (pass-if (=exact -1 (truncate -4/3)))
3853     (pass-if (=exact  0 (truncate -2/3)))
3854     (pass-if (=exact  0 (truncate -1/3)))
3855     (pass-if (=exact  0 (truncate  1/3)))
3856     (pass-if (=exact  0 (truncate  2/3)))
3857     (pass-if (=exact  1 (truncate  4/3)))
3858     (pass-if (=exact  1 (truncate  5/3)))
3859     (pass-if (=exact  2 (truncate  7/3)))
3860
3861     (pass-if (=exact -2 (truncate -17/6)))
3862     (pass-if (=exact -2 (truncate -16/6)))
3863     (pass-if (=exact -2 (truncate -15/6)))
3864     (pass-if (=exact -2 (truncate -14/6)))
3865     (pass-if (=exact -2 (truncate -13/6)))
3866     (pass-if (=exact -1 (truncate -11/6)))
3867     (pass-if (=exact -1 (truncate -10/6)))
3868     (pass-if (=exact -1 (truncate  -9/6)))
3869     (pass-if (=exact -1 (truncate  -8/6)))
3870     (pass-if (=exact -1 (truncate  -7/6)))
3871     (pass-if (=exact  0 (truncate  -5/6)))
3872     (pass-if (=exact  0 (truncate  -4/6)))
3873     (pass-if (=exact  0 (truncate  -3/6)))
3874     (pass-if (=exact  0 (truncate  -2/6)))
3875     (pass-if (=exact  0 (truncate  -1/6)))
3876     (pass-if (=exact  0 (truncate   1/6)))
3877     (pass-if (=exact  0 (truncate   2/6)))
3878     (pass-if (=exact  0 (truncate   3/6)))
3879     (pass-if (=exact  0 (truncate   4/6)))
3880     (pass-if (=exact  0 (truncate   5/6)))
3881     (pass-if (=exact  1 (truncate   7/6)))
3882     (pass-if (=exact  1 (truncate   8/6)))
3883     (pass-if (=exact  1 (truncate   9/6)))
3884     (pass-if (=exact  1 (truncate  10/6)))
3885     (pass-if (=exact  1 (truncate  11/6)))
3886     (pass-if (=exact  2 (truncate  13/6)))
3887     (pass-if (=exact  2 (truncate  14/6)))
3888     (pass-if (=exact  2 (truncate  15/6)))
3889     (pass-if (=exact  2 (truncate  16/6)))
3890     (pass-if (=exact  2 (truncate  17/6))))
3891
3892   (with-test-prefix "real"
3893     (pass-if "0.0"
3894       (and (= 0.0    (truncate 0.0))
3895            (inexact? (truncate 0.0))))
3896
3897     (pass-if "1.0"
3898       (and (= 1.0    (truncate 1.0))
3899            (inexact? (truncate 1.0))))
3900
3901     (pass-if "-1.0"
3902       (and (= -1.0   (truncate -1.0))
3903            (inexact? (truncate -1.0))))
3904
3905     (pass-if "-3.1"
3906       (and (= -3.0   (truncate -3.1))
3907            (inexact? (truncate -3.1))))
3908
3909     (pass-if "3.1"
3910       (and (= 3.0    (truncate 3.1))
3911            (inexact? (truncate 3.1))))
3912
3913     (pass-if "3.9"
3914       (and (= 3.0    (truncate 3.9))
3915            (inexact? (truncate 3.9))))
3916
3917     (pass-if "-3.9"
3918       (and (= -3.0   (truncate -3.9))
3919            (inexact? (truncate -3.9))))
3920
3921     (pass-if "1.5"
3922       (and (= 1.0    (truncate 1.5))
3923            (inexact? (truncate 1.5))))
3924
3925     (pass-if "2.5"
3926       (and (= 2.0    (truncate 2.5))
3927            (inexact? (truncate 2.5))))
3928
3929     (pass-if "3.5"
3930       (and (= 3.0    (truncate 3.5))
3931            (inexact? (truncate 3.5))))
3932
3933     (pass-if "-1.5"
3934       (and (= -1.0   (truncate -1.5))
3935            (inexact? (truncate -1.5))))
3936
3937     (pass-if "-2.5"
3938       (and (= -2.0   (truncate -2.5))
3939            (inexact? (truncate -2.5))))
3940
3941     (pass-if "-3.5"
3942       (and (= -3.0   (truncate -3.5))
3943            (inexact? (truncate -3.5))))))
3944
3945 ;;;
3946 ;;; round
3947 ;;;
3948
3949 (with-test-prefix "round"
3950   (pass-if (=  2 (round  1.75)))
3951   (pass-if (=  2 (round  1.5)))
3952   (pass-if (=  1 (round  1.25)))
3953   (pass-if (=  1 (round  0.75)))
3954   (pass-if (=  0 (round  0.5)))
3955   (pass-if (=  0 (round  0.0)))
3956   (pass-if (=  0 (round -0.5)))
3957   (pass-if (= -1 (round -1.25)))
3958   (pass-if (= -2 (round -1.5)))
3959
3960   (with-test-prefix "inum"
3961     (pass-if "0"
3962       (and (= 0    (round 0))
3963            (exact? (round 0))))
3964
3965     (pass-if "1"
3966       (and (= 1    (round 1))
3967            (exact? (round 1))))
3968
3969     (pass-if "-1"
3970       (and (= -1   (round -1))
3971            (exact? (round -1)))))
3972
3973   (with-test-prefix "bignum"
3974     (let ((x (1+ most-positive-fixnum)))
3975       (pass-if "(1+ most-positive-fixnum)"
3976         (and (= x    (round x))
3977              (exact? (round x)))))
3978
3979     (let ((x (1- most-negative-fixnum)))
3980       (pass-if "(1- most-negative-fixnum)"
3981         (and (= x    (round x))
3982              (exact? (round x))))))
3983
3984   (with-test-prefix "frac"
3985     (define (=exact x y)
3986       (and (= x y)
3987            (exact? y)))
3988
3989     (pass-if (=exact -2 (round -7/3)))
3990     (pass-if (=exact -2 (round -5/3)))
3991     (pass-if (=exact -1 (round -4/3)))
3992     (pass-if (=exact -1 (round -2/3)))
3993     (pass-if (=exact  0 (round -1/3)))
3994     (pass-if (=exact  0 (round  1/3)))
3995     (pass-if (=exact  1 (round  2/3)))
3996     (pass-if (=exact  1 (round  4/3)))
3997     (pass-if (=exact  2 (round  5/3)))
3998     (pass-if (=exact  2 (round  7/3)))
3999
4000     (pass-if (=exact -3 (round -17/6)))
4001     (pass-if (=exact -3 (round -16/6)))
4002     (pass-if (=exact -2 (round -15/6)))
4003     (pass-if (=exact -2 (round -14/6)))
4004     (pass-if (=exact -2 (round -13/6)))
4005     (pass-if (=exact -2 (round -11/6)))
4006     (pass-if (=exact -2 (round -10/6)))
4007     (pass-if (=exact -2 (round  -9/6)))
4008     (pass-if (=exact -1 (round  -8/6)))
4009     (pass-if (=exact -1 (round  -7/6)))
4010     (pass-if (=exact -1 (round  -5/6)))
4011     (pass-if (=exact -1 (round  -4/6)))
4012     (pass-if (=exact  0 (round  -3/6)))
4013     (pass-if (=exact  0 (round  -2/6)))
4014     (pass-if (=exact  0 (round  -1/6)))
4015     (pass-if (=exact  0 (round   1/6)))
4016     (pass-if (=exact  0 (round   2/6)))
4017     (pass-if (=exact  0 (round   3/6)))
4018     (pass-if (=exact  1 (round   4/6)))
4019     (pass-if (=exact  1 (round   5/6)))
4020     (pass-if (=exact  1 (round   7/6)))
4021     (pass-if (=exact  1 (round   8/6)))
4022     (pass-if (=exact  2 (round   9/6)))
4023     (pass-if (=exact  2 (round  10/6)))
4024     (pass-if (=exact  2 (round  11/6)))
4025     (pass-if (=exact  2 (round  13/6)))
4026     (pass-if (=exact  2 (round  14/6)))
4027     (pass-if (=exact  2 (round  15/6)))
4028     (pass-if (=exact  3 (round  16/6)))
4029     (pass-if (=exact  3 (round  17/6))))
4030
4031   (with-test-prefix "real"
4032     (pass-if "0.0"
4033       (and (= 0.0    (round 0.0))
4034            (inexact? (round 0.0))))
4035
4036     (pass-if "1.0"
4037       (and (= 1.0    (round 1.0))
4038            (inexact? (round 1.0))))
4039
4040     (pass-if "-1.0"
4041       (and (= -1.0   (round -1.0))
4042            (inexact? (round -1.0))))
4043
4044     (pass-if "-3.1"
4045       (and (= -3.0   (round -3.1))
4046            (inexact? (round -3.1))))
4047
4048     (pass-if "3.1"
4049       (and (= 3.0    (round 3.1))
4050            (inexact? (round 3.1))))
4051
4052     (pass-if "3.9"
4053       (and (= 4.0    (round 3.9))
4054            (inexact? (round 3.9))))
4055
4056     (pass-if "-3.9"
4057       (and (= -4.0   (round -3.9))
4058            (inexact? (round -3.9))))
4059
4060     (pass-if "1.5"
4061       (and (= 2.0    (round 1.5))
4062            (inexact? (round 1.5))))
4063
4064     (pass-if "2.5"
4065       (and (= 2.0    (round 2.5))
4066            (inexact? (round 2.5))))
4067
4068     (pass-if "3.5"
4069       (and (= 4.0    (round 3.5))
4070            (inexact? (round 3.5))))
4071
4072     (pass-if "-1.5"
4073       (and (= -2.0   (round -1.5))
4074            (inexact? (round -1.5))))
4075
4076     (pass-if "-2.5"
4077       (and (= -2.0   (round -2.5))
4078            (inexact? (round -2.5))))
4079
4080     (pass-if "-3.5"
4081       (and (= -4.0   (round -3.5))
4082            (inexact? (round -3.5))))
4083
4084     ;; prior to guile 1.6.5, on an IEEE system an inexact 2^53-1 (ie. a
4085     ;; float with mantissa all ones) came out as 2^53 from `round' (except
4086     ;; on i386 and m68k systems using the coprocessor and optimizing, where
4087     ;; extra precision hid the problem)
4088     (pass-if "2^53-1"
4089       (let ((x (exact->inexact (1- (ash 1 53)))))
4090         (and (= x      (round x))
4091              (inexact? (round x)))))
4092     (pass-if "-(2^53-1)"
4093       (let ((x (exact->inexact (- (1- (ash 1 53))))))
4094         (and (= x      (round x))
4095              (inexact? (round x)))))))
4096
4097 ;;;
4098 ;;; exact->inexact
4099 ;;;
4100
4101 (with-test-prefix "exact->inexact"
4102
4103   ;; Test "(exact->inexact n)", expect "want".
4104   (define (test name n want)
4105     (with-test-prefix name
4106       (pass-if-equal "pos" want (exact->inexact n))
4107       (pass-if-equal "neg" (- want) (exact->inexact (- n)))))
4108
4109   ;; Test "(exact->inexact n)", expect "want".
4110   ;; "i" is a index, for diagnostic purposes.
4111   (define (try-i i n want)
4112     (test (list i n want) n want))
4113
4114   (with-test-prefix "2^i, no round"
4115     (do ((i    0   (1+ i))
4116          (n    1   (* 2 n))
4117          (want 1.0 (* 2.0 want)))
4118         ((> i 100))
4119       (try-i i n want)))
4120
4121   (with-test-prefix "2^i+1, no round"
4122     (do ((i    1   (1+ i))
4123          (n    3   (1- (* 2 n)))
4124          (want 3.0 (- (* 2.0 want) 1.0)))
4125         ((>= i dbl-mant-dig))
4126       (try-i i n want)))
4127
4128   (with-test-prefix "(2^i+1)*2^100, no round"
4129     (do ((i    1   (1+ i))
4130          (n    3   (1- (* 2 n)))
4131          (want 3.0 (- (* 2.0 want) 1.0)))
4132         ((>= i dbl-mant-dig))
4133       (try-i i (ash n 100) (ash-flo want 100))))
4134
4135   ;; bit pattern: 1111....11100.00
4136   ;;              <-mantdig-><-i->
4137   ;;
4138   (with-test-prefix "mantdig ones then zeros, no rounding"
4139     (do ((i    0  (1+ i))
4140          (n    (- (ash     1   dbl-mant-dig) 1)   (* 2 n))
4141          (want (- (ash-flo 1.0 dbl-mant-dig) 1.0) (* 2.0 want)))
4142         ((> i 100))
4143       (try-i i n want)))
4144
4145   ;; bit pattern: 1111....111011..1
4146   ;;              <-mantdig-> <-i->
4147   ;; This sort of value was incorrectly rounded upwards in Guile 1.6.4 when
4148   ;; i >= 11 (that's when the total is 65 or more bits).
4149   ;;
4150   (with-test-prefix "mantdig ones then 011..11, round down"
4151     (do ((i    0  (1+ i))
4152          (n    (- (ash     1   (+ 1 dbl-mant-dig)) 2)   (+ 1 (* 2 n)))
4153          (want (- (ash-flo 1.0 (+ 1 dbl-mant-dig)) 2.0) (* 2.0 want)))
4154         ((> i 100))
4155       (try-i i n want)))
4156
4157   ;; bit pattern: 1111....111100..001
4158   ;;              <-mantdig-> <--i->
4159   ;;
4160   (with-test-prefix "mantdig ones then 100..001, round up"
4161     (do ((i    0  (1+ i))
4162          (n    (- (ash     1   (+ 2 dbl-mant-dig)) 1)  (1- (* 2 n)))
4163          (want    (ash-flo 1.0 (+ 2 dbl-mant-dig))     (* 2.0 want)))
4164         ((> i 100))
4165       (try-i i n want)))
4166
4167   ;; bit pattern: 1000....000100..001
4168   ;;              <-mantdig-> <--i->
4169   ;;
4170   (with-test-prefix "2^mantdig then 100..001, round up"
4171     (do ((i    0  (1+ i))
4172          (n    (- (ash     1   (+ 2 dbl-mant-dig)) 1)   (1- (* 2 n)))
4173          (want (+ (ash-flo 1.0 (+ 2 dbl-mant-dig)) 4.0) (* 2.0 want)))
4174         ((> i 100))
4175       (try-i i n want)))
4176
4177   (pass-if "frac big/big"
4178     (let ((big (ash 1 256)))
4179       (= 1.0 (exact->inexact (/ (1+ big) big)))))
4180
4181   ;; In guile 1.8.0 this failed, giving back "nan" because it tried to
4182   ;; convert the num and den to doubles, resulting in infs.
4183   (pass-if "frac big/big, exceeding double"
4184     (let ((big (ash 1 4096)))
4185       (= 1.0 (exact->inexact (/ (1+ big) big)))))
4186
4187   ;; In guile 2.0.9, 'exact->inexact' guaranteed proper rounding when
4188   ;; applied to non-negative fractions, but on 64-bit systems would
4189   ;; sometimes double-round when applied to negative fractions,
4190   ;; specifically when the numerator was a fixnum not exactly
4191   ;; representable as a double.
4192   (with-test-prefix "frac inum/inum, numerator not exactly representable as a double"
4193     (let ((n (+ 1 (expt 2 dbl-mant-dig))))
4194       (for-each (lambda (d)
4195                   (test (/ n d)
4196                         (/ n d)
4197                         (exact->inexact (/ n d))))
4198                 '(3 5 6 7 9 11 13 17 19 23 0.0 -0.0 +nan.0 +inf.0 -inf.0))))
4199
4200   (test "round up to odd"
4201         ;; =====================================================
4202         ;; 11111111111111111111111111111111111111111111111111000101 ->
4203         ;; 11111111111111111111111111111111111111111111111111001000
4204         (+ (expt 2   (+ dbl-mant-dig 3)) -64 #b000101)
4205         (+ (expt 2.0 (+ dbl-mant-dig 3)) -64 #b001000))
4206
4207   (test "round down to odd"
4208         ;; =====================================================
4209         ;; 11111111111111111111111111111111111111111111111111001011 ->
4210         ;; 11111111111111111111111111111111111111111111111111001000
4211         (+ (expt 2   (+ dbl-mant-dig 3)) -64 #b001011)
4212         (+ (expt 2.0 (+ dbl-mant-dig 3)) -64 #b001000))
4213
4214   (test "round tie up to even"
4215         ;; =====================================================
4216         ;; 11111111111111111111111111111111111111111111111111011100 ->
4217         ;; 11111111111111111111111111111111111111111111111111100000
4218         (+ (expt 2   (+ dbl-mant-dig 3)) -64 #b011100)
4219         (+ (expt 2.0 (+ dbl-mant-dig 3)) -64 #b100000))
4220
4221   (test "round tie down to even"
4222         ;; =====================================================
4223         ;; 11111111111111111111111111111111111111111111111111000100 ->
4224         ;; 11111111111111111111111111111111111111111111111111000000
4225         (+ (expt 2   (+ dbl-mant-dig 3)) -64 #b000100)
4226         (+ (expt 2.0 (+ dbl-mant-dig 3)) -64 #b000000))
4227
4228   (test "round tie up to next power of two"
4229         ;;  =====================================================
4230         ;;  11111111111111111111111111111111111111111111111111111100 ->
4231         ;; 100000000000000000000000000000000000000000000000000000000
4232         (+ (expt 2 (+ dbl-mant-dig 3)) -64 #b111100)
4233         (expt 2.0 (+ dbl-mant-dig 3)))
4234
4235   (test "miniscule value rounds to zero of appropriate sign"
4236         (expt 17 (- dbl-min-exp dbl-mant-dig))
4237         0.0)
4238
4239   (test "smallest inexact"
4240         (expt 2 (- dbl-min-exp dbl-mant-dig))
4241         (expt 2.0 (- dbl-min-exp dbl-mant-dig)))
4242
4243   (test "1/2 smallest inexact rounds down to zero"
4244         (* 1/2 (expt 2 (- dbl-min-exp dbl-mant-dig)))
4245         0.0)
4246
4247   (test "just over 1/2 smallest inexact rounds up"
4248         (+ (* 1/2 (expt 2 (- dbl-min-exp dbl-mant-dig)))
4249            (expt 7 (- dbl-min-exp dbl-mant-dig)))
4250         (expt 2.0 (- dbl-min-exp dbl-mant-dig)))
4251
4252   (test "3/2 smallest inexact rounds up to twice smallest inexact"
4253         (* 3/2 (expt 2 (- dbl-min-exp dbl-mant-dig)))
4254         (* 2.0 (expt 2.0 (- dbl-min-exp dbl-mant-dig))))
4255
4256   (test "just under 3/2 smallest inexact rounds down"
4257         (- (* 3/2 (expt 2 (- dbl-min-exp dbl-mant-dig)))
4258            (expt 11 (- dbl-min-exp dbl-mant-dig)))
4259         (expt 2.0 (- dbl-min-exp dbl-mant-dig)))
4260
4261   (test "5/2 smallest inexact rounds down to twice smallest inexact"
4262         (* 5/2 (expt 2 (- dbl-min-exp dbl-mant-dig)))
4263         (* 2.0 (expt 2.0 (- dbl-min-exp dbl-mant-dig))))
4264
4265   (test "just over 5/2 smallest inexact rounds up"
4266         (+ (* 5/2 (expt 2 (- dbl-min-exp dbl-mant-dig)))
4267            (expt 13 (- dbl-min-exp dbl-mant-dig)))
4268         (* 3.0 (expt 2.0 (- dbl-min-exp dbl-mant-dig))))
4269
4270   (test "one plus dbl-epsilon"
4271         (+ 1 dbl-epsilon-exact)
4272         (+ 1.0 dbl-epsilon))
4273
4274   (test "one plus 1/2 dbl-epsilon rounds down to 1.0"
4275         (+ 1 (* 1/2 dbl-epsilon-exact))
4276         1.0)
4277
4278   (test "just over one plus 1/2 dbl-epsilon rounds up"
4279         (+ 1
4280            (* 1/2 dbl-epsilon-exact)
4281            (expt 13 (- dbl-min-exp dbl-mant-dig)))
4282         (+ 1.0 dbl-epsilon))
4283
4284   (test "one plus 3/2 dbl-epsilon rounds up"
4285         (+ 1 (* 3/2 dbl-epsilon-exact))
4286         (+ 1.0 (* 2.0 dbl-epsilon)))
4287
4288   (test "just under one plus 3/2 dbl-epsilon rounds down"
4289         (+ 1
4290            (* 3/2 dbl-epsilon-exact)
4291            (- (expt 17 (- dbl-min-exp dbl-mant-dig))))
4292         (+ 1.0 dbl-epsilon))
4293
4294   (test "one plus 5/2 dbl-epsilon rounds down"
4295         (+ 1 (* 5/2 dbl-epsilon-exact))
4296         (+ 1.0 (* 2.0 dbl-epsilon)))
4297
4298   (test "just over one plus 5/2 dbl-epsilon rounds up"
4299         (+ 1
4300            (* 5/2 dbl-epsilon-exact)
4301            (expt 13 (- dbl-min-exp dbl-mant-dig)))
4302         (+ 1.0 (* 3.0 dbl-epsilon)))
4303
4304   (test "largest finite inexact"
4305         (* (- (expt 2 dbl-mant-dig) 1)
4306            (expt 2 (- dbl-max-exp dbl-mant-dig)))
4307         (* (- (expt 2.0 dbl-mant-dig) 1)
4308            (expt 2.0 (- dbl-max-exp dbl-mant-dig))))
4309
4310   (test "largest finite inexact plus 1/2 epsilon rounds up to infinity"
4311         (* (+ (expt 2 dbl-mant-dig) -1 1/2)
4312            (expt 2 (- dbl-max-exp dbl-mant-dig)))
4313         (inf))
4314
4315   (test "largest finite inexact plus just under 1/2 epsilon rounds down"
4316         (* (+ (expt 2 dbl-mant-dig) -1 1/2
4317               (- (expt 13 (- dbl-min-exp dbl-mant-dig))))
4318            (expt 2 (- dbl-max-exp dbl-mant-dig)))
4319         (* (- (expt 2.0 dbl-mant-dig) 1)
4320            (expt 2.0 (- dbl-max-exp dbl-mant-dig))))
4321
4322   (test "1/2 largest finite inexact"
4323         (* (- (expt 2 dbl-mant-dig) 1)
4324            (expt 2 (- dbl-max-exp dbl-mant-dig 1)))
4325         (* (- (expt 2.0 dbl-mant-dig) 1)
4326            (expt 2.0 (- dbl-max-exp dbl-mant-dig 1))))
4327
4328   (test "1/2 largest finite inexact plus 1/2 epsilon rounds up to next power of two"
4329         (* (+ (expt 2 dbl-mant-dig) -1 1/2)
4330            (expt 2 (- dbl-max-exp dbl-mant-dig 1)))
4331         (expt 2.0 (- dbl-max-exp 1)))
4332
4333   (test "1/2 largest finite inexact plus just over 1/2 epsilon rounds up to next power of two"
4334         (* (+ (expt 2 dbl-mant-dig) -1 1/2
4335               (expt 13 (- dbl-min-exp dbl-mant-dig)))
4336            (expt 2 (- dbl-max-exp dbl-mant-dig 1)))
4337         (expt 2.0 (- dbl-max-exp 1)))
4338
4339   (test "1/2 largest finite inexact plus just under 1/2 epsilon rounds down"
4340         (* (+ (expt 2 dbl-mant-dig) -1 1/2
4341               (- (expt 13 (- dbl-min-exp dbl-mant-dig))))
4342            (expt 2 (- dbl-max-exp dbl-mant-dig 1)))
4343         (* (- (expt 2.0 dbl-mant-dig) 1)
4344            (expt 2.0 (- dbl-max-exp dbl-mant-dig 1))))
4345
4346   )
4347
4348 ;;;
4349 ;;; expt
4350 ;;;
4351
4352 (with-test-prefix "expt"
4353   (pass-if (documented? expt))
4354
4355   ;;
4356   ;; expt no longer requires its first argument to be a scheme number,
4357   ;; for the sake of extensibility, and expt calls integer-expt for
4358   ;; integer powers.  To raise to a positive power, all that is required
4359   ;; is that it can be multiplied using `*'.  For negative powers we
4360   ;; must also be able to find the reciprocal.  If we try to raise #t to
4361   ;; any power other than 0 or 1 it may throw an exception, depending on
4362   ;; whether * has been defined for #t.  However, when raising to the 0
4363   ;; or 1 power, the first argument is not manipulated at all.
4364   ;;
4365   ;; (pass-if-exception "non-numeric base" exception:wrong-type-arg
4366   ;;                    (expt #t 0))
4367   ;;
4368
4369   (pass-if (eqv? 1 (expt 0 0)))
4370   (pass-if (eqv? 1 (expt 0.0 0)))
4371   (pass-if (eqv? 1.0 (expt 0 0.0)))
4372   (pass-if (eqv? 1.0 (expt 0.0 0.0)))
4373   (pass-if (real-nan? (expt 0 -1)))
4374   (pass-if (real-nan? (expt 0 -1.0)))
4375   (pass-if (real-nan? (expt 0.0 -1)))
4376   (pass-if (real-nan? (expt 0.0 -1.0)))
4377   (pass-if (eqv? 0 (expt 0 3)))
4378   (pass-if (= 0 (expt 0 4.0)))
4379   (pass-if (eqv? 0.0 (expt 0.0 5)))
4380   (pass-if (eqv? 0.0 (expt 0.0 6.0)))
4381   (pass-if (eqv? -2742638075.5 (expt -2742638075.5 1)))
4382   (pass-if (eqv? (* -2742638075.5 -2742638075.5)
4383                  (expt -2742638075.5 2)))
4384   (pass-if (eqv? 4.0 (expt -2.0 2.0)))
4385   (pass-if (eqv? -1/8 (expt -2 -3)))
4386   (pass-if (eqv? -0.125 (expt -2.0 -3)))
4387   (pass-if (eqv? -0.125 (expt -2 -3.0)))
4388   (pass-if (eqv? -0.125 (expt -2.0 -3.0)))
4389   (pass-if (eqv? 0.25 (expt 2.0 -2.0)))
4390   (pass-if (eqv? 32/243 (expt 2/3 5)))
4391   (pass-if (eqv? 243/32 (expt 2/3 -5)))
4392   (pass-if (eqv? 32 (expt 1/2 -5)))
4393   (pass-if (test-eqv? (* -1.0+0.0i 12398 12398) (expt +12398i 2.0)))
4394   (pass-if (eqv-loosely? +i (expt -1 0.5)))
4395   (pass-if (eqv-loosely? +i (expt -1 1/2)))
4396   (pass-if (eqv-loosely? 1.0+1.7320508075688i (expt -8 1/3)))
4397   (pass-if (eqv? +inf.0 (expt 2 +inf.0)))
4398   (pass-if (eqv? +inf.0 (expt 2.0 +inf.0)))
4399   (pass-if (eqv? 0.0 (expt 2 -inf.0)))
4400   (pass-if (eqv? 0.0 (expt 2.0 -inf.0))))
4401
4402
4403 ;;;
4404 ;;; sin
4405 ;;;
4406
4407 (with-test-prefix "sin"
4408   (pass-if (eqv? 0   (sin 0)))
4409   (pass-if (eqv? 0.0 (sin 0.0)))
4410   (pass-if (eqv-loosely? 1.0 (sin 1.57)))
4411   (pass-if (eqv-loosely? +1.175i (sin +i)))
4412   (pass-if (real-nan? (sin +nan.0)))
4413   (pass-if (real-nan? (sin +inf.0)))
4414   (pass-if (real-nan? (sin -inf.0))))
4415
4416 ;;;
4417 ;;; cos
4418 ;;;
4419
4420 (with-test-prefix "cos"
4421   (pass-if (eqv? 1   (cos 0)))
4422   (pass-if (eqv? 1.0 (cos 0.0)))
4423   (pass-if (eqv-loosely? 0.0 (cos 1.57)))
4424   (pass-if (eqv-loosely? 1.543 (cos +i)))
4425   (pass-if (real-nan? (cos +nan.0)))
4426   (pass-if (real-nan? (cos +inf.0)))
4427   (pass-if (real-nan? (cos -inf.0))))
4428
4429 ;;;
4430 ;;; tan
4431 ;;;
4432
4433 (with-test-prefix "tan"
4434   (pass-if (eqv? 0   (tan 0)))
4435   (pass-if (eqv? 0.0 (tan 0.0)))
4436   (pass-if (eqv-loosely? 1.0 (tan 0.785)))
4437   (pass-if (eqv-loosely? +0.76i (tan +i)))
4438   (pass-if (real-nan? (tan +nan.0)))
4439   (pass-if (real-nan? (tan +inf.0)))
4440   (pass-if (real-nan? (tan -inf.0))))
4441
4442 ;;;
4443 ;;; asin
4444 ;;;
4445
4446 (with-test-prefix "asin"
4447   (pass-if (complex-nan? (asin +nan.0)))
4448   (pass-if (eqv? 0 (asin 0)))
4449   (pass-if (eqv? 0.0 (asin 0.0))))
4450
4451 ;;;
4452 ;;; acos
4453 ;;;
4454
4455 (with-test-prefix "acos"
4456   (pass-if (complex-nan? (acos +nan.0)))
4457   (pass-if (eqv? 0 (acos 1)))
4458   (pass-if (eqv? 0.0 (acos 1.0))))
4459
4460 ;;;
4461 ;;; atan
4462 ;;;
4463 ;;; FIXME: add tests for two-argument atan
4464 ;;;
4465 (with-test-prefix "atan"
4466   (pass-if (real-nan? (atan +nan.0)))
4467   (pass-if (eqv? 0 (atan 0)))
4468   (pass-if (eqv? 0.0 (atan 0.0)))
4469   (pass-if (eqv-loosely?  1.57 (atan +inf.0)))
4470   (pass-if (eqv-loosely? -1.57 (atan -inf.0))))
4471
4472 ;;;
4473 ;;; sinh
4474 ;;;
4475
4476 (with-test-prefix "sinh"
4477   (pass-if (= 0 (sinh 0)))
4478   (pass-if (= 0.0 (sinh 0.0))))
4479
4480 ;;;
4481 ;;; cosh
4482 ;;;
4483
4484 (with-test-prefix "cosh"
4485   (pass-if (= 1 (cosh 0)))
4486   (pass-if (= 1.0 (cosh 0.0))))
4487
4488 ;;;
4489 ;;; tanh
4490 ;;;
4491
4492 (with-test-prefix "tanh"
4493   (pass-if (= 0 (tanh 0)))
4494   (pass-if (= 0.0 (tanh 0.0))))
4495
4496 ;;;
4497 ;;; asinh
4498 ;;;
4499
4500 (with-test-prefix "asinh"
4501   (pass-if (= 0 (asinh 0)))
4502   (pass-if (= 0.0 (asinh 0.0))))
4503
4504 ;;;
4505 ;;; acosh
4506 ;;;
4507
4508 (with-test-prefix "acosh"
4509   (pass-if (= 0 (acosh 1)))
4510   (pass-if (= 0.0 (acosh 1.0))))
4511
4512 ;;;
4513 ;;; atanh
4514 ;;;
4515
4516 (with-test-prefix "atanh"
4517   (pass-if (= 0 (atanh 0)))
4518   (pass-if (= 0.0 (atanh 0.0))))
4519
4520 ;;;
4521 ;;; make-rectangular
4522 ;;;
4523
4524 (with-test-prefix "make-rectangular"
4525   (pass-if (real?      (make-rectangular 5.0  0  )))
4526   (pass-if (not (real? (make-rectangular 5.0  0.0))))
4527   (pass-if (not (real? (make-rectangular 5.0 -0.0)))))
4528
4529 ;;;
4530 ;;; make-polar
4531 ;;;
4532
4533 (with-test-prefix "make-polar"
4534   (define pi 3.14159265358979323846)
4535   (define (almost= x y)
4536     (> 0.01 (magnitude (- x y))))
4537
4538   (pass-if (real?      (make-polar 0    1.0)))
4539   (pass-if (real?      (make-polar 5.0  0  )))
4540   (pass-if (not (real? (make-polar 5.0  0.0))))
4541   (pass-if (not (real? (make-polar 5.0 -0.0))))
4542
4543   (pass-if (eqv?  0 (make-polar  0 0)))
4544   (pass-if (eqv?  0 (make-polar  0 123.456)))
4545   (pass-if (eqv?  1 (make-polar  1 0)))
4546   (pass-if (eqv? -1 (make-polar -1 0)))
4547
4548   (pass-if (almost= 0+i (make-polar 1 (* 0.5 pi))))
4549   (pass-if (almost= -1  (make-polar 1 (* 1.0 pi))))
4550   (pass-if (almost= 0-i (make-polar 1 (* 1.5 pi))))
4551   (pass-if (almost= 1   (make-polar 1 (* 2.0 pi)))))
4552
4553 ;;;
4554 ;;; real-part
4555 ;;;
4556
4557 (with-test-prefix "real-part"
4558   (pass-if (documented? real-part))
4559   (pass-if (eqv? 5.0 (real-part  5.0)))
4560   (pass-if (eqv? 0.0 (real-part +5.0i)))
4561   (pass-if (eqv? 5   (real-part  5)))
4562   (pass-if (eqv? 1/5 (real-part  1/5)))
4563   (pass-if (eqv? (1+ fixnum-max) (real-part (1+ fixnum-max)))))
4564
4565 ;;;
4566 ;;; imag-part
4567 ;;;
4568
4569 (with-test-prefix "imag-part"
4570   (pass-if (documented? imag-part))
4571   (pass-if (eqv? 0   (imag-part  5.0)))
4572   (pass-if (eqv? 5.0 (imag-part +5.0i)))
4573   (pass-if (eqv? 0   (imag-part  5)))
4574   (pass-if (eqv? 0   (imag-part  1/5)))
4575   (pass-if (eqv? 0   (imag-part (1+ fixnum-max)))))
4576
4577 ;;;
4578 ;;; magnitude
4579 ;;;
4580
4581 (with-test-prefix "magnitude"
4582   (pass-if (documented? magnitude))
4583   (pass-if (= 0 (magnitude 0)))
4584   (pass-if (= 1 (magnitude 1)))
4585   (pass-if (= 1 (magnitude -1)))
4586   (pass-if (= 1 (magnitude 0+i)))
4587   (pass-if (= 1 (magnitude 0-i)))
4588   (pass-if (= 5 (magnitude 3+4i)))
4589   (pass-if (= 5 (magnitude 3-4i)))
4590   (pass-if (= 5 (magnitude -3+4i)))
4591   (pass-if (= 5 (magnitude -3-4i))))
4592
4593 ;;;
4594 ;;; angle
4595 ;;;
4596
4597 (with-test-prefix "angle"
4598   (define pi 3.14159265358979323846)
4599   (define (almost= x y)
4600     (> 0.000001 (magnitude (- x y))))
4601
4602   (pass-if (documented? angle))
4603
4604   (pass-if "inum +ve"   (=        0 (angle 1)))
4605   (pass-if "inum -ve"   (almost= pi (angle -1)))
4606
4607   (pass-if "bignum +ve" (=        0 (angle (1+ fixnum-max))))
4608   (pass-if "bignum -ve" (almost= pi (angle (1- fixnum-min))))
4609
4610   (pass-if "flonum +ve" (=        0 (angle 1.5)))
4611   (pass-if "flonum -ve" (almost= pi (angle -1.5)))
4612
4613   (pass-if "signed zero +ve" (=        0 (angle 0.0)))
4614   (pass-if "signed zero -ve" (almost= pi (angle -0.0))))
4615
4616 ;;;
4617 ;;; inexact->exact
4618 ;;;
4619
4620 (with-test-prefix "inexact->exact"
4621
4622   ;; Test "(inexact->exact f)", expect "want".
4623   (define (test name f want)
4624     (with-test-prefix name
4625       (pass-if-equal "pos" want (inexact->exact f))
4626       (pass-if-equal "neg" (- want) (inexact->exact (- f)))))
4627
4628   (pass-if (documented? inexact->exact))
4629
4630   (pass-if-exception "+inf" exception:out-of-range
4631     (inexact->exact +inf.0))
4632
4633   (pass-if-exception "-inf" exception:out-of-range
4634     (inexact->exact -inf.0))
4635
4636   (pass-if-exception "nan" exception:out-of-range
4637     (inexact->exact +nan.0))
4638
4639   (test "0.0" 0.0 0)
4640   (test "small even integer" 72.0 72)
4641   (test "small odd integer"  73.0 73)
4642
4643   (test "largest inexact odd integer"
4644         (- (expt 2.0 dbl-mant-dig) 1)
4645         (- (expt 2   dbl-mant-dig) 1))
4646
4647   (test "largest inexact odd integer - 1"
4648         (- (expt 2.0 dbl-mant-dig) 2)
4649         (- (expt 2   dbl-mant-dig) 2))
4650
4651   (test "largest inexact odd integer + 3"
4652         (+ (expt 2.0 dbl-mant-dig) 2)
4653         (+ (expt 2   dbl-mant-dig) 2))
4654
4655   (test "largest inexact odd integer * 2^48"
4656         (* (expt 2.0 48) (- (expt 2.0 dbl-mant-dig) 1))
4657         (* (expt 2   48) (- (expt 2   dbl-mant-dig) 1)))
4658
4659   (test "largest inexact odd integer / 2^48"
4660         (* (expt 0.5 48) (- (expt 2.0 dbl-mant-dig) 1))
4661         (* (expt 1/2 48) (- (expt 2   dbl-mant-dig) 1)))
4662
4663   (test "largest finite inexact"
4664         (* (- (expt 2.0 dbl-mant-dig) 1)
4665            (expt 2.0 (- dbl-max-exp dbl-mant-dig)))
4666         (* (- (expt 2 dbl-mant-dig) 1)
4667            (expt 2 (- dbl-max-exp dbl-mant-dig))))
4668
4669   (test "smallest inexact"
4670         (expt 2.0 (- dbl-min-exp dbl-mant-dig))
4671         (expt 2   (- dbl-min-exp dbl-mant-dig)))
4672
4673   (test "smallest inexact * 2"
4674         (* 2.0 (expt 2.0 (- dbl-min-exp dbl-mant-dig)))
4675         (* 2   (expt 2   (- dbl-min-exp dbl-mant-dig))))
4676
4677   (test "smallest inexact * 3"
4678         (* 3.0 (expt 2.0 (- dbl-min-exp dbl-mant-dig)))
4679         (* 3   (expt 2   (- dbl-min-exp dbl-mant-dig))))
4680
4681   (with-test-prefix "2.0**i to exact"
4682     (do ((i 0   (1+ i))
4683          (n 1   (* 2 n))
4684          (f 1.0 (* 2.0 f)))
4685         ((> i 100))
4686       (test (list i n) f n))))
4687
4688 ;;;
4689 ;;; integer-expt
4690 ;;;
4691
4692 (with-test-prefix "integer-expt"
4693   (pass-if (documented? integer-expt))
4694
4695   (pass-if-exception "2^+inf" exception:wrong-type-arg
4696     (integer-expt 2 +inf.0))
4697   (pass-if-exception "2^-inf" exception:wrong-type-arg
4698     (integer-expt 2 -inf.0))
4699   (pass-if-exception "2^nan" exception:wrong-type-arg
4700     (integer-expt 2 +nan.0))
4701
4702   (pass-if (eqv? 1 (integer-expt 0 0)))
4703   (pass-if (eqv? 1 (integer-expt 0.0 0)))
4704   (pass-if (real-nan? (integer-expt 0 -1)))
4705   (pass-if (real-nan? (integer-expt 0.0 -1)))
4706   (pass-if (eqv? 0 (integer-expt 0 3)))
4707   (pass-if (eqv? 0.0 (integer-expt 0.0 5)))
4708   (pass-if (eqv? -2742638075.5 (integer-expt -2742638075.5 1)))
4709   (pass-if (eqv? (* -2742638075.5 -2742638075.5)
4710                  (integer-expt -2742638075.5 2)))
4711   (pass-if (eqv? 4.0 (integer-expt -2.0 2)))
4712   (pass-if (eqv? -1/8 (integer-expt -2 -3)))
4713   (pass-if (eqv? -0.125 (integer-expt -2.0 -3)))
4714   (pass-if (eqv? 0.25 (integer-expt 2.0 -2)))
4715   (pass-if (eqv? 32/243 (integer-expt 2/3 5)))
4716   (pass-if (eqv? 243/32 (integer-expt 2/3 -5)))
4717   (pass-if (eqv? 32 (integer-expt 1/2 -5)))
4718   (pass-if (test-eqv? (* -1.0+0.0i 12398 12398) (integer-expt +12398.0i 2))))
4719
4720
4721 ;;;
4722 ;;; integer-length
4723 ;;;
4724
4725 (with-test-prefix "integer-length"
4726   (pass-if (documented? integer-length))
4727
4728   (with-test-prefix "-2^i, ...11100..00"
4729     (do ((n -1 (ash n 1))
4730          (i 0  (1+ i)))
4731         ((> i 256))
4732       (pass-if (list n "expect" i)
4733         (= i (integer-length n)))))
4734
4735   (with-test-prefix "-2^i+1 ...11100..01"
4736     (do ((n -3 (logxor 3 (ash n 1)))
4737          (i 2  (1+ i)))
4738         ((> i 256))
4739       (pass-if n
4740         (= i (integer-length n)))))
4741
4742   (with-test-prefix "-2^i-1 ...111011..11"
4743     (do ((n -2 (1+ (ash n 1)))
4744          (i 1  (1+ i)))
4745         ((> i 256))
4746       (pass-if n
4747         (= i (integer-length n))))))
4748
4749 ;;;
4750 ;;; log
4751 ;;;
4752
4753 (with-test-prefix "log"
4754   (pass-if (documented? log))
4755
4756   (pass-if-exception "no args" exception:wrong-num-args
4757     (log))
4758   (pass-if-exception "two args" exception:wrong-num-args
4759     (log 123 456))
4760   (pass-if-exception "(log 0)" exception:numerical-overflow
4761     (log 0))
4762
4763   (pass-if (test-eqv? -inf.0 (log 0.0)))
4764   (pass-if (test-eqv? +inf.0 (log +inf.0)))
4765   (pass-if (test-eqv? -inf.0+3.14159265358979i (log -0.0)))
4766   (pass-if (test-eqv? +inf.0+3.14159265358979i (log -inf.0)))
4767   (pass-if (test-eqv?  0.0 (log 1  )))
4768   (pass-if (test-eqv?  0.0 (log 1.0)))
4769   (pass-if (test-eqv?  1.0 (log const-e)))
4770   (pass-if (test-eqv?  2.0 (log const-e^2)))
4771   (pass-if (test-eqv? -1.0 (log const-1/e)))
4772   (pass-if (test-eqv? -1.0+3.14159265358979i (log (- const-1/e))))
4773   (pass-if (test-eqv?  2.30258509299405 (log 10)))
4774   (pass-if (test-eqv?  2.30258509299405+3.14159265358979i (log -10)))
4775
4776   (pass-if (test-eqv?  1.0+0.0i (log (+ const-e +0.0i))))
4777   (pass-if (test-eqv?  1.0-0.0i (log (+ const-e -0.0i))))
4778
4779   (pass-if (eqv-loosely?  230258.509299405 (log (expt 10  100000))))
4780   (pass-if (eqv-loosely? -230258.509299405 (log (expt 10 -100000))))
4781   (pass-if (eqv-loosely?  230257.410687116 (log (/ (expt 10 100000) 3))))
4782   (pass-if (eqv-loosely?  230258.509299405+3.14159265358979i
4783                           (log (- (expt 10 100000)))))
4784   (pass-if (eqv-loosely? -230258.509299405+3.14159265358979i
4785                           (log (- (expt 10 -100000)))))
4786   (pass-if (eqv-loosely?  230257.410687116+3.14159265358979i
4787                           (log (- (/ (expt 10 100000) 3)))))
4788   (pass-if (test-eqv?  3.05493636349961e-151
4789                        (log (/ (1+ (expt 2 500)) (expt 2 500)))))
4790
4791   (pass-if (eqv-loosely? 1.0+1.57079i (log 0+2.71828i)))
4792   (pass-if (eqv-loosely? 1.0-1.57079i (log 0-2.71828i)))
4793
4794   (pass-if (eqv-loosely? 0.0+3.14159i (log -1.0)))
4795   (pass-if (eqv-loosely? 1.0+3.14159i (log -2.71828)))
4796   (pass-if (eqv-loosely? 2.0+3.14159i (log (* -2.71828 2.71828)))))
4797
4798 ;;;
4799 ;;; log10
4800 ;;;
4801
4802 (with-test-prefix "log10"
4803   (pass-if (documented? log10))
4804
4805   (pass-if-exception "no args" exception:wrong-num-args
4806     (log10))
4807   (pass-if-exception "two args" exception:wrong-num-args
4808     (log10 123 456))
4809   (pass-if-exception "(log10 0)" exception:numerical-overflow
4810     (log10 0))
4811
4812   (pass-if (test-eqv? -inf.0 (log10 0.0)))
4813   (pass-if (test-eqv? +inf.0 (log10 +inf.0)))
4814   (pass-if (test-eqv? -inf.0+1.36437635384184i (log10 -0.0)))
4815   (pass-if (test-eqv? +inf.0+1.36437635384184i (log10 -inf.0)))
4816   (pass-if (test-eqv?  0.0 (log10   1  )))
4817   (pass-if (test-eqv?  0.0 (log10   1.0)))
4818   (pass-if (test-eqv?  1.0 (log10  10  )))
4819   (pass-if (test-eqv?  1.0 (log10  10.0)))
4820   (pass-if (test-eqv?  2.0 (log10 100.0)))
4821   (pass-if (test-eqv? -1.0 (log10   0.1)))
4822   (pass-if (test-eqv? -1.0+1.36437635384184i (log10  -0.1)))
4823   (pass-if (test-eqv?  1.0+1.36437635384184i (log10 -10  )))
4824
4825   (pass-if (test-eqv?  1.0+0.0i (log10  10.0+0.0i)))
4826   (pass-if (test-eqv?  1.0-0.0i (log10  10.0-0.0i)))
4827
4828   (pass-if (eqv-loosely?  100000.0 (log10 (expt 10  100000))))
4829   (pass-if (eqv-loosely? -100000.0 (log10 (expt 10 -100000))))
4830   (pass-if (eqv-loosely?   99999.5228787453 (log10 (/ (expt 10 100000) 3))))
4831   (pass-if (eqv-loosely?  100000.0+1.36437635384184i
4832                           (log10 (- (expt 10 100000)))))
4833   (pass-if (eqv-loosely? -100000.0+1.36437635384184i
4834                           (log10 (- (expt 10 -100000)))))
4835   (pass-if (eqv-loosely?   99999.5228787453+1.36437635384184i
4836                           (log10 (- (/ (expt 10 100000) 3)))))
4837   (pass-if (test-eqv?  1.32674200523347e-151
4838                        (log10 (/ (1+ (expt 2 500)) (expt 2 500)))))
4839
4840   (pass-if (eqv-loosely? 1.0+0.68218i (log10 0+10.0i)))
4841   (pass-if (eqv-loosely? 1.0-0.68218i (log10 0-10.0i)))
4842
4843   (pass-if (eqv-loosely? 0.0+1.36437i (log10   -1)))
4844   (pass-if (eqv-loosely? 1.0+1.36437i (log10  -10)))
4845   (pass-if (eqv-loosely? 2.0+1.36437i (log10 -100))))
4846
4847 ;;;
4848 ;;; logbit?
4849 ;;;
4850
4851 (with-test-prefix "logbit?"
4852   (pass-if (documented? logbit?))
4853
4854   (pass-if (eq? #f (logbit?  0 0)))
4855   (pass-if (eq? #f (logbit?  1 0)))
4856   (pass-if (eq? #f (logbit? 31 0)))
4857   (pass-if (eq? #f (logbit? 32 0)))
4858   (pass-if (eq? #f (logbit? 33 0)))
4859   (pass-if (eq? #f (logbit? 63 0)))
4860   (pass-if (eq? #f (logbit? 64 0)))
4861   (pass-if (eq? #f (logbit? 65 0)))
4862
4863   ;; prior to guile 1.6.5, testing bit 32, 64 etc of value 1 would wrap
4864   ;; around and return #t where it ought to be #f
4865   (pass-if (eq? #t (logbit?  0 1)))
4866   (pass-if (eq? #f (logbit?  1 1)))
4867   (pass-if (eq? #f (logbit? 31 1)))
4868   (pass-if (eq? #f (logbit? 32 1)))
4869   (pass-if (eq? #f (logbit? 33 1)))
4870   (pass-if (eq? #f (logbit? 63 1)))
4871   (pass-if (eq? #f (logbit? 64 1)))
4872   (pass-if (eq? #f (logbit? 65 1)))
4873   (pass-if (eq? #f (logbit? 128 1)))
4874
4875   (pass-if (eq? #t (logbit?  0 -1)))
4876   (pass-if (eq? #t (logbit?  1 -1)))
4877   (pass-if (eq? #t (logbit? 31 -1)))
4878   (pass-if (eq? #t (logbit? 32 -1)))
4879   (pass-if (eq? #t (logbit? 33 -1)))
4880   (pass-if (eq? #t (logbit? 63 -1)))
4881   (pass-if (eq? #t (logbit? 64 -1)))
4882   (pass-if (eq? #t (logbit? 65 -1))))
4883
4884 ;;;
4885 ;;; logcount
4886 ;;;
4887
4888 (with-test-prefix "logcount"
4889   (pass-if (documented? logcount))
4890
4891   (with-test-prefix "-2^i, meaning ...11100..00"
4892     (do ((n -1 (ash n 1))
4893          (i 0  (1+ i)))
4894         ((> i 256))
4895       (pass-if n
4896         (= i (logcount n)))))
4897
4898   (with-test-prefix "2^i"
4899     (do ((n 1 (ash n 1))
4900          (i 0  (1+ i)))
4901         ((> i 256))
4902       (pass-if n
4903         (= 1 (logcount n)))))
4904
4905   (with-test-prefix "2^i-1"
4906     (do ((n 0 (1+ (ash n 1)))
4907          (i 0  (1+ i)))
4908         ((> i 256))
4909       (pass-if n
4910         (= i (logcount n))))))
4911
4912 ;;;
4913 ;;; logior
4914 ;;;
4915
4916 (with-test-prefix "logior"
4917   (pass-if (documented? logior))
4918
4919   (pass-if (eqv? -1 (logior (ash -1 1) 1)))
4920
4921   ;; check that bignum or bignum+inum args will reduce to an inum
4922   (let ()
4923     (define (test x y)
4924       (pass-if (list x y '=> -1)
4925         (eqv? -1 (logior x y)))
4926       (pass-if (list y x '=> -1)
4927         (eqv? -1 (logior y x))))
4928     (test (ash -1 8) #xFF)
4929     (test (ash -1 28) #x0FFFFFFF)
4930     (test (ash -1 29) #x1FFFFFFF)
4931     (test (ash -1 30) #x3FFFFFFF)
4932     (test (ash -1 31) #x7FFFFFFF)
4933     (test (ash -1 32) #xFFFFFFFF)
4934     (test (ash -1 33) #x1FFFFFFFF)
4935     (test (ash -1 60) #x0FFFFFFFFFFFFFFF)
4936     (test (ash -1 61) #x1FFFFFFFFFFFFFFF)
4937     (test (ash -1 62) #x3FFFFFFFFFFFFFFF)
4938     (test (ash -1 63) #x7FFFFFFFFFFFFFFF)
4939     (test (ash -1 64) #xFFFFFFFFFFFFFFFF)
4940     (test (ash -1 65) #x1FFFFFFFFFFFFFFFF)
4941     (test (ash -1 128) #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)))
4942
4943 ;;;
4944 ;;; lognot
4945 ;;;
4946
4947 (with-test-prefix "lognot"
4948   (pass-if (documented? lognot))
4949
4950   (pass-if (= -1 (lognot 0)))
4951   (pass-if (= 0  (lognot -1)))
4952   (pass-if (= -2 (lognot 1)))
4953   (pass-if (= 1  (lognot -2)))
4954
4955   (pass-if (= #x-100000000000000000000000000000000
4956               (lognot #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)))
4957   (pass-if (= #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
4958               (lognot #x-100000000000000000000000000000000))))
4959
4960 ;;;
4961 ;;; exact-integer-sqrt
4962 ;;;
4963
4964 (with-test-prefix "exact-integer-sqrt"
4965   (define (non-negative-exact-integer? k)
4966     (and (integer? k) (exact? k) (>= k 0)))
4967
4968   (define (test k)
4969     (pass-if k (let-values (((s r) (exact-integer-sqrt k)))
4970                  (and (non-negative-exact-integer? s)
4971                       (non-negative-exact-integer? r)
4972                       (= k (+ r (* s s)))
4973                       (< k (* (1+ s) (1+ s)))))))
4974
4975   (define (test-wrong-type-arg k)
4976     (pass-if-exception k exception:wrong-type-arg
4977                        (let-values (((s r) (exact-integer-sqrt k)))
4978                          #t)))
4979
4980   (pass-if (documented? exact-integer-sqrt))
4981
4982   (pass-if-exception "no args" exception:wrong-num-args
4983     (exact-integer-sqrt))
4984   (pass-if-exception "two args" exception:wrong-num-args
4985     (exact-integer-sqrt 123 456))
4986
4987   (test 0)
4988   (test 1)
4989   (test 9)
4990   (test 10)
4991   (test fixnum-max)
4992   (test (1+ fixnum-max))
4993   (test (* fixnum-max fixnum-max))
4994   (test (+ 1 (* fixnum-max fixnum-max)))
4995   (test (expt 10 100))
4996   (test (+ 3 (expt 10 100)))
4997
4998   (test-wrong-type-arg -1)
4999   (test-wrong-type-arg 1/9)
5000   (test-wrong-type-arg fixnum-min)
5001   (test-wrong-type-arg (1- fixnum-min))
5002   (test-wrong-type-arg 1.0)
5003   (test-wrong-type-arg 1.5)
5004   (test-wrong-type-arg "foo")
5005   (test-wrong-type-arg 'foo))
5006
5007
5008 ;;;
5009 ;;; sqrt
5010 ;;;
5011
5012 (with-test-prefix "sqrt"
5013   (pass-if (documented? sqrt))
5014
5015   (pass-if-exception "no args" exception:wrong-num-args
5016     (sqrt))
5017   (pass-if-exception "two args" exception:wrong-num-args
5018     (sqrt 123 456))
5019
5020   (pass-if (eqv? 0 (sqrt 0)))
5021   (pass-if (eqv? 1 (sqrt 1)))
5022   (pass-if (eqv? 2 (sqrt 4)))
5023   (pass-if (eqv? 3 (sqrt 9)))
5024   (pass-if (eqv? 4 (sqrt 16)))
5025   (pass-if (eqv? fixnum-max (sqrt (expt fixnum-max 2))))
5026   (pass-if (eqv? (+ 1 fixnum-max) (sqrt (expt (+ 1 fixnum-max) 2))))
5027   (pass-if (eqv? (expt 10 400) (sqrt (expt 10 800))))
5028   (pass-if (eqv? (/ (expt 10 1000)
5029                     (expt 13 1000))
5030                  (sqrt (/ (expt 10 2000)
5031                           (expt 13 2000)))))
5032
5033   (with-test-prefix "exact sqrt"
5034
5035     (define (test root)
5036       (pass-if (list root 'exact)
5037         (eqv? root (sqrt (expt root 2))))
5038       (pass-if (list root '*2)
5039         (let ((r (sqrt (* 2 (expt root 2)))))
5040           (and (inexact? r)
5041                (eqv-loosely? (* (sqrt 2) root) r))))
5042       (pass-if (list root '-1)
5043         (let ((r (sqrt (- (expt root 2) 1))))
5044           (and (inexact? r)
5045                (eqv-loosely? root r))))
5046       (pass-if (list root '+1)
5047         (let ((r (sqrt (+ (expt root 2) 1))))
5048           (and (inexact? r)
5049                (eqv-loosely? root r))))
5050       (pass-if (list root 'negative)
5051         (eqv-loosely? (* +i root) (sqrt (- (expt root 2))))))
5052
5053     (test (exact-integer-sqrt (+ -1 (expt 2 (+  2 dbl-mant-dig)))))
5054     (test (exact-integer-sqrt (+ -1 (expt 2 (+  1 dbl-mant-dig)))))
5055     (test (exact-integer-sqrt (+ -1 (expt 2 (+  0 dbl-mant-dig)))))
5056     (test (exact-integer-sqrt (+ -1 (expt 2 (+ -1 dbl-mant-dig)))))
5057     (test (exact-integer-sqrt (+ -1 (expt 2 (+ -2 dbl-mant-dig)))))
5058
5059     ;; largest finite inexact
5060     (test (* (- (expt 2 dbl-mant-dig) 1)
5061              (expt 2 (- dbl-max-exp dbl-mant-dig)))))
5062
5063   (pass-if-equal "smallest inexact"
5064       (expt 2.0 (- dbl-min-exp dbl-mant-dig))
5065     (sqrt (/ (+ -1 (expt 2 (* 2 (- dbl-mant-dig dbl-min-exp)))))))
5066
5067   (with-test-prefix "extreme ratios"
5068     (define-syntax-rule (test want x)
5069       (pass-if 'x
5070         (let ((got (sqrt x)))
5071           (and (inexact? got)
5072                (test-eqv? 1.0 (/ want got))))))
5073     (test 1.511139943175573e176   (/ (expt 3 2001) (expt 2 2001)))
5074     (test 2.1370746022826034e176  (/ (expt 3 2001) (expt 2 2000)))
5075     (test 8.724570529756128e175   (/ (expt 3 2000) (expt 2 2001)))
5076     (test 6.6175207962444435e-177 (/ (expt 2 2001) (expt 3 2001)))
5077     (test 1.1461882239239027e-176 (/ (expt 2 2001) (expt 3 2000)))
5078     (test 4.679293829667447e-177  (/ (expt 2 2000) (expt 3 2001))))
5079
5080   (pass-if (eqv? (/ (expt 2 1000)
5081                     (expt 3 1000))
5082                  (sqrt (/ (expt 2 2000)
5083                           (expt 3 2000)))))
5084
5085   (pass-if (eqv? (/ (expt 3 1000)
5086                     (expt 2 1000))
5087                  (sqrt (/ (expt 3 2000)
5088                           (expt 2 2000)))))
5089
5090   (pass-if (eqv? +4i (sqrt -16)))
5091   (pass-if (eqv-loosely? +1.0e150i (sqrt #e-1e300)))
5092   (pass-if (eqv-loosely? +0.7071i (sqrt -1/2)))
5093
5094   (pass-if (eqv? 0.0 (sqrt 0.0)))
5095   (pass-if (eqv? 1.0 (sqrt 1.0)))
5096   (pass-if (eqv-loosely? 2.0   (sqrt 4.0)))
5097   (pass-if (eqv-loosely? 31.62 (sqrt 1000.0)))
5098
5099   (pass-if (eqv? +1.0i (sqrt -1.0)))
5100   (pass-if (eqv-loosely? +2.0i   (sqrt -4.0)))
5101   (pass-if (eqv-loosely? +31.62i (sqrt -1000.0)))
5102
5103   (pass-if "+i swings back to 45deg angle"
5104     (eqv-loosely? +0.7071+0.7071i (sqrt +1.0i)))
5105
5106   ;; Note: glibc 2.3 csqrt() had a bug affecting this test case, so if it
5107   ;; fails check whether that's the cause (there's a configure test to
5108   ;; reject it, but when cross-compiling we assume the C library is ok).
5109   (pass-if "-100i swings back to 45deg down"
5110     (eqv-loosely? +7.071-7.071i (sqrt -100.0i))))
5111
5112
5113 ;;;
5114 ;;; Tests for number-theoretic division operators:
5115 ;;;
5116 ;;; euclidean/
5117 ;;; euclidean-quotient
5118 ;;; euclidean-remainder
5119 ;;; floor/
5120 ;;; floor-quotient
5121 ;;; floor-remainder
5122 ;;; ceiling/
5123 ;;; ceiling-quotient
5124 ;;; ceiling-remainder
5125 ;;; truncate/
5126 ;;; truncate-quotient
5127 ;;; truncate-remainder
5128 ;;; centered/
5129 ;;; centered-quotient
5130 ;;; centered-remainder
5131 ;;; round/
5132 ;;; round-quotient
5133 ;;; round-remainder
5134 ;;;
5135
5136 (with-test-prefix "Number-theoretic division"
5137
5138   ;; Tests that (lo <1 x <2 hi),
5139   ;; but allowing for imprecision
5140   ;; if x is inexact.
5141   (define (test-within-range? lo <1 x <2 hi)
5142     (if (exact? x)
5143         (and (<1 lo x) (<2 x hi))
5144         (let ((lo (- lo test-epsilon))
5145               (hi (+ hi test-epsilon)))
5146           (<= lo x hi))))
5147
5148   (define (valid-euclidean-answer? x y q r)
5149     (and (eq? (exact? q)
5150               (exact? r)
5151               (and (exact? x) (exact? y)))
5152          (test-eqv? r (- x (* q y)))
5153          (if (and (finite? x) (finite? y))
5154              (and (integer? q)
5155                   (test-within-range? 0 <= r < (abs y)))
5156              (test-eqv? q (/ x y)))))
5157
5158   (define (valid-floor-answer? x y q r)
5159     (and (eq? (exact? q)
5160               (exact? r)
5161               (and (exact? x) (exact? y)))
5162          (test-eqv? r (- x (* q y)))
5163          (if (and (finite? x) (finite? y))
5164              (and (integer? q)
5165                   (if (> y 0)
5166                       (test-within-range? 0 <= r < y)
5167                       (test-within-range? y < r <= 0)))
5168              (test-eqv? q (/ x y)))))
5169
5170   (define (valid-ceiling-answer? x y q r)
5171     (and (eq? (exact? q)
5172               (exact? r)
5173               (and (exact? x) (exact? y)))
5174          (test-eqv? r (- x (* q y)))
5175          (if (and (finite? x) (finite? y))
5176              (and (integer? q)
5177                   (if (> y 0)
5178                       (test-within-range? (- y) < r <= 0)
5179                       (test-within-range?    0 <= r < (- y))))
5180              (test-eqv? q (/ x y)))))
5181
5182   (define (valid-truncate-answer? x y q r)
5183     (and (eq? (exact? q)
5184               (exact? r)
5185               (and (exact? x) (exact? y)))
5186          (test-eqv? r (- x (* q y)))
5187          (if (and (finite? x) (finite? y))
5188              (and (integer? q)
5189                   (if (> x 0)
5190                       (test-within-range?          0 <= r < (abs y))
5191                       (test-within-range? (- (abs y)) < r <= 0)))
5192              (test-eqv? q (/ x y)))))
5193
5194   (define (valid-centered-answer? x y q r)
5195     (and (eq? (exact? q)
5196               (exact? r)
5197               (and (exact? x) (exact? y)))
5198          (test-eqv? r (- x (* q y)))
5199          (if (and (finite? x) (finite? y))
5200              (and (integer? q)
5201                   (test-within-range?
5202                    (* -1/2 (abs y)) <= r < (* +1/2 (abs y))))
5203              (test-eqv? q (/ x y)))))
5204
5205   (define (valid-round-answer? x y q r)
5206     (and (eq? (exact? q)
5207               (exact? r)
5208               (and (exact? x) (exact? y)))
5209          (test-eqv? r (- x (* q y)))
5210          (if (and (finite? x) (finite? y))
5211              (and (integer? q)
5212                   (let ((ay/2 (/ (abs y) 2)))
5213                     (if (even? q)
5214                         (test-within-range? (- ay/2) <= r <= ay/2)
5215                         (test-within-range? (- ay/2) <  r <  ay/2))))
5216              (test-eqv? q (/ x y)))))
5217
5218   (define (for lsts f) (apply for-each f lsts))
5219
5220   (define big (expt 10 (1+ (inexact->exact (ceiling (log10 fixnum-max))))))
5221
5222   (define (run-division-tests quo+rem quo rem valid-answer?)
5223     (define (test n d)
5224       (run-test (list n d) #t
5225                 (lambda ()
5226                   (let-values (((q r) (quo+rem n d)))
5227                     (and (test-eqv? q (quo n d))
5228                          (test-eqv? r (rem n d))
5229                          (valid-answer? n d q r))))))
5230     (define (test+/- n d)
5231       (test n    d )
5232       (test n (- d))
5233       (cond ((not (zero? n))
5234              (test (- n)    d )
5235              (test (- n) (- d)))))
5236
5237     (define (test-for-exception n d exception)
5238       (let ((name (list n d)))
5239         (pass-if-exception name exception (quo+rem n d))
5240         (pass-if-exception name exception (quo n d))
5241         (pass-if-exception name exception (rem n d))))
5242
5243     (run-test "documented?" #t
5244               (lambda ()
5245                 (and (documented? quo+rem)
5246                      (documented? quo)
5247                      (documented? rem))))
5248
5249     (with-test-prefix "inum / inum"
5250       (with-test-prefix "fixnum-min / -1"
5251         (test fixnum-min -1))
5252       (for '((1 2 5 10))  ;; denominators
5253            (lambda (d)
5254              (for '((0 1 2 5 10))  ;; multiples
5255                   (lambda (m)
5256                     (for '((-2 -1 0 1 2 3 4 5 7 10
5257                                12 15 16 19 20))  ;; offsets
5258                          (lambda (b)
5259                            (test+/- (+ b (* m d))
5260                                     d))))))))
5261
5262     (with-test-prefix "inum / big"
5263       (with-test-prefix "fixnum-min / -fixnum-min"
5264         (test fixnum-min (- fixnum-min)))
5265       (with-test-prefix "fixnum-max / (2*fixnum-max)"
5266         (test+/- fixnum-max (* 2 fixnum-max)))
5267       (for `((0 1 2 10 ,(1- fixnum-max) ,fixnum-max))
5268            (lambda (n)
5269              (test    n  (1+ fixnum-max))
5270              (test (- n) (1+ fixnum-max))
5271              (test    n  (1- fixnum-min))
5272              (test (- n) (1- fixnum-min)))))
5273
5274     (with-test-prefix "big / inum"
5275       (with-test-prefix "-fixnum-min / fixnum-min"
5276         (test (- fixnum-min) fixnum-min))
5277       (for '((1 4 5 10))  ;; denominators
5278            (lambda (d)
5279              (for `((1 2 5 ,@(if (even? d)
5280                                  '(1/2 3/2 5/2)
5281                                  '())))  ;; multiples
5282                   (lambda (m)
5283                     (for '((-2 -1 0 1 2))  ;; offsets
5284                          (lambda (b)
5285                            (test+/- (+ b (* m d big))
5286                                     d))))))))
5287
5288     (with-test-prefix "big / big"
5289       (for `((,big ,(1+ big)))  ;; denominators
5290            (lambda (d)
5291              (for `((1 2 5 ,@(if (even? d)
5292                                  '(1/2 3/2 5/2)
5293                                  '())))  ;; multiples
5294                   (lambda (m)
5295                     (for '((-2 -1 0 1 2))  ;; offsets
5296                          (lambda (b)
5297                            (test+/- (+ b (* m d))
5298                                     d))))))))
5299
5300     (with-test-prefix "inexact"
5301       (for '((0.5 1.5 2.25 5.75))  ;; denominators
5302            (lambda (d)
5303              (for '((0 1 2 5 1/2 3/2 5/2))  ;; multiples
5304                   (lambda (m)
5305                     (for '((-2 -1 0 1 2))  ;; offsets
5306                          (lambda (b)
5307                            (test+/- (+ b (* m d))
5308                                     d))))))))
5309
5310     (with-test-prefix "fractions"
5311       (for '((1/10 16/3 10/7))  ;; denominators
5312            (lambda (d)
5313              (for '((0 1 2 5 1/2 3/2 5/2))  ;; multiples
5314                   (lambda (m)
5315                     (for '((-2/9 -1/11 0 1/3 2/3))  ;; offsets
5316                          (lambda (b)
5317                            (test+/- (+ b (* m d))
5318                                     d))))))))
5319
5320     (with-test-prefix "mixed types"
5321       (for `((10 ,big 12.0 10/7 +inf.0 -inf.0 +nan.0))  ;; denominators
5322            (lambda (d)
5323              (for `((25 ,(* 3/2 big) 130.0 15/7
5324                         0 0.0 -0.0 +inf.0 -inf.0 +nan.0))  ;; numerators
5325                   (lambda (n)
5326                     (test+/- n d))))))
5327
5328     (with-test-prefix "divide by zero"
5329       (for `((0 0.0 -0.0))  ;; denominators
5330            (lambda (d)
5331              (for `((15 ,(* 3/2 big) 18.0 33/7
5332                         0 0.0 -0.0 +inf.0 -inf.0 +nan.0))  ;; numerators
5333                   (lambda (n)
5334                     (test-for-exception
5335                      n d exception:numerical-overflow)))))))
5336
5337   (with-test-prefix "euclidean/"
5338     (run-division-tests euclidean/
5339                         euclidean-quotient
5340                         euclidean-remainder
5341                         valid-euclidean-answer?))
5342
5343   (with-test-prefix "floor/"
5344     (run-division-tests floor/
5345                         floor-quotient
5346                         floor-remainder
5347                         valid-floor-answer?))
5348
5349   (with-test-prefix "ceiling/"
5350     (run-division-tests ceiling/
5351                         ceiling-quotient
5352                         ceiling-remainder
5353                         valid-ceiling-answer?))
5354
5355   (with-test-prefix "truncate/"
5356     (run-division-tests truncate/
5357                         truncate-quotient
5358                         truncate-remainder
5359                         valid-truncate-answer?))
5360
5361   (with-test-prefix "centered/"
5362     (run-division-tests centered/
5363                         centered-quotient
5364                         centered-remainder
5365                         valid-centered-answer?))
5366
5367   (with-test-prefix "round/"
5368     (run-division-tests round/
5369                         round-quotient
5370                         round-remainder
5371                         valid-round-answer?)))
5372
5373 ;;;
5374 ;;; ash
5375 ;;; round-ash
5376 ;;;
5377
5378 (let ()
5379   (define (test-ash-variant name ash-variant round-variant)
5380     (with-test-prefix name
5381       (define (test n count)
5382         (pass-if (list n count)
5383           (eqv? (ash-variant n count)
5384                 (round-variant (* n (expt 2 count))))))
5385
5386       (pass-if "documented?"
5387         (documented? ash-variant))
5388
5389       (for-each (lambda (n)
5390                   (for-each (lambda (count) (test n count))
5391                             `(-1000
5392                               ,(- fixnum-bit)
5393                               ,(- (- fixnum-bit 1))
5394                               -3 -2 -1 0 1 2 3
5395                               ,(- fixnum-bit 1)
5396                               ,fixnum-bit
5397                               1000)))
5398                 (list 0 1 3 23 -1 -3 -23
5399                       fixnum-max
5400                       (1+ fixnum-max)
5401                       (1- fixnum-max)
5402                       (* fixnum-max 4)
5403                       (quotient fixnum-max 4)
5404                       fixnum-min
5405                       (1+ fixnum-min)
5406                       (1- fixnum-min)
5407                       (* fixnum-min 4)
5408                       (quotient fixnum-min 4)))
5409
5410       (do ((count -2 (1- count))
5411            (vals '(1 3 5 7 9 11)
5412                  (map (lambda (n) (* 2 n)) vals)))
5413           ((> (car vals) (* 2 fixnum-max)) 'done)
5414         (for-each (lambda (n)
5415                     (test    n  count)
5416                     (test (- n) count))
5417                   vals))
5418
5419       ;; Test rounding
5420       (for-each (lambda (base)
5421                   (for-each (lambda (offset) (test (+ base offset) -3))
5422                             '(#b11001 #b11100 #b11101 #b10001 #b10100 #b10101)))
5423                 (list 0 64 -64 (* 64 fixnum-max) (* 64 fixnum-min)))))
5424
5425   (test-ash-variant       'ash       ash floor)
5426   (test-ash-variant 'round-ash round-ash round))