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 ;;; inexact?
1812 ;;;
1813
1814 (with-test-prefix "inexact?"
1815   (pass-if (documented? inexact?))
1816   (pass-if (not (inexact? 0)))
1817   (pass-if (not (inexact? 7)))
1818   (pass-if (not (inexact? -7)))
1819   (pass-if (not (inexact? (+ 1 fixnum-max))))
1820   (pass-if (not (inexact? (- 1 fixnum-min))))
1821   (pass-if (inexact? 1.3))
1822   (pass-if (inexact? 3.1+4.2i))
1823   (pass-if (inexact? +inf.0))
1824   (pass-if (inexact? -inf.0))
1825   (pass-if (inexact? +nan.0))
1826   (pass-if-exception "char"
1827                      exception:wrong-type-arg
1828                      (not (inexact? #\a)))
1829   (pass-if-exception "string"
1830                      exception:wrong-type-arg
1831                      (not (inexact? "a")))
1832   (pass-if-exception "vector"
1833                      exception:wrong-type-arg
1834                      (not (inexact? (make-vector 0))))
1835   (pass-if-exception "cons"
1836                      exception:wrong-type-arg
1837                      (not (inexact? (cons 1 2))))
1838   (pass-if-exception "bool"
1839                      exception:wrong-type-arg
1840                      (not (inexact? #t)))
1841   (pass-if-exception "procedure"
1842                      exception:wrong-type-arg
1843                      (not (inexact? (lambda () #t))))
1844   (pass-if-exception "port"
1845                      exception:wrong-type-arg
1846                      (not (inexact? (current-input-port)))))
1847
1848 ;;;
1849 ;;; equal?
1850 ;;;
1851
1852 (with-test-prefix "equal?"
1853   (pass-if (documented? equal?))
1854
1855   ;; The following test will fail on platforms
1856   ;; without distinct signed zeroes 0.0 and -0.0.
1857   (pass-if (not (equal? 0.0 -0.0)))
1858
1859   (pass-if (equal? 0 0))
1860   (pass-if (equal? 7 7))
1861   (pass-if (equal? -7 -7))
1862   (pass-if (equal? (+ 1 fixnum-max) (+ 1 fixnum-max)))
1863   (pass-if (equal? (- fixnum-min 1) (- fixnum-min 1)))
1864   (pass-if (equal?  0.0  0.0))
1865   (pass-if (equal? -0.0 -0.0))
1866   (pass-if (equal?  0.0+0.0i  0.0+0.0i))
1867   (pass-if (equal?  0.0-0.0i  0.0-0.0i))
1868   (pass-if (equal? -0.0+0.0i -0.0+0.0i))
1869   (pass-if (not (equal? 0 1)))
1870   (pass-if (not (equal? 0 0.0)))
1871   (pass-if (not (equal? 1 1.0)))
1872   (pass-if (not (equal? 0.0 0)))
1873   (pass-if (not (equal? 1.0 1)))
1874   (pass-if (not (equal? -1.0 -1)))
1875   (pass-if (not (equal? 1.0 1.0+0.0i)))
1876   (pass-if (not (equal? 0.0 0.0+0.0i)))
1877   (pass-if (not (equal? 0.0+0.0i  0.0-0.0i)))
1878   (pass-if (not (equal? 0.0+0.0i -0.0+0.0i)))
1879   (pass-if (not (equal? fixnum-max (+ 1 fixnum-max))))
1880   (pass-if (not (equal? (+ 1 fixnum-max) fixnum-max)))
1881   (pass-if (not (equal? (+ 1 fixnum-max) (+ 2 fixnum-max))))
1882   (pass-if (not (equal? fixnum-min (- fixnum-min 1))))
1883   (pass-if (not (equal? (- fixnum-min 1) fixnum-min)))
1884   (pass-if (not (equal? (- fixnum-min 1) (- fixnum-min 2))))
1885   (pass-if (not (equal? (+ fixnum-max 1) (- fixnum-min 1))))
1886
1887   (pass-if (not (equal? (ash 1 256) +inf.0)))
1888   (pass-if (not (equal? +inf.0 (ash 1 256))))
1889   (pass-if (not (equal? (ash 1 256) -inf.0)))
1890   (pass-if (not (equal? -inf.0 (ash 1 256))))
1891
1892   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
1893   ;; sure we've avoided that
1894   (pass-if (not (equal? (ash 1 1024) +inf.0)))
1895   (pass-if (not (equal? +inf.0 (ash 1 1024))))
1896   (pass-if (not (equal? (- (ash 1 1024)) -inf.0)))
1897   (pass-if (not (equal? -inf.0 (- (ash 1 1024)))))
1898
1899   (pass-if (equal? +nan.0 +nan.0))
1900   (pass-if (equal? +nan.0 +nan.0))
1901   (pass-if (not (equal? +nan.0 0.0+nan.0i)))
1902
1903   (pass-if (not (equal? 0 +nan.0)))
1904   (pass-if (not (equal? +nan.0 0)))
1905   (pass-if (not (equal? 1 +nan.0)))
1906   (pass-if (not (equal? +nan.0 1)))
1907   (pass-if (not (equal? -1 +nan.0)))
1908   (pass-if (not (equal? +nan.0 -1)))
1909
1910   (pass-if (not (equal? (ash 1 256) +nan.0)))
1911   (pass-if (not (equal? +nan.0 (ash 1 256))))
1912   (pass-if (not (equal? (- (ash 1 256)) +nan.0)))
1913   (pass-if (not (equal? +nan.0 (- (ash 1 256)))))
1914
1915   (pass-if (not (equal? (ash 1 8192) +nan.0)))
1916   (pass-if (not (equal? +nan.0 (ash 1 8192))))
1917   (pass-if (not (equal? (- (ash 1 8192)) +nan.0)))
1918   (pass-if (not (equal? +nan.0 (- (ash 1 8192)))))
1919
1920   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
1921   ;; sure we've avoided that
1922   (pass-if (not (equal? (ash 3 1023) +nan.0)))
1923   (pass-if (not (equal? +nan.0 (ash 3 1023)))))
1924
1925 ;;;
1926 ;;; eqv?
1927 ;;;
1928
1929 (with-test-prefix "eqv?"
1930   (pass-if (documented? eqv?))
1931
1932   ;; The following test will fail on platforms
1933   ;; without distinct signed zeroes 0.0 and -0.0.
1934   (pass-if (not (eqv? 0.0 -0.0)))
1935
1936   (pass-if (eqv? 0 0))
1937   (pass-if (eqv? 7 7))
1938   (pass-if (eqv? -7 -7))
1939   (pass-if (eqv? (+ 1 fixnum-max) (+ 1 fixnum-max)))
1940   (pass-if (eqv? (- fixnum-min 1) (- fixnum-min 1)))
1941   (pass-if (eqv?  0.0  0.0))
1942   (pass-if (eqv? -0.0 -0.0))
1943   (pass-if (eqv?  0.0+0.0i  0.0+0.0i))
1944   (pass-if (eqv?  0.0-0.0i  0.0-0.0i))
1945   (pass-if (eqv? -0.0+0.0i -0.0+0.0i))
1946   (pass-if (not (eqv? 0.0 -0.0)))
1947   (pass-if (not (eqv? 0.0  0.0+0.0i)))
1948   (pass-if (not (eqv? 0.0+0.0i  0.0-0.0i)))
1949   (pass-if (not (eqv? 0.0+0.0i -0.0+0.0i)))
1950   (pass-if (not (eqv? 0 1)))
1951   (pass-if (not (eqv? 0 0.0)))
1952   (pass-if (not (eqv? 1 1.0)))
1953   (pass-if (not (eqv? 0.0 0)))
1954   (pass-if (not (eqv? 1.0 1)))
1955   (pass-if (not (eqv? -1.0 -1)))
1956   (pass-if (not (eqv? 1.0 1.0+0.0i)))
1957   (pass-if (not (eqv? 0.0 0.0+0.0i)))
1958   (pass-if (not (eqv? fixnum-max (+ 1 fixnum-max))))
1959   (pass-if (not (eqv? (+ 1 fixnum-max) fixnum-max)))
1960   (pass-if (not (eqv? (+ 1 fixnum-max) (+ 2 fixnum-max))))
1961   (pass-if (not (eqv? fixnum-min (- fixnum-min 1))))
1962   (pass-if (not (eqv? (- fixnum-min 1) fixnum-min)))
1963   (pass-if (not (eqv? (- fixnum-min 1) (- fixnum-min 2))))
1964   (pass-if (not (eqv? (+ fixnum-max 1) (- fixnum-min 1))))
1965
1966   (pass-if (not (eqv? (ash 1 256) +inf.0)))
1967   (pass-if (not (eqv? +inf.0 (ash 1 256))))
1968   (pass-if (not (eqv? (ash 1 256) -inf.0)))
1969   (pass-if (not (eqv? -inf.0 (ash 1 256))))
1970
1971   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
1972   ;; sure we've avoided that
1973   (pass-if (not (eqv? (ash 1 1024) +inf.0)))
1974   (pass-if (not (eqv? +inf.0 (ash 1 1024))))
1975   (pass-if (not (eqv? (- (ash 1 1024)) -inf.0)))
1976   (pass-if (not (eqv? -inf.0 (- (ash 1 1024)))))
1977
1978   (pass-if (eqv? +nan.0 +nan.0))
1979   (pass-if (not (eqv? +nan.0 0.0+nan.0i)))
1980
1981   (pass-if (not (eqv? 0 +nan.0)))
1982   (pass-if (not (eqv? +nan.0 0)))
1983   (pass-if (not (eqv? 1 +nan.0)))
1984   (pass-if (not (eqv? +nan.0 1)))
1985   (pass-if (not (eqv? -1 +nan.0)))
1986   (pass-if (not (eqv? +nan.0 -1)))
1987
1988   (pass-if (not (eqv? (ash 1 256) +nan.0)))
1989   (pass-if (not (eqv? +nan.0 (ash 1 256))))
1990   (pass-if (not (eqv? (- (ash 1 256)) +nan.0)))
1991   (pass-if (not (eqv? +nan.0 (- (ash 1 256)))))
1992
1993   (pass-if (not (eqv? (ash 1 8192) +nan.0)))
1994   (pass-if (not (eqv? +nan.0 (ash 1 8192))))
1995   (pass-if (not (eqv? (- (ash 1 8192)) +nan.0)))
1996   (pass-if (not (eqv? +nan.0 (- (ash 1 8192)))))
1997
1998   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
1999   ;; sure we've avoided that
2000   (pass-if (not (eqv? (ash 3 1023) +nan.0)))
2001   (pass-if (not (eqv? +nan.0 (ash 3 1023)))))
2002
2003 ;;;
2004 ;;; =
2005 ;;;
2006
2007 (with-test-prefix "="
2008   (pass-if (documented? =))
2009   (pass-if (= 7 7))
2010   (pass-if (= -7 -7))
2011   (pass-if (= 1.0 1))
2012   (pass-if (= 1 1.0))
2013   (pass-if (= -1 -1.0))
2014   (pass-if (= 0.0  0.0))
2015   (pass-if (= 0.0 -0.0))
2016   (pass-if (= 1 1.0+0.0i))
2017
2018   (pass-if (= 0  0))
2019   (pass-if (= 0  0.0))
2020   (pass-if (= 0 -0.0))
2021   (pass-if (= 0  0.0+0.0i))
2022   (pass-if (= 0  0.0-0.0i))
2023   (pass-if (= 0  0.0+0.0i))
2024   (pass-if (= 0 -0.0-0.0i))
2025
2026   (pass-if (=  0        0))
2027   (pass-if (=  0.0      0))
2028   (pass-if (= -0.0      0))
2029   (pass-if (=  0.0+0.0i 0))
2030   (pass-if (=  0.0-0.0i 0))
2031   (pass-if (=  0.0+0.0i 0))
2032   (pass-if (= -0.0-0.0i 0))
2033
2034   (pass-if (= 0.0+0.0i  0.0-0.0i))
2035   (pass-if (= 0.0+0.0i -0.0+0.0i))
2036
2037   (pass-if (= (+ 1 fixnum-max) (+ 1 fixnum-max)))
2038   (pass-if (= (- fixnum-min 1) (- fixnum-min 1)))
2039   (pass-if (not (= 0 1)))
2040   (pass-if (not (= fixnum-max (+ 1 fixnum-max))))
2041   (pass-if (not (= (+ 1 fixnum-max) fixnum-max)))
2042   (pass-if (not (= (+ 1 fixnum-max) (+ 2 fixnum-max))))
2043   (pass-if (not (= fixnum-min (- fixnum-min 1))))
2044   (pass-if (not (= (- fixnum-min 1) fixnum-min)))
2045   (pass-if (not (= (- fixnum-min 1) (- fixnum-min 2))))
2046   (pass-if (not (= (+ fixnum-max 1) (- fixnum-min 1))))
2047
2048   (pass-if (not (= (ash 1 256) +inf.0)))
2049   (pass-if (not (= +inf.0 (ash 1 256))))
2050   (pass-if (not (= (ash 1 256) -inf.0)))
2051   (pass-if (not (= -inf.0 (ash 1 256))))
2052
2053   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
2054   ;; sure we've avoided that
2055   (pass-if (not (= (ash 1 1024) +inf.0)))
2056   (pass-if (not (= +inf.0 (ash 1 1024))))
2057   (pass-if (not (= (- (ash 1 1024)) -inf.0)))
2058   (pass-if (not (= -inf.0 (- (ash 1 1024)))))
2059
2060   (pass-if (not (= +nan.0 +nan.0)))
2061   (pass-if (not (= 0 +nan.0)))
2062   (pass-if (not (= +nan.0 0)))
2063   (pass-if (not (= 1 +nan.0)))
2064   (pass-if (not (= +nan.0 1)))
2065   (pass-if (not (= -1 +nan.0)))
2066   (pass-if (not (= +nan.0 -1)))
2067
2068   (pass-if (not (= (ash 1 256) +nan.0)))
2069   (pass-if (not (= +nan.0 (ash 1 256))))
2070   (pass-if (not (= (- (ash 1 256)) +nan.0)))
2071   (pass-if (not (= +nan.0 (- (ash 1 256)))))
2072
2073   (pass-if (not (= (ash 1 8192) +nan.0)))
2074   (pass-if (not (= +nan.0 (ash 1 8192))))
2075   (pass-if (not (= (- (ash 1 8192)) +nan.0)))
2076   (pass-if (not (= +nan.0 (- (ash 1 8192)))))
2077
2078   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
2079   ;; sure we've avoided that
2080   (pass-if (not (= (ash 3 1023) +nan.0)))
2081   (pass-if (not (= +nan.0 (ash 3 1023))))
2082
2083   (pass-if (= 1/2 0.5))
2084   (pass-if (not (= 1/3 0.333333333333333333333333333333333)))
2085   (pass-if (not (= 2/3 0.5)))
2086   (pass-if (not (= 0.5 (+ 1/2 (/ 1 (ash 1 1000))))))
2087
2088   (pass-if (= 1/2 0.5+0i))
2089   (pass-if (not (= 0.333333333333333333333333333333333 1/3)))
2090   (pass-if (not (= 2/3 0.5+0i)))
2091   (pass-if (not (= 1/2 0+0.5i)))
2092
2093   (pass-if (= 0.5 1/2))
2094   (pass-if (not (= 0.5 2/3)))
2095   (pass-if (not (= (+ 1/2 (/ 1 (ash 1 1000))) 0.5)))
2096
2097   (pass-if (= 0.5+0i 1/2))
2098   (pass-if (not (= 0.5+0i 2/3)))
2099   (pass-if (not (= 0+0.5i 1/2)))
2100
2101   ;; prior to guile 1.8, inum/flonum comparisons were done just by
2102   ;; converting the inum to a double, which on a 64-bit would round making
2103   ;; say inexact 2^58 appear equal to exact 2^58+1
2104   (pass-if (= (ash-flo 1.0 58) (ash 1 58)))
2105   (pass-if (not (= (ash-flo 1.0 58) (1+ (ash 1 58)))))
2106   (pass-if (not (= (ash-flo 1.0 58) (1- (ash 1 58)))))
2107   (pass-if (= (ash 1 58) (ash-flo 1.0 58)))
2108   (pass-if (not (= (1+ (ash 1 58)) (ash-flo 1.0 58))))
2109   (pass-if (not (= (1- (ash 1 58)) (ash-flo 1.0 58))))
2110
2111   ;; prior to guile 2.0.10, inum/complex comparisons were done just by
2112   ;; converting the inum to a double, which on a 64-bit would round making
2113   ;; say inexact 2^58 appear equal to exact 2^58+1
2114   (pass-if (= (+ +0.0i (ash-flo 1.0 58)) (ash 1 58)))
2115   (pass-if (not (= (+ +0.0i (ash-flo 1.0 58)) (1+ (ash 1 58)))))
2116   (pass-if (not (= (+ +0.0i (ash-flo 1.0 58)) (1- (ash 1 58)))))
2117   (pass-if (= (ash 1 58) (+ +0.0i (ash-flo 1.0 58))))
2118   (pass-if (not (= (1+ (ash 1 58)) (+ +0.0i (ash-flo 1.0 58)))))
2119   (pass-if (not (= (1- (ash 1 58)) (+ +0.0i (ash-flo 1.0 58)))))
2120
2121   ;; prior to guile 2.0.10, fraction/flonum and fraction/complex
2122   ;; comparisons mishandled infinities.
2123   (pass-if (not (= 1/2 +inf.0)))
2124   (pass-if (not (= 1/2 -inf.0)))
2125   (pass-if (not (= +inf.0 1/2)))
2126   (pass-if (not (= -inf.0 1/2)))
2127   (pass-if (not (= 1/2 +inf.0+0.0i)))
2128   (pass-if (not (= 1/2 -inf.0+0.0i)))
2129   (pass-if (not (= +inf.0+0.0i 1/2)))
2130   (pass-if (not (= -inf.0+0.0i 1/2))))
2131
2132 ;;;
2133 ;;; <
2134 ;;;
2135
2136 (with-test-prefix "<"
2137
2138   (pass-if "documented?"
2139     (documented? <))
2140
2141   (with-test-prefix "(< 0 n)"
2142
2143     (pass-if "n = 0"
2144       (not (< 0 0)))
2145
2146     (pass-if "n = 0.0"
2147       (not (< 0 0.0)))
2148
2149     (pass-if "n = 1"
2150       (< 0 1))
2151
2152     (pass-if "n = 1.0"
2153       (< 0 1.0))
2154
2155     (pass-if "n = -1"
2156       (not (< 0 -1)))
2157
2158     (pass-if "n = -1.0"
2159       (not (< 0 -1.0)))
2160
2161     (pass-if "n = fixnum-max"
2162       (< 0 fixnum-max))
2163
2164     (pass-if "n = fixnum-max + 1"
2165       (< 0 (+ fixnum-max 1)))
2166
2167     (pass-if "n = fixnum-min"
2168       (not (< 0 fixnum-min)))
2169
2170     (pass-if "n = fixnum-min - 1"
2171       (not (< 0 (- fixnum-min 1)))))
2172
2173   (with-test-prefix "(< 0.0 n)"
2174
2175     (pass-if "n = 0"
2176       (not (< 0.0 0)))
2177
2178     (pass-if "n = 0.0"
2179       (not (< 0.0 0.0)))
2180
2181     (pass-if "n = -0.0"
2182       (not (< 0.0 -0.0)))
2183
2184     (pass-if "n = 1"
2185       (< 0.0 1))
2186
2187     (pass-if "n = 1.0"
2188       (< 0.0 1.0))
2189
2190     (pass-if "n = -1"
2191       (not (< 0.0 -1)))
2192
2193     (pass-if "n = -1.0"
2194       (not (< 0.0 -1.0)))
2195
2196     (pass-if "n = fixnum-max"
2197       (< 0.0 fixnum-max))
2198
2199     (pass-if "n = fixnum-max + 1"
2200       (< 0.0 (+ fixnum-max 1)))
2201
2202     (pass-if "n = fixnum-min"
2203       (not (< 0.0 fixnum-min)))
2204
2205     (pass-if "n = fixnum-min - 1"
2206       (not (< 0.0 (- fixnum-min 1)))))
2207
2208   (pass-if (not (< -0.0 0.0)))
2209   (pass-if (not (< -0.0 -0.0)))
2210
2211   (with-test-prefix "(< 1 n)"
2212
2213     (pass-if "n = 0"
2214       (not (< 1 0)))
2215
2216     (pass-if "n = 0.0"
2217       (not (< 1 0.0)))
2218
2219     (pass-if "n = 1"
2220       (not (< 1 1)))
2221
2222     (pass-if "n = 1.0"
2223       (not (< 1 1.0)))
2224
2225     (pass-if "n = -1"
2226       (not (< 1 -1)))
2227
2228     (pass-if "n = -1.0"
2229       (not (< 1 -1.0)))
2230
2231     (pass-if "n = fixnum-max"
2232       (< 1 fixnum-max))
2233
2234     (pass-if "n = fixnum-max + 1"
2235       (< 1 (+ fixnum-max 1)))
2236
2237     (pass-if "n = fixnum-min"
2238       (not (< 1 fixnum-min)))
2239
2240     (pass-if "n = fixnum-min - 1"
2241       (not (< 1 (- fixnum-min 1)))))
2242
2243   (with-test-prefix "(< 1.0 n)"
2244
2245     (pass-if "n = 0"
2246       (not (< 1.0 0)))
2247
2248     (pass-if "n = 0.0"
2249       (not (< 1.0 0.0)))
2250
2251     (pass-if "n = 1"
2252       (not (< 1.0 1)))
2253
2254     (pass-if "n = 1.0"
2255       (not (< 1.0 1.0)))
2256
2257     (pass-if "n = -1"
2258       (not (< 1.0 -1)))
2259
2260     (pass-if "n = -1.0"
2261       (not (< 1.0 -1.0)))
2262
2263     (pass-if "n = fixnum-max"
2264       (< 1.0 fixnum-max))
2265
2266     (pass-if "n = fixnum-max + 1"
2267       (< 1.0 (+ fixnum-max 1)))
2268
2269     (pass-if "n = fixnum-min"
2270       (not (< 1.0 fixnum-min)))
2271
2272     (pass-if "n = fixnum-min - 1"
2273       (not (< 1.0 (- fixnum-min 1)))))
2274
2275   (with-test-prefix "(< -1 n)"
2276
2277     (pass-if "n = 0"
2278       (< -1 0))
2279
2280     (pass-if "n = 0.0"
2281       (< -1 0.0))
2282
2283     (pass-if "n = 1"
2284       (< -1 1))
2285
2286     (pass-if "n = 1.0"
2287       (< -1 1.0))
2288
2289     (pass-if "n = -1"
2290       (not (< -1 -1)))
2291
2292     (pass-if "n = -1.0"
2293       (not (< -1 -1.0)))
2294
2295     (pass-if "n = fixnum-max"
2296       (< -1 fixnum-max))
2297
2298     (pass-if "n = fixnum-max + 1"
2299       (< -1 (+ fixnum-max 1)))
2300
2301     (pass-if "n = fixnum-min"
2302       (not (< -1 fixnum-min)))
2303
2304     (pass-if "n = fixnum-min - 1"
2305       (not (< -1 (- fixnum-min 1)))))
2306
2307   (with-test-prefix "(< -1.0 n)"
2308
2309     (pass-if "n = 0"
2310       (< -1.0 0))
2311
2312     (pass-if "n = 0.0"
2313       (< -1.0 0.0))
2314
2315     (pass-if "n = 1"
2316       (< -1.0 1))
2317
2318     (pass-if "n = 1.0"
2319       (< -1.0 1.0))
2320
2321     (pass-if "n = -1"
2322       (not (< -1.0 -1)))
2323
2324     (pass-if "n = -1.0"
2325       (not (< -1.0 -1.0)))
2326
2327     (pass-if "n = fixnum-max"
2328       (< -1.0 fixnum-max))
2329
2330     (pass-if "n = fixnum-max + 1"
2331       (< -1.0 (+ fixnum-max 1)))
2332
2333     (pass-if "n = fixnum-min"
2334       (not (< -1.0 fixnum-min)))
2335
2336     (pass-if "n = fixnum-min - 1"
2337       (not (< -1.0 (- fixnum-min 1)))))
2338
2339   (with-test-prefix "(< fixnum-max n)"
2340
2341     (pass-if "n = 0"
2342       (not (< fixnum-max 0)))
2343
2344     (pass-if "n = 0.0"
2345       (not (< fixnum-max 0.0)))
2346
2347     (pass-if "n = 1"
2348       (not (< fixnum-max 1)))
2349
2350     (pass-if "n = 1.0"
2351       (not (< fixnum-max 1.0)))
2352
2353     (pass-if "n = -1"
2354       (not (< fixnum-max -1)))
2355
2356     (pass-if "n = -1.0"
2357       (not (< fixnum-max -1.0)))
2358
2359     (pass-if "n = fixnum-max"
2360       (not (< fixnum-max fixnum-max)))
2361
2362     (pass-if "n = fixnum-max + 1"
2363       (< fixnum-max (+ fixnum-max 1)))
2364
2365     (pass-if "n = fixnum-min"
2366       (not (< fixnum-max fixnum-min)))
2367
2368     (pass-if "n = fixnum-min - 1"
2369       (not (< fixnum-max (- fixnum-min 1)))))
2370
2371   (with-test-prefix "(< (+ fixnum-max 1) n)"
2372
2373     (pass-if "n = 0"
2374       (not (< (+ fixnum-max 1) 0)))
2375
2376     (pass-if "n = 0.0"
2377       (not (< (+ fixnum-max 1) 0.0)))
2378
2379     (pass-if "n = 1"
2380       (not (< (+ fixnum-max 1) 1)))
2381
2382     (pass-if "n = 1.0"
2383       (not (< (+ fixnum-max 1) 1.0)))
2384
2385     (pass-if "n = -1"
2386       (not (< (+ fixnum-max 1) -1)))
2387
2388     (pass-if "n = -1.0"
2389       (not (< (+ fixnum-max 1) -1.0)))
2390
2391     (pass-if "n = fixnum-max"
2392       (not (< (+ fixnum-max 1) fixnum-max)))
2393
2394     (pass-if "n = fixnum-max + 1"
2395       (not (< (+ fixnum-max 1) (+ fixnum-max 1))))
2396
2397     (pass-if "n = fixnum-min"
2398       (not (< (+ fixnum-max 1) fixnum-min)))
2399
2400     (pass-if "n = fixnum-min - 1"
2401       (not (< (+ fixnum-max 1) (- fixnum-min 1)))))
2402
2403   (with-test-prefix "(< fixnum-min n)"
2404
2405     (pass-if "n = 0"
2406       (< fixnum-min 0))
2407
2408     (pass-if "n = 0.0"
2409       (< fixnum-min 0.0))
2410
2411     (pass-if "n = 1"
2412       (< fixnum-min 1))
2413
2414     (pass-if "n = 1.0"
2415       (< fixnum-min 1.0))
2416
2417     (pass-if "n = -1"
2418       (< fixnum-min -1))
2419
2420     (pass-if "n = -1.0"
2421       (< fixnum-min -1.0))
2422
2423     (pass-if "n = fixnum-max"
2424       (< fixnum-min fixnum-max))
2425
2426     (pass-if "n = fixnum-max + 1"
2427       (< fixnum-min (+ fixnum-max 1)))
2428
2429     (pass-if "n = fixnum-min"
2430       (not (< fixnum-min fixnum-min)))
2431
2432     (pass-if "n = fixnum-min - 1"
2433       (not (< fixnum-min (- fixnum-min 1)))))
2434
2435   (with-test-prefix "(< (- fixnum-min 1) n)"
2436
2437     (pass-if "n = 0"
2438       (< (- fixnum-min 1) 0))
2439
2440     (pass-if "n = 0.0"
2441       (< (- fixnum-min 1) 0.0))
2442
2443     (pass-if "n = 1"
2444       (< (- fixnum-min 1) 1))
2445
2446     (pass-if "n = 1.0"
2447       (< (- fixnum-min 1) 1.0))
2448
2449     (pass-if "n = -1"
2450       (< (- fixnum-min 1) -1))
2451
2452     (pass-if "n = -1.0"
2453       (< (- fixnum-min 1) -1.0))
2454
2455     (pass-if "n = fixnum-max"
2456       (< (- fixnum-min 1) fixnum-max))
2457
2458     (pass-if "n = fixnum-max + 1"
2459       (< (- fixnum-min 1) (+ fixnum-max 1)))
2460
2461     (pass-if "n = fixnum-min"
2462       (< (- fixnum-min 1) fixnum-min))
2463
2464     (pass-if "n = fixnum-min - 1"
2465       (not (< (- fixnum-min 1) (- fixnum-min 1)))))
2466
2467   (pass-if (< (ash 1 256) +inf.0))
2468   (pass-if (not (< +inf.0 (ash 1 256))))
2469   (pass-if (not (< (ash 1 256) -inf.0)))
2470   (pass-if (< -inf.0 (ash 1 256)))
2471
2472   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
2473   ;; sure we've avoided that
2474   (pass-if (< (1- (ash 1 1024)) +inf.0))
2475   (pass-if (<     (ash 1 1024)  +inf.0))
2476   (pass-if (< (1+ (ash 1 1024)) +inf.0))
2477   (pass-if (not (< +inf.0 (1- (ash 1 1024)))))
2478   (pass-if (not (< +inf.0     (ash 1 1024))))
2479   (pass-if (not (< +inf.0 (1+ (ash 1 1024)))))
2480   (pass-if (< -inf.0 (- (1- (ash 1 1024)))))
2481   (pass-if (< -inf.0 (-     (ash 1 1024))))
2482   (pass-if (< -inf.0 (- (1+ (ash 1 1024)))))
2483   (pass-if (not (< (- (1- (ash 1 1024))) -inf.0)))
2484   (pass-if (not (< (-     (ash 1 1024))  -inf.0)))
2485   (pass-if (not (< (- (1+ (ash 1 1024))) -inf.0)))
2486
2487   (pass-if (not (< +nan.0 +nan.0)))
2488   (pass-if (not (< 0 +nan.0)))
2489   (pass-if (not (< +nan.0 0)))
2490   (pass-if (not (< 1 +nan.0)))
2491   (pass-if (not (< +nan.0 1)))
2492   (pass-if (not (< -1 +nan.0)))
2493   (pass-if (not (< +nan.0 -1)))
2494
2495   (pass-if (not (< (ash 1 256) +nan.0)))
2496   (pass-if (not (< +nan.0 (ash 1 256))))
2497   (pass-if (not (< (- (ash 1 256)) +nan.0)))
2498   (pass-if (not (< +nan.0 (- (ash 1 256)))))
2499
2500   (pass-if (not (< (ash 1 8192) +nan.0)))
2501   (pass-if (not (< +nan.0 (ash 1 8192))))
2502   (pass-if (not (< (- (ash 1 8192)) +nan.0)))
2503   (pass-if (not (< +nan.0 (- (ash 1 8192)))))
2504
2505   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
2506   ;; sure we've avoided that
2507   (pass-if (not (< (ash 3 1023) +nan.0)))
2508   (pass-if (not (< (1+ (ash 3 1023)) +nan.0)))
2509   (pass-if (not (< (1- (ash 3 1023)) +nan.0)))
2510   (pass-if (not (< +nan.0 (ash 3 1023))))
2511   (pass-if (not (< +nan.0 (1+ (ash 3 1023)))))
2512   (pass-if (not (< +nan.0 (1- (ash 3 1023)))))
2513
2514   (with-test-prefix "inum/frac"
2515     (pass-if (< 2 9/4))
2516     (pass-if (< -2 9/4))
2517     (pass-if (< -2 7/4))
2518     (pass-if (< -2 -7/4))
2519     (pass-if (eq? #f (< 2 7/4)))
2520     (pass-if (eq? #f (< 2 -7/4)))
2521     (pass-if (eq? #f (< 2 -9/4)))
2522     (pass-if (eq? #f (< -2 -9/4))))
2523
2524   (with-test-prefix "bignum/frac"
2525     (let ((x (ash 1 2048)))
2526       (pass-if (< x (* 4/3 x)))
2527       (pass-if (< (- x) (* 4/3 x)))
2528       (pass-if (< (- x) (* 2/3 x)))
2529       (pass-if (< (- x) (* -2/3 x)))
2530       (pass-if (eq? #f (< x (* 2/3 x))))
2531       (pass-if (eq? #f (< x (* -2/3 x))))
2532       (pass-if (eq? #f (< x (* -4/3 x))))
2533       (pass-if (eq? #f (< (- x) (* -4/3 x))))))
2534
2535   (with-test-prefix "inum/flonum"
2536     (pass-if (< 4 4.5))
2537     (pass-if (< 4.5 5))
2538     (pass-if (< -5 -4.5))
2539     (pass-if (< -4.5 4))
2540     (pass-if (not (< 4.5 4)))
2541     (pass-if (not (< 5 4.5)))
2542     (pass-if (not (< -4.5 -5)))
2543     (pass-if (not (< 4 -4.5)))
2544
2545     (pass-if (< 4 +inf.0))
2546     (pass-if (< -4 +inf.0))
2547     (pass-if (< -inf.0 4))
2548     (pass-if (< -inf.0 -4))
2549     (pass-if (not (< +inf.0 4)))
2550     (pass-if (not (< +inf.0 -4)))
2551     (pass-if (not (< 4 -inf.0)))
2552     (pass-if (not (< -4 -inf.0)))
2553
2554     (pass-if (not (< +nan.0 4)))
2555     (pass-if (not (< +nan.0 -4)))
2556     (pass-if (not (< 4 +nan.0)))
2557     (pass-if (not (< -4 +nan.0)))
2558
2559     (pass-if (< most-positive-fixnum (expt 2.0 fixnum-bit)))
2560     (pass-if (not (< (expt 2.0 fixnum-bit) most-positive-fixnum)))
2561
2562     (pass-if (< (- (expt 2.0 fixnum-bit)) most-negative-fixnum))
2563     (pass-if (not (< most-negative-fixnum (- (expt 2.0 fixnum-bit)))))
2564
2565     ;; Prior to guile 2.0.10, we would unconditionally convert the inum
2566     ;; to a double, which on a 64-bit system could result in a
2567     ;; significant change in its value, thus corrupting the comparison.
2568     (pass-if (< most-positive-fixnum (exact->inexact (+ 1 most-positive-fixnum))))
2569     (pass-if (< (exact->inexact (- (+ 1 most-positive-fixnum))) (- most-positive-fixnum))))
2570
2571   (with-test-prefix "flonum/frac"
2572     (pass-if (< 0.75 4/3))
2573     (pass-if (< -0.75 4/3))
2574     (pass-if (< -0.75 2/3))
2575     (pass-if (< -0.75 -2/3))
2576     (pass-if (eq? #f (< 0.75 2/3)))
2577     (pass-if (eq? #f (< 0.75 -2/3)))
2578     (pass-if (eq? #f (< 0.75 -4/3)))
2579     (pass-if (eq? #f (< -0.75 -4/3)))
2580
2581     (pass-if (< -inf.0 4/3))
2582     (pass-if (< -inf.0 -4/3))
2583     (pass-if (eq? #f (< +inf.0 4/3)))
2584     (pass-if (eq? #f (< +inf.0 -4/3)))
2585
2586     (pass-if (eq? #f (< +nan.0 4/3)))
2587     (pass-if (eq? #f (< +nan.0 -4/3))))
2588
2589   (with-test-prefix "frac/inum"
2590     (pass-if (< 7/4 2))
2591     (pass-if (< -7/4 2))
2592     (pass-if (< -9/4 2))
2593     (pass-if (< -9/4 -2))
2594     (pass-if (eq? #f (< 9/4 2)))
2595     (pass-if (eq? #f (< 9/4 -2)))
2596     (pass-if (eq? #f (< 7/4 -2)))
2597     (pass-if (eq? #f (< -7/4 -2))))
2598
2599   (with-test-prefix "frac/bignum"
2600     (let ((x (ash 1 2048)))
2601       (pass-if (< (* 2/3 x) x))
2602       (pass-if (< (* -2/3 x) x))
2603       (pass-if (< (* -4/3 x) x))
2604       (pass-if (< (* -4/3 x) (- x)))
2605       (pass-if (eq? #f (< (* 4/3 x) x)))
2606       (pass-if (eq? #f (< (* 4/3 x) (- x))))
2607       (pass-if (eq? #f (< (* 2/3 x) (- x))))
2608       (pass-if (eq? #f (< (* -2/3 x) (- x))))))
2609
2610   (with-test-prefix "frac/flonum"
2611     (pass-if (< 2/3 0.75))
2612     (pass-if (< -2/3 0.75))
2613     (pass-if (< -4/3 0.75))
2614     (pass-if (< -4/3 -0.75))
2615     (pass-if (eq? #f (< 4/3 0.75)))
2616     (pass-if (eq? #f (< 4/3 -0.75)))
2617     (pass-if (eq? #f (< 2/3 -0.75)))
2618     (pass-if (eq? #f (< -2/3 -0.75)))
2619
2620     (pass-if (< 4/3 +inf.0))
2621     (pass-if (< -4/3 +inf.0))
2622     (pass-if (eq? #f (< 4/3 -inf.0)))
2623     (pass-if (eq? #f (< -4/3 -inf.0)))
2624
2625     (pass-if (eq? #f (< 4/3 +nan.0)))
2626     (pass-if (eq? #f (< -4/3 +nan.0))))
2627
2628   (with-test-prefix "frac/frac"
2629     (pass-if (< 2/3 6/7))
2630     (pass-if (< -2/3 6/7))
2631     (pass-if (< -4/3 6/7))
2632     (pass-if (< -4/3 -6/7))
2633     (pass-if (eq? #f (< 4/3 6/7)))
2634     (pass-if (eq? #f (< 4/3 -6/7)))
2635     (pass-if (eq? #f (< 2/3 -6/7)))
2636     (pass-if (eq? #f (< -2/3 -6/7)))))
2637
2638 ;;;
2639 ;;; >
2640 ;;;
2641
2642 ;; currently not tested -- implementation is trivial
2643 ;; (> x y) is implemented as (< y x)
2644 ;; FIXME: tests should probably be added in case we change implementation.
2645
2646 ;;;
2647 ;;; <=
2648 ;;;
2649
2650 ;; currently not tested -- implementation is trivial
2651 ;; (<= x y) is implemented as (not (< y x))
2652 ;; FIXME: tests should probably be added in case we change implementation.
2653
2654 ;;;
2655 ;;; >=
2656 ;;;
2657
2658 ;; currently not tested -- implementation is trivial
2659 ;; (>= x y) is implemented as (not (< x y))
2660 ;; FIXME: tests should probably be added in case we change implementation.
2661
2662 ;;;
2663 ;;; zero?
2664 ;;;
2665
2666 (with-test-prefix "zero?"
2667   (pass-if (documented? zero?))
2668
2669   (pass-if (zero?  0))
2670   (pass-if (zero?  0.0))
2671   (pass-if (zero? -0.0))
2672
2673   (pass-if (zero?  0.0+0.0i))
2674   (pass-if (zero?  0.0-0.0i))
2675   (pass-if (zero?  0.0+0.0i))
2676   (pass-if (zero? -0.0-0.0i))
2677
2678   (pass-if (not (zero?  7)))
2679   (pass-if (not (zero? -7)))
2680   (pass-if (not (zero? 1/7)))
2681   (pass-if (not (zero? -inf.0)))
2682   (pass-if (not (zero? +inf.0)))
2683   (pass-if (not (zero? +nan.0)))
2684   (pass-if (not (zero? (+ 1 fixnum-max))))
2685   (pass-if (not (zero? (- 1 fixnum-min))))
2686   (pass-if (not (zero? 1.3)))
2687   (pass-if (not (zero? 3.1+4.2i)))
2688   (pass-if (not (zero? 1.0+0.0i)))
2689   (pass-if (not (zero? 0.0-1.0i))))
2690
2691 ;;;
2692 ;;; positive?
2693 ;;;
2694
2695 (with-test-prefix "positive?"
2696   (pass-if (documented? positive?))
2697   (pass-if (positive? 1))
2698   (pass-if (positive? (+ fixnum-max 1)))
2699   (pass-if (positive? 1.3))
2700   (pass-if (not (positive? 0)))
2701   (pass-if (not (positive? -1)))
2702   (pass-if (not (positive? (- fixnum-min 1))))
2703   (pass-if (not (positive? -1.3))))
2704
2705 ;;;
2706 ;;; negative?
2707 ;;;
2708
2709 (with-test-prefix "negative?"
2710   (pass-if (documented? negative?))
2711   (pass-if (not (negative? 1)))
2712   (pass-if (not (negative? (+ fixnum-max 1))))
2713   (pass-if (not (negative? 1.3)))
2714   (pass-if (not (negative? 0)))
2715   (pass-if (negative? -1))
2716   (pass-if (negative? (- fixnum-min 1)))
2717   (pass-if (negative? -1.3)))
2718
2719 ;;;
2720 ;;; max
2721 ;;;
2722
2723 (with-test-prefix "max"
2724   (pass-if-exception "no args" exception:wrong-num-args
2725     (max))
2726
2727   (pass-if-exception "one complex" exception:wrong-type-arg
2728     (max 1+i))
2729
2730   (pass-if-exception "inum/complex" exception:wrong-type-arg
2731     (max 123 1+i))
2732   (pass-if-exception "big/complex" exception:wrong-type-arg
2733     (max 9999999999999999999999999999999999999999 1+i))
2734   (pass-if-exception "real/complex" exception:wrong-type-arg
2735     (max 123.0 1+i))
2736   (pass-if-exception "frac/complex" exception:wrong-type-arg
2737     (max 123/456 1+i))
2738
2739   (pass-if-exception "complex/inum" exception:wrong-type-arg
2740     (max 1+i 123))
2741   (pass-if-exception "complex/big" exception:wrong-type-arg
2742     (max 1+i 9999999999999999999999999999999999999999))
2743   (pass-if-exception "complex/real" exception:wrong-type-arg
2744     (max 1+i 123.0))
2745   (pass-if-exception "complex/frac" exception:wrong-type-arg
2746     (max 1+i 123/456))
2747
2748   (let ((big*2 (* fixnum-max 2))
2749         (big*3 (* fixnum-max 3))
2750         (big*4 (* fixnum-max 4))
2751         (big*5 (* fixnum-max 5)))
2752
2753     (with-test-prefix "inum / frac"
2754       (pass-if (eqv? 3 (max 3 5/2)))
2755       (pass-if (eqv? 5/2 (max 2 5/2))))
2756
2757     (with-test-prefix "frac / inum"
2758       (pass-if (eqv? 3 (max 5/2 3)))
2759       (pass-if (eqv? 5/2 (max 5/2 2))))
2760
2761     (with-test-prefix "infinities and NaNs"
2762       ;; +inf.0 beats everything except NaNs
2763       (pass-if (eqv?  +inf.0   (max   +inf.0    123   )))
2764       (pass-if (eqv?  +inf.0   (max    123     +inf.0 )))
2765       (pass-if (eqv?  +inf.0   (max   +inf.0   -123.3 )))
2766       (pass-if (eqv?  +inf.0   (max   -123.3   +inf.0 )))
2767       (pass-if (eqv?  +inf.0   (max   +inf.0   -7/2   )))
2768       (pass-if (eqv?  +inf.0   (max   -7/2     +inf.0 )))
2769       (pass-if (eqv?  +inf.0   (max   +inf.0  -1e20   )))
2770       (pass-if (eqv?  +inf.0   (max  -1e20     +inf.0 )))
2771       (pass-if (eqv?  +inf.0   (max   +inf.0 (- big*2))))
2772       (pass-if (eqv?  +inf.0   (max (- big*2)  +inf.0 )))
2773       (pass-if (eqv?  +inf.0   (max   +inf.0   +inf.0 )))
2774       (pass-if (eqv?  +inf.0   (max   +inf.0   +inf.0 )))
2775       (pass-if (eqv?  +inf.0   (max   +inf.0   +inf.0 )))
2776
2777       ;; NaNs beat everything
2778       (pass-if (real-nan?      (max   +nan.0    123   )))
2779       (pass-if (real-nan?      (max    123     +nan.0 )))
2780       (pass-if (real-nan?      (max   +nan.0    123.3 )))
2781       (pass-if (real-nan?      (max    123.3   +nan.0 )))
2782       (pass-if (real-nan?      (max   +nan.0   -7/2   )))
2783       (pass-if (real-nan?      (max   -7/2     +nan.0 )))
2784       (pass-if (real-nan?      (max   +nan.0  -1e20   )))
2785       (pass-if (real-nan?      (max  -1e20     +nan.0 )))
2786       (pass-if (real-nan?      (max   +nan.0 (- big*2))))
2787       (pass-if (real-nan?      (max (- big*2)  +nan.0 )))
2788       (pass-if (real-nan?      (max   +nan.0   -inf.0 )))
2789       (pass-if (real-nan?      (max   -inf.0   +nan.0 )))
2790       (pass-if (real-nan?      (max   +nan.0   +nan.0 )))
2791       (pass-if (real-nan?      (max   +inf.0   +nan.0 )))
2792       (pass-if (real-nan?      (max   +nan.0   +inf.0 )))
2793
2794       ;; -inf.0 always loses, except against itself
2795       (pass-if (eqv?   -inf.0  (max   -inf.0   -inf.0 )))
2796       (pass-if (eqv?   -123.0  (max   -inf.0   -123   )))
2797       (pass-if (eqv?   -123.0  (max   -123     -inf.0 )))
2798       (pass-if (eqv?   -123.3  (max   -inf.0   -123.3 )))
2799       (pass-if (eqv?   -123.3  (max   -123.3   -inf.0 )))
2800       (pass-if (eqv?     -3.5  (max   -inf.0   -7/2   )))
2801       (pass-if (eqv?     -3.5  (max   -7/2     -inf.0 )))
2802       (pass-if (eqv?  -1.0e20  (max   -inf.0  -1e20   )))
2803       (pass-if (eqv?  -1.0e20  (max  -1e20     -inf.0 )))
2804       (pass-if (eqv? (exact->inexact (- big*2))
2805                      (max   -inf.0 (- big*2))))
2806       (pass-if (eqv? (exact->inexact (- big*2))
2807                      (max (- big*2)  -inf.0 ))))
2808
2809     (with-test-prefix "signed zeroes"
2810       (pass-if (eqv?  0.0  (max  0.0  0.0)))
2811       (pass-if (eqv?  0.0  (max  0.0 -0.0)))
2812       (pass-if (eqv?  0.0  (max -0.0  0.0)))
2813       (pass-if (eqv? -0.0  (max -0.0 -0.0)))
2814       (pass-if (eqv?  0.0  (max -0.0  0  )))
2815       (pass-if (eqv?  0.0  (max  0.0  0  )))
2816       (pass-if (eqv?  0.0  (max  0   -0.0)))
2817       (pass-if (eqv?  0.0  (max  0    0.0)))
2818       (pass-if (eqv?  0    (min  0    0  ))))
2819
2820     (with-test-prefix "big / frac"
2821       (pass-if (eqv? big*2 (max big*2 5/2)))
2822       (pass-if (eqv? 5/2 (max (- big*2) 5/2))))
2823
2824     (with-test-prefix "frac / big"
2825       (pass-if (eqv? big*2 (max 5/2 big*2)))
2826       (pass-if (eqv? 5/2 (max 5/2 (- big*2)))))
2827
2828     (with-test-prefix "big / real"
2829       (pass-if (real-nan? (max big*5 +nan.0)))
2830       (pass-if (eqv? (exact->inexact big*5)  (max big*5 -inf.0)))
2831       (pass-if (eqv? (exact->inexact big*5)  (max big*5 1.0)))
2832       (pass-if (eqv? +inf.0                  (max big*5 +inf.0)))
2833       (pass-if (eqv? 1.0                     (max (- big*5) 1.0))))
2834
2835     (with-test-prefix "real / big"
2836       (pass-if (real-nan? (max +nan.0 big*5)))
2837       (pass-if (eqv? (exact->inexact big*5)  (max -inf.0 big*5)))
2838       (pass-if (eqv? (exact->inexact big*5)  (max 1.0 big*5)))
2839       (pass-if (eqv? +inf.0                  (max +inf.0 big*5)))
2840       (pass-if (eqv? 1.0                     (max 1.0 (- big*5)))))
2841
2842     (with-test-prefix "frac / frac"
2843       (pass-if (eqv? 2/3 (max 1/2 2/3)))
2844       (pass-if (eqv? 2/3 (max 2/3 1/2)))
2845       (pass-if (eqv? -1/2 (max -1/2 -2/3)))
2846       (pass-if (eqv? -1/2 (max -2/3 -1/2))))
2847
2848     (with-test-prefix "real / real"
2849       (pass-if (real-nan? (max 123.0 +nan.0)))
2850       (pass-if (real-nan? (max +nan.0 123.0)))
2851       (pass-if (real-nan? (max +nan.0 +nan.0)))
2852       (pass-if (eqv? 456.0 (max 123.0 456.0)))
2853       (pass-if (eqv? 456.0 (max 456.0 123.0)))))
2854
2855   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
2856   ;; sure we've avoided that
2857   (for-each (lambda (b)
2858               (pass-if (list b +inf.0)
2859                 (eqv? +inf.0 (max b +inf.0)))
2860               (pass-if (list +inf.0 b)
2861                 (eqv? +inf.0 (max b +inf.0)))
2862               (pass-if (list b -inf.0)
2863                 (eqv? (exact->inexact b) (max b -inf.0)))
2864               (pass-if (list -inf.0 b)
2865                 (eqv? (exact->inexact b) (max b -inf.0))))
2866             (list (1- (ash 1 1024))
2867                   (ash 1 1024)
2868                   (1+ (ash 1 1024))
2869                   (- (1- (ash 1 1024)))
2870                   (- (ash 1 1024))
2871                   (- (1+ (ash 1 1024)))))
2872
2873   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
2874   ;; sure we've avoided that
2875   (pass-if (real-nan? (max (ash 1 2048) +nan.0)))
2876   (pass-if (real-nan? (max +nan.0 (ash 1 2048)))))
2877
2878 ;;;
2879 ;;; min
2880 ;;;
2881
2882 ;; FIXME: unfinished...
2883
2884 (with-test-prefix "min"
2885   (pass-if-exception "no args" exception:wrong-num-args
2886     (min))
2887
2888   (pass-if-exception "one complex" exception:wrong-type-arg
2889     (min 1+i))
2890
2891   (pass-if-exception "inum/complex" exception:wrong-type-arg
2892     (min 123 1+i))
2893   (pass-if-exception "big/complex" exception:wrong-type-arg
2894     (min 9999999999999999999999999999999999999999 1+i))
2895   (pass-if-exception "real/complex" exception:wrong-type-arg
2896     (min 123.0 1+i))
2897   (pass-if-exception "frac/complex" exception:wrong-type-arg
2898     (min 123/456 1+i))
2899
2900   (pass-if-exception "complex/inum" exception:wrong-type-arg
2901     (min 1+i 123))
2902   (pass-if-exception "complex/big" exception:wrong-type-arg
2903     (min 1+i 9999999999999999999999999999999999999999))
2904   (pass-if-exception "complex/real" exception:wrong-type-arg
2905     (min 1+i 123.0))
2906   (pass-if-exception "complex/frac" exception:wrong-type-arg
2907     (min 1+i 123/456))
2908
2909   (let ((big*2 (* fixnum-max 2))
2910         (big*3 (* fixnum-max 3))
2911         (big*4 (* fixnum-max 4))
2912         (big*5 (* fixnum-max 5)))
2913
2914     (pass-if (documented? min))
2915     (pass-if (eqv? 1 (min 7 3 1 5)))
2916     (pass-if (eqv? 1 (min 1 7 3 5)))
2917     (pass-if (eqv? 1 (min 7 3 5 1)))
2918     (pass-if (eqv? -7 (min 2 3 4 -2 5 -7 1 -1 4 2)))
2919     (pass-if (eqv? -7 (min -7 2 3 4 -2 5 1 -1 4 2)))
2920     (pass-if (eqv? -7 (min 2 3 4 -2 5 1 -1 4 2 -7)))
2921     (pass-if (eqv? big*2 (min big*3 big*5 big*2 big*4)))
2922     (pass-if (eqv? big*2 (min big*2 big*3 big*5 big*4)))
2923     (pass-if (eqv? big*2 (min big*3 big*5 big*4 big*2)))
2924     (pass-if
2925         (eqv? (- fixnum-min 1) (min 2 4 (- fixnum-min 1) 3 (* 2 fixnum-max))))
2926     (pass-if
2927         (eqv? (- fixnum-min 1) (min (- fixnum-min 1) 2 4 3 (* 2 fixnum-max))))
2928     (pass-if
2929         (eqv? (- fixnum-min 1) (min 2 4 3 (* 2 fixnum-max) (- fixnum-min 1))))
2930
2931     (with-test-prefix "inum / frac"
2932       (pass-if (eqv? 5/2 (min 3 5/2)))
2933       (pass-if (eqv? 2   (min 2 5/2))))
2934
2935     (with-test-prefix "frac / inum"
2936       (pass-if (eqv? 5/2 (min 5/2 3)))
2937       (pass-if (eqv? 2   (min 5/2 2))))
2938
2939     (with-test-prefix "infinities and NaNs"
2940       ;; -inf.0 beats everything except NaNs
2941       (pass-if (eqv?  -inf.0   (min   -inf.0    123   )))
2942       (pass-if (eqv?  -inf.0   (min    123     -inf.0 )))
2943       (pass-if (eqv?  -inf.0   (min   -inf.0   -123.3 )))
2944       (pass-if (eqv?  -inf.0   (min   -123.3   -inf.0 )))
2945       (pass-if (eqv?  -inf.0   (min   -inf.0   -7/2   )))
2946       (pass-if (eqv?  -inf.0   (min   -7/2     -inf.0 )))
2947       (pass-if (eqv?  -inf.0   (min   -inf.0  -1e20   )))
2948       (pass-if (eqv?  -inf.0   (min  -1e20     -inf.0 )))
2949       (pass-if (eqv?  -inf.0   (min   -inf.0 (- big*2))))
2950       (pass-if (eqv?  -inf.0   (min (- big*2)  -inf.0 )))
2951       (pass-if (eqv?  -inf.0   (min   -inf.0   +inf.0 )))
2952       (pass-if (eqv?  -inf.0   (min   +inf.0   -inf.0 )))
2953       (pass-if (eqv?  -inf.0   (min   -inf.0   -inf.0 )))
2954
2955       ;; NaNs beat everything
2956       (pass-if (real-nan?      (min   +nan.0    123   )))
2957       (pass-if (real-nan?      (min    123     +nan.0 )))
2958       (pass-if (real-nan?      (min   +nan.0    123.3 )))
2959       (pass-if (real-nan?      (min    123.3   +nan.0 )))
2960       (pass-if (real-nan?      (min   +nan.0   -7/2   )))
2961       (pass-if (real-nan?      (min   -7/2     +nan.0 )))
2962       (pass-if (real-nan?      (min   +nan.0  -1e20   )))
2963       (pass-if (real-nan?      (min  -1e20     +nan.0 )))
2964       (pass-if (real-nan?      (min   +nan.0 (- big*2))))
2965       (pass-if (real-nan?      (min (- big*2)  +nan.0 )))
2966       (pass-if (real-nan?      (min   +nan.0   +inf.0 )))
2967       (pass-if (real-nan?      (min   +inf.0   +nan.0 )))
2968       (pass-if (real-nan?      (min   +nan.0   +nan.0 )))
2969       (pass-if (real-nan?      (min   -inf.0   +nan.0 )))
2970       (pass-if (real-nan?      (min   +nan.0   -inf.0 )))
2971
2972       ;; +inf.0 always loses, except against itself
2973       (pass-if (eqv?   +inf.0  (min   +inf.0   +inf.0 )))
2974       (pass-if (eqv?   -123.0  (min   +inf.0   -123   )))
2975       (pass-if (eqv?   -123.0  (min   -123     +inf.0 )))
2976       (pass-if (eqv?   -123.3  (min   +inf.0   -123.3 )))
2977       (pass-if (eqv?   -123.3  (min   -123.3   +inf.0 )))
2978       (pass-if (eqv?     -3.5  (min   +inf.0   -7/2   )))
2979       (pass-if (eqv?     -3.5  (min   -7/2     +inf.0 )))
2980       (pass-if (eqv?  -1.0e20  (min   +inf.0  -1e20   )))
2981       (pass-if (eqv?  -1.0e20  (min  -1e20     +inf.0 )))
2982       (pass-if (eqv? (exact->inexact (- big*2))
2983                      (min   +inf.0 (- big*2))))
2984       (pass-if (eqv? (exact->inexact (- big*2))
2985                      (min (- big*2)  +inf.0 ))))
2986
2987     (with-test-prefix "signed zeroes"
2988       (pass-if (eqv?  0.0  (min  0.0  0.0)))
2989       (pass-if (eqv? -0.0  (min  0.0 -0.0)))
2990       (pass-if (eqv? -0.0  (min -0.0  0.0)))
2991       (pass-if (eqv? -0.0  (min -0.0 -0.0)))
2992       (pass-if (eqv? -0.0  (min -0.0  0  )))
2993       (pass-if (eqv?  0.0  (min  0.0  0  )))
2994       (pass-if (eqv? -0.0  (min  0   -0.0)))
2995       (pass-if (eqv?  0.0  (min  0    0.0)))
2996       (pass-if (eqv?  0    (min  0    0  ))))
2997
2998     (with-test-prefix "big / frac"
2999       (pass-if (eqv? 5/2       (min big*2 5/2)))
3000       (pass-if (eqv? (- big*2) (min (- big*2) 5/2))))
3001
3002     (with-test-prefix "frac / big"
3003       (pass-if (eqv? 5/2       (min 5/2 big*2)))
3004       (pass-if (eqv? (- big*2) (min 5/2 (- big*2)))))
3005
3006     (with-test-prefix "big / real"
3007       (pass-if (real-nan? (min big*5 +nan.0)))
3008       (pass-if (eqv? (exact->inexact big*5)      (min big*5  +inf.0)))
3009       (pass-if (eqv? -inf.0                      (min big*5  -inf.0)))
3010       (pass-if (eqv? 1.0                         (min big*5 1.0)))
3011       (pass-if (eqv? (exact->inexact (- big*5))  (min (- big*5) 1.0))))
3012
3013     (with-test-prefix "real / big"
3014       (pass-if (real-nan? (min +nan.0 big*5)))
3015       (pass-if (eqv? (exact->inexact big*5)      (min +inf.0 big*5)))
3016       (pass-if (eqv? -inf.0                      (min -inf.0 big*5)))
3017       (pass-if (eqv? 1.0                         (min 1.0 big*5)))
3018       (pass-if (eqv? (exact->inexact (- big*5))  (min 1.0 (- big*5)))))
3019
3020     (with-test-prefix "frac / frac"
3021       (pass-if (eqv? 1/2 (min 1/2 2/3)))
3022       (pass-if (eqv? 1/2 (min 2/3 1/2)))
3023       (pass-if (eqv? -2/3 (min -1/2 -2/3)))
3024       (pass-if (eqv? -2/3 (min -2/3 -1/2))))
3025
3026     (with-test-prefix "real / real"
3027       (pass-if (real-nan? (min 123.0 +nan.0)))
3028       (pass-if (real-nan? (min +nan.0 123.0)))
3029       (pass-if (real-nan? (min +nan.0 +nan.0)))
3030       (pass-if (eqv? 123.0 (min 123.0 456.0)))
3031       (pass-if (eqv? 123.0 (min 456.0 123.0)))))
3032
3033
3034   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
3035   ;; sure we've avoided that
3036   (for-each (lambda (b)
3037               (pass-if (list b +inf.0)
3038                 (eqv? (exact->inexact b) (min b +inf.0)))
3039               (pass-if (list +inf.0 b)
3040                 (eqv? (exact->inexact b) (min b +inf.0)))
3041               (pass-if (list b -inf.0)
3042                 (eqv? -inf.0 (min b -inf.0)))
3043               (pass-if (list -inf.0 b)
3044                 (eqv? -inf.0 (min b -inf.0))))
3045             (list (1- (ash 1 1024))
3046                   (ash 1 1024)
3047                   (1+ (ash 1 1024))
3048                   (- (1- (ash 1 1024)))
3049                   (- (ash 1 1024))
3050                   (- (1+ (ash 1 1024)))))
3051
3052   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
3053   ;; sure we've avoided that
3054   (pass-if (real-nan? (min (- (ash 1 2048)) (- +nan.0))))
3055   (pass-if (real-nan? (min (- +nan.0) (- (ash 1 2048))))))
3056
3057 ;;;
3058 ;;; +
3059 ;;;
3060
3061 (with-test-prefix/c&e "+"
3062
3063   (pass-if "documented?"
3064     (documented? +))
3065
3066   (pass-if "simple"
3067     (and (eqv?  7 (+ 3 4))
3068          (eqv?  3 (+ 3))
3069          (eqv?  0 (+))))
3070
3071   (pass-if "exactness propagation"
3072     (and (eqv?  8   (+ 3 5))
3073          (eqv?  8.0 (+ 3 5.0))
3074          (eqv?  8.0 (+ 3.0 5))
3075          (eqv?  8.0 (+ 3.0 5.0))
3076
3077          (eqv?  5/6  (+ 1/2 1/3))
3078          (eqv?  5.5  (+ 1/2 5.0))
3079          (eqv?  3.25 (+ 3.0 1/4))))
3080
3081   (pass-if "signed zeroes"
3082     (and (eqv?  0.0 (+  0.0))
3083          (eqv? -0.0 (+ -0.0))
3084          (eqv?  0.0 (+  0.0  0.0))
3085          (eqv?  0.0 (+  0.0 -0.0))
3086          (eqv?  0.0 (+ -0.0  0.0))
3087          (eqv? -0.0 (+ -0.0 -0.0))))
3088
3089   (pass-if "NaNs"
3090     (and (real-nan?  (+ +nan.0 +nan.0))
3091          (real-nan?  (+ 0 +nan.0))
3092          (real-nan?  (+ +nan.0 0))
3093          (real-nan?  (+ 1 +nan.0))
3094          (real-nan?  (+ +nan.0 1))
3095          (real-nan?  (+ -1 +nan.0))
3096          (real-nan?  (+ +nan.0 -1))
3097          (real-nan?  (+ -7/2 +nan.0))
3098          (real-nan?  (+ +nan.0 -7/2))
3099          (real-nan?  (+ 1e20 +nan.0))
3100          (real-nan?  (+ +nan.0 1e20))
3101          (real-nan?  (+ +inf.0 +nan.0))
3102          (real-nan?  (+ +nan.0 +inf.0))
3103          (real-nan?  (+ -inf.0 +nan.0))
3104          (real-nan?  (+ +nan.0 -inf.0))
3105          (real-nan?  (+ (* fixnum-max 2) +nan.0))
3106          (real-nan?  (+ +nan.0 (* fixnum-max 2)))))
3107
3108   (pass-if "infinities"
3109     (and (eqv? +inf.0 (+ +inf.0 +inf.0))
3110          (eqv? -inf.0 (+ -inf.0 -inf.0))
3111          (real-nan?   (+ +inf.0 -inf.0))
3112          (real-nan?   (+ -inf.0 +inf.0))))
3113
3114   ;; The maximum fixnum on a 32-bit architecture: 2^29 - 1.
3115   (pass-if "fixnum + fixnum = bignum (32-bit)"
3116     (eqv? 536870912 (+ 536870910 2)))
3117
3118   ;; The maximum fixnum on a 64-bit architecture: 2^61 - 1.
3119   (pass-if "fixnum + fixnum = bignum (64-bit)"
3120     (eqv? 2305843009213693952 (+ 2305843009213693950 2)))
3121
3122   (pass-if "bignum + fixnum = fixnum"
3123     (eqv? 0 (+ (1+ most-positive-fixnum) most-negative-fixnum))))
3124
3125 ;;;
3126 ;;; -
3127 ;;;
3128
3129 (with-test-prefix/c&e "-"
3130
3131   (pass-if "double-negation of fixnum-min: ="
3132     (=      fixnum-min (- (- fixnum-min))))
3133   (pass-if "double-negation of fixnum-min: eqv?"
3134     (eqv?   fixnum-min (- (- fixnum-min))))
3135   (pass-if "double-negation of fixnum-min: equal?"
3136     (equal? fixnum-min (- (- fixnum-min))))
3137
3138   (pass-if "binary double-negation of fixnum-min: ="
3139     (=      fixnum-min (- 0 (- 0 fixnum-min))))
3140   (pass-if "binary double-negation of fixnum-min: eqv?"
3141     (eqv?   fixnum-min (- 0 (- 0 fixnum-min))))
3142   (pass-if "binary double-negation of fixnum-min: equal?"
3143     (equal? fixnum-min (- 0 (- 0 fixnum-min))))
3144
3145   (pass-if "signed zeroes"
3146     (and (eqv? +0.0 (- -0.0))
3147          (eqv? -0.0 (- +0.0))
3148          (eqv?  0.0 (-  0.0  0.0))
3149          (eqv?  0.0 (-  0.0 -0.0))
3150          (eqv?  0.0 (- -0.0 -0.0))
3151          (eqv? -0.0 (- -0.0  0.0))))
3152
3153   (pass-if "exactness propagation"
3154     (and (eqv?  3   (- 8 5))
3155          (eqv?  3.0 (- 8 5.0))
3156          (eqv?  3.0 (- 8.0 5))
3157          (eqv?  3.0 (- 8.0 5.0))
3158          (eqv? -1/6  (- 1/3 1/2))
3159          (eqv? -4.5  (- 1/2 5.0))
3160          (eqv?  2.75 (- 3.0 1/4))))
3161
3162   (pass-if "infinities"
3163     (and (eqv? +inf.0 (- +inf.0 -inf.0))
3164          (eqv? -inf.0 (- -inf.0 +inf.0))
3165          (real-nan?   (- +inf.0 +inf.0))
3166          (real-nan?   (- -inf.0 -inf.0))))
3167
3168   (pass-if "NaNs"
3169     (and (real-nan?  (- +nan.0 +nan.0))
3170          (real-nan?  (- 0 +nan.0))
3171          (real-nan?  (- +nan.0 0))
3172          (real-nan?  (- 1 +nan.0))
3173          (real-nan?  (- +nan.0 1))
3174          (real-nan?  (- -1 +nan.0))
3175          (real-nan?  (- +nan.0 -1))
3176          (real-nan?  (- -7/2 +nan.0))
3177          (real-nan?  (- +nan.0 -7/2))
3178          (real-nan?  (- 1e20 +nan.0))
3179          (real-nan?  (- +nan.0 1e20))
3180          (real-nan?  (- +inf.0 +nan.0))
3181          (real-nan?  (- +nan.0 +inf.0))
3182          (real-nan?  (- -inf.0 +nan.0))
3183          (real-nan?  (- +nan.0 -inf.0))
3184          (real-nan?  (- (* fixnum-max 2) +nan.0))
3185          (real-nan?  (- +nan.0 (* fixnum-max 2)))))
3186
3187   (pass-if "(eqv? fixnum-min (- (- fixnum-min)))"
3188     (eqv? fixnum-min (- (- fixnum-min))))
3189   (pass-if "(eqv? fixnum-min (- 0 (- 0 fixnum-min)))"
3190     (eqv? fixnum-min (- 0 (- 0 fixnum-min))))
3191   (pass-if "(eqv? fixnum-num (apply - (list (apply - (list fixnum-min)))))"
3192     (eqv? fixnum-min (apply - (list (apply - (list fixnum-min))))))
3193
3194   (pass-if "-inum - +bignum"
3195     (= #x-100000000000000000000000000000001
3196        (- -1 #x100000000000000000000000000000000)))
3197
3198   (pass-if "big - inum"
3199     (= #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
3200        (- #x100000000000000000000000000000000 1)))
3201
3202   (pass-if "big - -inum"
3203     (= #x100000000000000000000000000000001
3204        (- #x100000000000000000000000000000000 -1)))
3205
3206   ;; The mininum fixnum on a 32-bit architecture: -2^29.
3207   (pass-if "fixnum - fixnum = bignum (32-bit)"
3208     (eqv? -536870912 (- -536870910 2)))
3209
3210   ;; The minimum fixnum on a 64-bit architecture: -2^61.
3211   (pass-if "fixnum - fixnum = bignum (64-bit)"
3212     (eqv? -2305843009213693952 (- -2305843009213693950 2)))
3213
3214   (pass-if "bignum - fixnum = fixnum"
3215     (eqv? most-positive-fixnum (- (1+ most-positive-fixnum) 1))))
3216
3217 ;;;
3218 ;;; *
3219 ;;;
3220
3221 (with-test-prefix "*"
3222
3223   (with-test-prefix "double-negation of fixnum-min"
3224     (pass-if (=      fixnum-min (* -1 (* -1 fixnum-min))))
3225     (pass-if (eqv?   fixnum-min (* -1 (* -1 fixnum-min))))
3226     (pass-if (equal? fixnum-min (* -1 (* -1 fixnum-min))))
3227     (pass-if (=      fixnum-min (* (* fixnum-min -1) -1)))
3228     (pass-if (eqv?   fixnum-min (* (* fixnum-min -1) -1)))
3229     (pass-if (equal? fixnum-min (* (* fixnum-min -1) -1))))
3230
3231   (with-test-prefix "signed fixnum overflow"
3232     (pass-if (eqv? (* 65536 65536) 4294967296))
3233     (pass-if (eqv? (* -65536 65536) -4294967296))
3234     (pass-if (eqv? (* 65536 -65536) -4294967296))
3235     (pass-if (eqv? (* -65536 -65536) 4294967296))
3236     (pass-if (eqv? (* 4294967296 4294967296) 18446744073709551616))
3237     (pass-if (eqv? (* -4294967296 4294967296) -18446744073709551616))
3238     (pass-if (eqv? (* 4294967296 -4294967296) -18446744073709551616))
3239     (pass-if (eqv? (* -4294967296 -4294967296) 18446744073709551616)))
3240
3241   (with-test-prefix "signed zeroes"
3242     (pass-if (eqv? +0.0 (* +0.0 +0.0)))
3243     (pass-if (eqv? -0.0 (* -0.0 +0.0)))
3244     (pass-if (eqv? +0.0 (* -0.0 -0.0)))
3245     (pass-if (eqv? -0.0 (* +0.0 -0.0)))
3246     (pass-if (eqv? +0.0+0.0i (* +i +0.0)))
3247     (pass-if (eqv? +0.0-0.0i (* -i +0.0)))
3248     (pass-if (eqv? -0.0-0.0i (* +i -0.0)))
3249     (pass-if (eqv? -0.0+0.0i (* -i -0.0))))
3250
3251   (with-test-prefix "exactness propagation"
3252     (pass-if (eqv? -0.0 (*  0 -1.0 )))
3253     (pass-if (eqv?  0.0 (*  0  1.0 )))
3254     (pass-if (eqv? -0.0 (* -1.0  0 )))
3255     (pass-if (eqv?  0.0 (*  1.0  0 )))
3256     (pass-if (eqv?  0   (*  0  1/2 )))
3257     (pass-if (eqv?  0   (*  1/2  0 )))
3258     (pass-if (eqv?  0.0+0.0i (*  0  1+i )))
3259     (pass-if (eqv?  0.0+0.0i (*  1+i  0 )))
3260     (pass-if (eqv? -1.0 (*  1 -1.0 )))
3261     (pass-if (eqv?  1.0 (*  1  1.0 )))
3262     (pass-if (eqv? -1.0 (* -1.0  1 )))
3263     (pass-if (eqv?  1.0 (*  1.0  1 )))
3264     (pass-if (eqv?  1/2 (*  1  1/2 )))
3265     (pass-if (eqv?  1/2 (*  1/2  1 )))
3266     (pass-if (eqv?  1+i (*  1  1+i )))
3267     (pass-if (eqv?  1+i (*  1+i  1 ))))
3268
3269   (with-test-prefix "propagation of NaNs"
3270     (pass-if (real-nan?      (* +nan.0 +nan.0)))
3271     (pass-if (real-nan?      (* +nan.0    1  )))
3272     (pass-if (real-nan?      (* +nan.0   -1  )))
3273     (pass-if (real-nan?      (* +nan.0 -7/2  )))
3274     (pass-if (real-nan?      (* +nan.0 1e20  )))
3275     (pass-if (real-nan?      (*  1     +nan.0)))
3276     (pass-if (real-nan?      (* -1     +nan.0)))
3277     (pass-if (real-nan?      (* -7/2   +nan.0)))
3278     (pass-if (real-nan?      (* 1e20   +nan.0)))
3279     (pass-if (real-nan?      (* +inf.0 +nan.0)))
3280     (pass-if (real-nan?      (* +nan.0 +inf.0)))
3281     (pass-if (real-nan?      (* -inf.0 +nan.0)))
3282     (pass-if (real-nan?      (* +nan.0 -inf.0)))
3283     (pass-if (real-nan?      (* (* fixnum-max 2) +nan.0)))
3284     (pass-if (real-nan?      (* +nan.0 (* fixnum-max 2))))
3285
3286     (pass-if (real-nan?        (*     0     +nan.0  )))
3287     (pass-if (real-nan?        (*  +nan.0      0    )))
3288     (pass-if (almost-real-nan? (*     0     +nan.0+i)))
3289     (pass-if (almost-real-nan? (*  +nan.0+i    0    )))
3290
3291     (pass-if (imaginary-nan? (*     0     +nan.0i )))
3292     (pass-if (imaginary-nan? (*  +nan.0i     0    )))
3293     (pass-if (imaginary-nan? (*     0    1+nan.0i )))
3294     (pass-if (imaginary-nan? (* 1+nan.0i     0    )))
3295
3296     (pass-if (complex-nan?   (* 0   +nan.0+nan.0i )))
3297     (pass-if (complex-nan?   (* +nan.0+nan.0i   0 ))))
3298
3299   (with-test-prefix "infinities"
3300     (pass-if (eqv?   +inf.0  (* +inf.0  5  )))
3301     (pass-if (eqv?   -inf.0  (* +inf.0 -5  )))
3302     (pass-if (eqv?   +inf.0  (* +inf.0 73.1)))
3303     (pass-if (eqv?   -inf.0  (* +inf.0 -9.2)))
3304     (pass-if (eqv?   +inf.0  (* +inf.0  5/2)))
3305     (pass-if (eqv?   -inf.0  (* +inf.0 -5/2)))
3306     (pass-if (eqv?   -inf.0  (* -5   +inf.0)))
3307     (pass-if (eqv?   +inf.0  (* 73.1 +inf.0)))
3308     (pass-if (eqv?   -inf.0  (* -9.2 +inf.0)))
3309     (pass-if (eqv?   +inf.0  (*  5/2 +inf.0)))
3310     (pass-if (eqv?   -inf.0  (* -5/2 +inf.0)))
3311
3312     (pass-if (eqv?   -inf.0  (* -inf.0  5  )))
3313     (pass-if (eqv?   +inf.0  (* -inf.0 -5  )))
3314     (pass-if (eqv?   -inf.0  (* -inf.0 73.1)))
3315     (pass-if (eqv?   +inf.0  (* -inf.0 -9.2)))
3316     (pass-if (eqv?   -inf.0  (* -inf.0  5/2)))
3317     (pass-if (eqv?   +inf.0  (* -inf.0 -5/2)))
3318     (pass-if (eqv?   +inf.0  (* -5   -inf.0)))
3319     (pass-if (eqv?   -inf.0  (* 73.1 -inf.0)))
3320     (pass-if (eqv?   +inf.0  (* -9.2 -inf.0)))
3321     (pass-if (eqv?   -inf.0  (* 5/2  -inf.0)))
3322     (pass-if (eqv?   +inf.0  (* -5/2 -inf.0)))
3323
3324     (pass-if (real-nan?      (*    0.0 +inf.0)))
3325     (pass-if (real-nan?      (*   -0.0 +inf.0)))
3326     (pass-if (real-nan?      (* +inf.0    0.0)))
3327     (pass-if (real-nan?      (* +inf.0   -0.0)))
3328
3329     (pass-if (real-nan?      (*    0.0 -inf.0)))
3330     (pass-if (real-nan?      (*   -0.0 -inf.0)))
3331     (pass-if (real-nan?      (* -inf.0    0.0)))
3332     (pass-if (real-nan?      (* -inf.0   -0.0)))
3333
3334     (pass-if (real-nan?      (*     0     +inf.0  )))
3335     (pass-if (real-nan?      (*  +inf.0      0    )))
3336     (pass-if (real-nan?      (*     0     -inf.0  )))
3337     (pass-if (real-nan?      (*  -inf.0      0    )))
3338
3339     (pass-if (almost-real-nan? (*     0     +inf.0+i)))
3340     (pass-if (almost-real-nan? (*  +inf.0+i    0    )))
3341     (pass-if (almost-real-nan? (*     0     -inf.0+i)))
3342     (pass-if (almost-real-nan? (*  -inf.0+i    0    )))
3343
3344     (pass-if (imaginary-nan? (*     0     +inf.0i )))
3345     (pass-if (imaginary-nan? (*  +inf.0i     0    )))
3346     (pass-if (imaginary-nan? (*     0    1+inf.0i )))
3347     (pass-if (imaginary-nan? (* 1+inf.0i     0    )))
3348
3349     (pass-if (imaginary-nan? (*     0     -inf.0i )))
3350     (pass-if (imaginary-nan? (*  -inf.0i     0    )))
3351     (pass-if (imaginary-nan? (*     0    1-inf.0i )))
3352     (pass-if (imaginary-nan? (* 1-inf.0i     0    )))
3353
3354     (pass-if (complex-nan?   (* 0   +inf.0+inf.0i )))
3355     (pass-if (complex-nan?   (* +inf.0+inf.0i   0 )))
3356
3357     (pass-if (complex-nan?   (* 0   +inf.0-inf.0i )))
3358     (pass-if (complex-nan?   (* -inf.0+inf.0i   0 ))))
3359
3360   (with-test-prefix "inum * bignum"
3361
3362     (pass-if "0 * 2^256 = 0"
3363       (eqv? 0 (* 0 (ash 1 256)))))
3364
3365   (with-test-prefix "inum * flonum"
3366
3367     (pass-if "0 * 1.0 = 0.0"
3368       (eqv? 0.0 (* 0 1.0))))
3369
3370   (with-test-prefix "inum * complex"
3371
3372     (pass-if "0 * 1+1i = 0.0+0.0i"
3373       (eqv? 0.0+0.0i (* 0 1+1i))))
3374
3375   (with-test-prefix "inum * frac"
3376
3377     (pass-if "0 * 2/3 = 0"
3378       (eqv? 0 (* 0 2/3))))
3379
3380   (with-test-prefix "bignum * inum"
3381
3382     (pass-if "2^256 * 0 = 0"
3383       (eqv? 0 (* (ash 1 256) 0))))
3384
3385   (with-test-prefix "flonum * inum"
3386     (pass-if "1.0 * 0 = 0.0"
3387       (eqv? 0.0 (* 1.0 0))))
3388
3389   (with-test-prefix "complex * inum"
3390     (pass-if "1+1i * 0 = 0.0+0.0i"
3391       (eqv? 0.0+0.0i (* 1+1i 0))))
3392
3393   (pass-if "complex * bignum"
3394     (let ((big (ash 1 90)))
3395       (= (make-rectangular big big)
3396          (* 1+1i big))))
3397
3398   (with-test-prefix "frac * inum"
3399
3400     (pass-if "2/3 * 0 = 0"
3401       (eqv? 0 (* 2/3 0)))))
3402
3403 ;;;
3404 ;;; /
3405 ;;;
3406
3407 (with-test-prefix "/"
3408
3409   (with-test-prefix "double-negation of fixnum-min"
3410     (pass-if (=      fixnum-min (/ (/ fixnum-min -1) -1)))
3411     (pass-if (eqv?   fixnum-min (/ (/ fixnum-min -1) -1)))
3412     (pass-if (equal? fixnum-min (/ (/ fixnum-min -1) -1))))
3413
3414   (pass-if "documented?"
3415     (documented? /))
3416
3417   (with-test-prefix "division by zero"
3418
3419     (pass-if-exception "(/ 0)"
3420         exception:numerical-overflow
3421       (/ 0))
3422
3423     (pass-if "(/ 0.0)"
3424       (= +inf.0 (/ 0.0)))
3425
3426     (pass-if-exception "(/ 1 0)"
3427         exception:numerical-overflow
3428       (/ 1 0))
3429
3430     (pass-if "(/ 1 0.0)"
3431       (= +inf.0 (/ 1 0.0)))
3432
3433     (pass-if-exception "(/ bignum 0)"
3434         exception:numerical-overflow
3435       (/ (+ fixnum-max 1) 0))
3436
3437     (pass-if "(/ bignum 0.0)"
3438       (= +inf.0 (/ (+ fixnum-max 1) 0.0)))
3439
3440     (pass-if-exception "(/ 1.0 0)"
3441         exception:numerical-overflow
3442       (/ 1.0 0))
3443
3444     (pass-if "(/ 1.0 0.0)"
3445       (= +inf.0 (/ 1.0 0.0)))
3446
3447     (pass-if-exception "(/ +i 0)"
3448         exception:numerical-overflow
3449       (/ +i 0))
3450
3451     (pass-if "(/ +i 0.0)"
3452       (= +inf.0 (imag-part (/ +i 0.0)))))
3453
3454   (with-test-prefix "1/complex"
3455
3456     (pass-if "0+1i"
3457       (eqv? 0-1i (/ 0+1i)))
3458
3459     ;; in guile 1.6 through 1.6.7 this incorrectly resulted in nans
3460     (pass-if "0-1i"
3461       (eqv? 0+1i (/ 0-1i)))
3462
3463     (pass-if "1+1i"
3464       (eqv? 0.5-0.5i (/ 1+1i)))
3465
3466     (pass-if "1-1i"
3467       (eqv? 0.5+0.5i (/ 1-1i)))
3468
3469     (pass-if "-1+1i"
3470       (eqv? -0.5-0.5i (/ -1+1i)))
3471
3472     (pass-if "-1-1i"
3473       (eqv? -0.5+0.5i (/ -1-1i)))
3474
3475     (pass-if "(/ 3+4i)"
3476       (= (/ 3+4i) 0.12-0.16i))
3477
3478     (pass-if "(/ 4+3i)"
3479       (= (/ 4+3i) 0.16-0.12i))
3480
3481     (pass-if "(/ 1e200+1e200i)"
3482       (= (/ 1e200+1e200i) 5.0e-201-5.0e-201i)))
3483
3484   (with-test-prefix "inum/complex"
3485
3486     (pass-if "(/ 25 3+4i)"
3487       (= (/ 25 3+4i) 3.0-4.0i))
3488
3489     (pass-if "(/ 25 4+3i)"
3490       (= (/ 25 4+3i) 4.0-3.0i)))
3491
3492   (with-test-prefix "complex/complex"
3493
3494     (pass-if "(/ 25+125i 3+4i)"
3495       (= (/ 25+125i 3+4i) 23.0+11.0i))
3496
3497     (pass-if "(/ 25+125i 4+3i)"
3498       (= (/ 25+125i 4+3i) 19.0+17.0i))))
3499
3500 ;;;
3501 ;;; floor
3502 ;;;
3503
3504 (with-test-prefix "floor"
3505   (pass-if (=  1 (floor  1.75)))
3506   (pass-if (=  1 (floor  1.5)))
3507   (pass-if (=  1 (floor  1.25)))
3508   (pass-if (=  0 (floor  0.75)))
3509   (pass-if (=  0 (floor  0.5)))
3510   (pass-if (=  0 (floor  0.0)))
3511   (pass-if (= -1 (floor -0.5)))
3512   (pass-if (= -2 (floor -1.25)))
3513   (pass-if (= -2 (floor -1.5)))
3514
3515   (with-test-prefix "inum"
3516     (pass-if "0"
3517       (and (= 0    (floor 0))
3518            (exact? (floor 0))))
3519
3520     (pass-if "1"
3521       (and (= 1    (floor 1))
3522            (exact? (floor 1))))
3523
3524     (pass-if "-1"
3525       (and (= -1   (floor -1))
3526            (exact? (floor -1)))))
3527
3528   (with-test-prefix "bignum"
3529     (let ((x (1+ most-positive-fixnum)))
3530       (pass-if "(1+ most-positive-fixnum)"
3531         (and (= x    (floor x))
3532              (exact? (floor x)))))
3533
3534     (let ((x (1- most-negative-fixnum)))
3535       (pass-if "(1- most-negative-fixnum)"
3536         (and (= x    (floor x))
3537              (exact? (floor x))))))
3538
3539   (with-test-prefix "frac"
3540     (define (=exact x y)
3541       (and (= x y)
3542            (exact? y)))
3543
3544     (pass-if (=exact -3 (floor -7/3)))
3545     (pass-if (=exact -2 (floor -5/3)))
3546     (pass-if (=exact -2 (floor -4/3)))
3547     (pass-if (=exact -1 (floor -2/3)))
3548     (pass-if (=exact -1 (floor -1/3)))
3549     (pass-if (=exact  0 (floor  1/3)))
3550     (pass-if (=exact  0 (floor  2/3)))
3551     (pass-if (=exact  1 (floor  4/3)))
3552     (pass-if (=exact  1 (floor  5/3)))
3553     (pass-if (=exact  2 (floor  7/3)))
3554
3555     (pass-if (=exact -3 (floor -17/6)))
3556     (pass-if (=exact -3 (floor -16/6)))
3557     (pass-if (=exact -3 (floor -15/6)))
3558     (pass-if (=exact -3 (floor -14/6)))
3559     (pass-if (=exact -3 (floor -13/6)))
3560     (pass-if (=exact -2 (floor -11/6)))
3561     (pass-if (=exact -2 (floor -10/6)))
3562     (pass-if (=exact -2 (floor  -9/6)))
3563     (pass-if (=exact -2 (floor  -8/6)))
3564     (pass-if (=exact -2 (floor  -7/6)))
3565     (pass-if (=exact -1 (floor  -5/6)))
3566     (pass-if (=exact -1 (floor  -4/6)))
3567     (pass-if (=exact -1 (floor  -3/6)))
3568     (pass-if (=exact -1 (floor  -2/6)))
3569     (pass-if (=exact -1 (floor  -1/6)))
3570     (pass-if (=exact  0 (floor   1/6)))
3571     (pass-if (=exact  0 (floor   2/6)))
3572     (pass-if (=exact  0 (floor   3/6)))
3573     (pass-if (=exact  0 (floor   4/6)))
3574     (pass-if (=exact  0 (floor   5/6)))
3575     (pass-if (=exact  1 (floor   7/6)))
3576     (pass-if (=exact  1 (floor   8/6)))
3577     (pass-if (=exact  1 (floor   9/6)))
3578     (pass-if (=exact  1 (floor  10/6)))
3579     (pass-if (=exact  1 (floor  11/6)))
3580     (pass-if (=exact  2 (floor  13/6)))
3581     (pass-if (=exact  2 (floor  14/6)))
3582     (pass-if (=exact  2 (floor  15/6)))
3583     (pass-if (=exact  2 (floor  16/6)))
3584     (pass-if (=exact  2 (floor  17/6))))
3585
3586   (with-test-prefix "real"
3587     (pass-if "0.0"
3588       (and (= 0.0    (floor 0.0))
3589            (inexact? (floor 0.0))))
3590
3591     (pass-if "1.0"
3592       (and (= 1.0    (floor 1.0))
3593            (inexact? (floor 1.0))))
3594
3595     (pass-if "-1.0"
3596       (and (= -1.0   (floor -1.0))
3597            (inexact? (floor -1.0))))
3598
3599     (pass-if "-3.1"
3600       (and (= -4.0   (floor -3.1))
3601            (inexact? (floor -3.1))))
3602
3603     (pass-if "3.1"
3604       (and (= 3.0    (floor 3.1))
3605            (inexact? (floor 3.1))))
3606
3607     (pass-if "3.9"
3608       (and (= 3.0    (floor 3.9))
3609            (inexact? (floor 3.9))))
3610
3611     (pass-if "-3.9"
3612       (and (= -4.0   (floor -3.9))
3613            (inexact? (floor -3.9))))
3614
3615     (pass-if "1.5"
3616       (and (= 1.0    (floor 1.5))
3617            (inexact? (floor 1.5))))
3618
3619     (pass-if "2.5"
3620       (and (= 2.0    (floor 2.5))
3621            (inexact? (floor 2.5))))
3622
3623     (pass-if "3.5"
3624       (and (= 3.0    (floor 3.5))
3625            (inexact? (floor 3.5))))
3626
3627     (pass-if "-1.5"
3628       (and (= -2.0   (floor -1.5))
3629            (inexact? (floor -1.5))))
3630
3631     (pass-if "-2.5"
3632       (and (= -3.0   (floor -2.5))
3633            (inexact? (floor -2.5))))
3634
3635     (pass-if "-3.5"
3636       (and (= -4.0   (floor -3.5))
3637            (inexact? (floor -3.5))))))
3638
3639 ;;;
3640 ;;; ceiling
3641 ;;;
3642
3643 (with-test-prefix "ceiling"
3644   (pass-if (=  2 (ceiling  1.75)))
3645   (pass-if (=  2 (ceiling  1.5)))
3646   (pass-if (=  2 (ceiling  1.25)))
3647   (pass-if (=  1 (ceiling  0.75)))
3648   (pass-if (=  1 (ceiling  0.5)))
3649   (pass-if (=  0 (ceiling  0.0)))
3650   (pass-if (=  0 (ceiling -0.5)))
3651   (pass-if (= -1 (ceiling -1.25)))
3652   (pass-if (= -1 (ceiling -1.5)))
3653
3654   (with-test-prefix "inum"
3655     (pass-if "0"
3656       (and (= 0    (ceiling 0))
3657            (exact? (ceiling 0))))
3658
3659     (pass-if "1"
3660       (and (= 1    (ceiling 1))
3661            (exact? (ceiling 1))))
3662
3663     (pass-if "-1"
3664       (and (= -1   (ceiling -1))
3665            (exact? (ceiling -1)))))
3666
3667   (with-test-prefix "bignum"
3668     (let ((x (1+ most-positive-fixnum)))
3669       (pass-if "(1+ most-positive-fixnum)"
3670         (and (= x    (ceiling x))
3671              (exact? (ceiling x)))))
3672
3673     (let ((x (1- most-negative-fixnum)))
3674       (pass-if "(1- most-negative-fixnum)"
3675         (and (= x    (ceiling x))
3676              (exact? (ceiling x))))))
3677
3678   (with-test-prefix "frac"
3679     (define (=exact x y)
3680       (and (= x y)
3681            (exact? y)))
3682
3683     (pass-if (=exact -2 (ceiling -7/3)))
3684     (pass-if (=exact -1 (ceiling -5/3)))
3685     (pass-if (=exact -1 (ceiling -4/3)))
3686     (pass-if (=exact  0 (ceiling -2/3)))
3687     (pass-if (=exact  0 (ceiling -1/3)))
3688     (pass-if (=exact  1 (ceiling  1/3)))
3689     (pass-if (=exact  1 (ceiling  2/3)))
3690     (pass-if (=exact  2 (ceiling  4/3)))
3691     (pass-if (=exact  2 (ceiling  5/3)))
3692     (pass-if (=exact  3 (ceiling  7/3)))
3693
3694     (pass-if (=exact -2 (ceiling -17/6)))
3695     (pass-if (=exact -2 (ceiling -16/6)))
3696     (pass-if (=exact -2 (ceiling -15/6)))
3697     (pass-if (=exact -2 (ceiling -14/6)))
3698     (pass-if (=exact -2 (ceiling -13/6)))
3699     (pass-if (=exact -1 (ceiling -11/6)))
3700     (pass-if (=exact -1 (ceiling -10/6)))
3701     (pass-if (=exact -1 (ceiling  -9/6)))
3702     (pass-if (=exact -1 (ceiling  -8/6)))
3703     (pass-if (=exact -1 (ceiling  -7/6)))
3704     (pass-if (=exact  0 (ceiling  -5/6)))
3705     (pass-if (=exact  0 (ceiling  -4/6)))
3706     (pass-if (=exact  0 (ceiling  -3/6)))
3707     (pass-if (=exact  0 (ceiling  -2/6)))
3708     (pass-if (=exact  0 (ceiling  -1/6)))
3709     (pass-if (=exact  1 (ceiling   1/6)))
3710     (pass-if (=exact  1 (ceiling   2/6)))
3711     (pass-if (=exact  1 (ceiling   3/6)))
3712     (pass-if (=exact  1 (ceiling   4/6)))
3713     (pass-if (=exact  1 (ceiling   5/6)))
3714     (pass-if (=exact  2 (ceiling   7/6)))
3715     (pass-if (=exact  2 (ceiling   8/6)))
3716     (pass-if (=exact  2 (ceiling   9/6)))
3717     (pass-if (=exact  2 (ceiling  10/6)))
3718     (pass-if (=exact  2 (ceiling  11/6)))
3719     (pass-if (=exact  3 (ceiling  13/6)))
3720     (pass-if (=exact  3 (ceiling  14/6)))
3721     (pass-if (=exact  3 (ceiling  15/6)))
3722     (pass-if (=exact  3 (ceiling  16/6)))
3723     (pass-if (=exact  3 (ceiling  17/6))))
3724
3725   (with-test-prefix "real"
3726     (pass-if "0.0"
3727       (and (= 0.0    (ceiling 0.0))
3728            (inexact? (ceiling 0.0))))
3729
3730     (pass-if "1.0"
3731       (and (= 1.0    (ceiling 1.0))
3732            (inexact? (ceiling 1.0))))
3733
3734     (pass-if "-1.0"
3735       (and (= -1.0   (ceiling -1.0))
3736            (inexact? (ceiling -1.0))))
3737
3738     (pass-if "-3.1"
3739       (and (= -3.0   (ceiling -3.1))
3740            (inexact? (ceiling -3.1))))
3741
3742     (pass-if "3.1"
3743       (and (= 4.0    (ceiling 3.1))
3744            (inexact? (ceiling 3.1))))
3745
3746     (pass-if "3.9"
3747       (and (= 4.0    (ceiling 3.9))
3748            (inexact? (ceiling 3.9))))
3749
3750     (pass-if "-3.9"
3751       (and (= -3.0   (ceiling -3.9))
3752            (inexact? (ceiling -3.9))))
3753
3754     (pass-if "1.5"
3755       (and (= 2.0    (ceiling 1.5))
3756            (inexact? (ceiling 1.5))))
3757
3758     (pass-if "2.5"
3759       (and (= 3.0    (ceiling 2.5))
3760            (inexact? (ceiling 2.5))))
3761
3762     (pass-if "3.5"
3763       (and (= 4.0    (ceiling 3.5))
3764            (inexact? (ceiling 3.5))))
3765
3766     (pass-if "-1.5"
3767       (and (= -1.0   (ceiling -1.5))
3768            (inexact? (ceiling -1.5))))
3769
3770     (pass-if "-2.5"
3771       (and (= -2.0   (ceiling -2.5))
3772            (inexact? (ceiling -2.5))))
3773
3774     (pass-if "-3.5"
3775       (and (= -3.0   (ceiling -3.5))
3776            (inexact? (ceiling -3.5))))))
3777
3778 ;;;
3779 ;;; truncate
3780 ;;;
3781
3782 (with-test-prefix "truncate"
3783   (pass-if (=  1 (truncate  1.75)))
3784   (pass-if (=  1 (truncate  1.5)))
3785   (pass-if (=  1 (truncate  1.25)))
3786   (pass-if (=  0 (truncate  0.75)))
3787   (pass-if (=  0 (truncate  0.5)))
3788   (pass-if (=  0 (truncate  0.0)))
3789   (pass-if (=  0 (truncate -0.5)))
3790   (pass-if (= -1 (truncate -1.25)))
3791   (pass-if (= -1 (truncate -1.5)))
3792
3793   (with-test-prefix "inum"
3794     (pass-if "0"
3795       (and (= 0    (truncate 0))
3796            (exact? (truncate 0))))
3797
3798     (pass-if "1"
3799       (and (= 1    (truncate 1))
3800            (exact? (truncate 1))))
3801
3802     (pass-if "-1"
3803       (and (= -1   (truncate -1))
3804            (exact? (truncate -1)))))
3805
3806   (with-test-prefix "bignum"
3807     (let ((x (1+ most-positive-fixnum)))
3808       (pass-if "(1+ most-positive-fixnum)"
3809         (and (= x    (truncate x))
3810              (exact? (truncate x)))))
3811
3812     (let ((x (1- most-negative-fixnum)))
3813       (pass-if "(1- most-negative-fixnum)"
3814         (and (= x    (truncate x))
3815              (exact? (truncate x))))))
3816
3817   (with-test-prefix "frac"
3818     (define (=exact x y)
3819       (and (= x y)
3820            (exact? y)))
3821
3822     (pass-if (=exact -2 (truncate -7/3)))
3823     (pass-if (=exact -1 (truncate -5/3)))
3824     (pass-if (=exact -1 (truncate -4/3)))
3825     (pass-if (=exact  0 (truncate -2/3)))
3826     (pass-if (=exact  0 (truncate -1/3)))
3827     (pass-if (=exact  0 (truncate  1/3)))
3828     (pass-if (=exact  0 (truncate  2/3)))
3829     (pass-if (=exact  1 (truncate  4/3)))
3830     (pass-if (=exact  1 (truncate  5/3)))
3831     (pass-if (=exact  2 (truncate  7/3)))
3832
3833     (pass-if (=exact -2 (truncate -17/6)))
3834     (pass-if (=exact -2 (truncate -16/6)))
3835     (pass-if (=exact -2 (truncate -15/6)))
3836     (pass-if (=exact -2 (truncate -14/6)))
3837     (pass-if (=exact -2 (truncate -13/6)))
3838     (pass-if (=exact -1 (truncate -11/6)))
3839     (pass-if (=exact -1 (truncate -10/6)))
3840     (pass-if (=exact -1 (truncate  -9/6)))
3841     (pass-if (=exact -1 (truncate  -8/6)))
3842     (pass-if (=exact -1 (truncate  -7/6)))
3843     (pass-if (=exact  0 (truncate  -5/6)))
3844     (pass-if (=exact  0 (truncate  -4/6)))
3845     (pass-if (=exact  0 (truncate  -3/6)))
3846     (pass-if (=exact  0 (truncate  -2/6)))
3847     (pass-if (=exact  0 (truncate  -1/6)))
3848     (pass-if (=exact  0 (truncate   1/6)))
3849     (pass-if (=exact  0 (truncate   2/6)))
3850     (pass-if (=exact  0 (truncate   3/6)))
3851     (pass-if (=exact  0 (truncate   4/6)))
3852     (pass-if (=exact  0 (truncate   5/6)))
3853     (pass-if (=exact  1 (truncate   7/6)))
3854     (pass-if (=exact  1 (truncate   8/6)))
3855     (pass-if (=exact  1 (truncate   9/6)))
3856     (pass-if (=exact  1 (truncate  10/6)))
3857     (pass-if (=exact  1 (truncate  11/6)))
3858     (pass-if (=exact  2 (truncate  13/6)))
3859     (pass-if (=exact  2 (truncate  14/6)))
3860     (pass-if (=exact  2 (truncate  15/6)))
3861     (pass-if (=exact  2 (truncate  16/6)))
3862     (pass-if (=exact  2 (truncate  17/6))))
3863
3864   (with-test-prefix "real"
3865     (pass-if "0.0"
3866       (and (= 0.0    (truncate 0.0))
3867            (inexact? (truncate 0.0))))
3868
3869     (pass-if "1.0"
3870       (and (= 1.0    (truncate 1.0))
3871            (inexact? (truncate 1.0))))
3872
3873     (pass-if "-1.0"
3874       (and (= -1.0   (truncate -1.0))
3875            (inexact? (truncate -1.0))))
3876
3877     (pass-if "-3.1"
3878       (and (= -3.0   (truncate -3.1))
3879            (inexact? (truncate -3.1))))
3880
3881     (pass-if "3.1"
3882       (and (= 3.0    (truncate 3.1))
3883            (inexact? (truncate 3.1))))
3884
3885     (pass-if "3.9"
3886       (and (= 3.0    (truncate 3.9))
3887            (inexact? (truncate 3.9))))
3888
3889     (pass-if "-3.9"
3890       (and (= -3.0   (truncate -3.9))
3891            (inexact? (truncate -3.9))))
3892
3893     (pass-if "1.5"
3894       (and (= 1.0    (truncate 1.5))
3895            (inexact? (truncate 1.5))))
3896
3897     (pass-if "2.5"
3898       (and (= 2.0    (truncate 2.5))
3899            (inexact? (truncate 2.5))))
3900
3901     (pass-if "3.5"
3902       (and (= 3.0    (truncate 3.5))
3903            (inexact? (truncate 3.5))))
3904
3905     (pass-if "-1.5"
3906       (and (= -1.0   (truncate -1.5))
3907            (inexact? (truncate -1.5))))
3908
3909     (pass-if "-2.5"
3910       (and (= -2.0   (truncate -2.5))
3911            (inexact? (truncate -2.5))))
3912
3913     (pass-if "-3.5"
3914       (and (= -3.0   (truncate -3.5))
3915            (inexact? (truncate -3.5))))))
3916
3917 ;;;
3918 ;;; round
3919 ;;;
3920
3921 (with-test-prefix "round"
3922   (pass-if (=  2 (round  1.75)))
3923   (pass-if (=  2 (round  1.5)))
3924   (pass-if (=  1 (round  1.25)))
3925   (pass-if (=  1 (round  0.75)))
3926   (pass-if (=  0 (round  0.5)))
3927   (pass-if (=  0 (round  0.0)))
3928   (pass-if (=  0 (round -0.5)))
3929   (pass-if (= -1 (round -1.25)))
3930   (pass-if (= -2 (round -1.5)))
3931
3932   (with-test-prefix "inum"
3933     (pass-if "0"
3934       (and (= 0    (round 0))
3935            (exact? (round 0))))
3936
3937     (pass-if "1"
3938       (and (= 1    (round 1))
3939            (exact? (round 1))))
3940
3941     (pass-if "-1"
3942       (and (= -1   (round -1))
3943            (exact? (round -1)))))
3944
3945   (with-test-prefix "bignum"
3946     (let ((x (1+ most-positive-fixnum)))
3947       (pass-if "(1+ most-positive-fixnum)"
3948         (and (= x    (round x))
3949              (exact? (round x)))))
3950
3951     (let ((x (1- most-negative-fixnum)))
3952       (pass-if "(1- most-negative-fixnum)"
3953         (and (= x    (round x))
3954              (exact? (round x))))))
3955
3956   (with-test-prefix "frac"
3957     (define (=exact x y)
3958       (and (= x y)
3959            (exact? y)))
3960
3961     (pass-if (=exact -2 (round -7/3)))
3962     (pass-if (=exact -2 (round -5/3)))
3963     (pass-if (=exact -1 (round -4/3)))
3964     (pass-if (=exact -1 (round -2/3)))
3965     (pass-if (=exact  0 (round -1/3)))
3966     (pass-if (=exact  0 (round  1/3)))
3967     (pass-if (=exact  1 (round  2/3)))
3968     (pass-if (=exact  1 (round  4/3)))
3969     (pass-if (=exact  2 (round  5/3)))
3970     (pass-if (=exact  2 (round  7/3)))
3971
3972     (pass-if (=exact -3 (round -17/6)))
3973     (pass-if (=exact -3 (round -16/6)))
3974     (pass-if (=exact -2 (round -15/6)))
3975     (pass-if (=exact -2 (round -14/6)))
3976     (pass-if (=exact -2 (round -13/6)))
3977     (pass-if (=exact -2 (round -11/6)))
3978     (pass-if (=exact -2 (round -10/6)))
3979     (pass-if (=exact -2 (round  -9/6)))
3980     (pass-if (=exact -1 (round  -8/6)))
3981     (pass-if (=exact -1 (round  -7/6)))
3982     (pass-if (=exact -1 (round  -5/6)))
3983     (pass-if (=exact -1 (round  -4/6)))
3984     (pass-if (=exact  0 (round  -3/6)))
3985     (pass-if (=exact  0 (round  -2/6)))
3986     (pass-if (=exact  0 (round  -1/6)))
3987     (pass-if (=exact  0 (round   1/6)))
3988     (pass-if (=exact  0 (round   2/6)))
3989     (pass-if (=exact  0 (round   3/6)))
3990     (pass-if (=exact  1 (round   4/6)))
3991     (pass-if (=exact  1 (round   5/6)))
3992     (pass-if (=exact  1 (round   7/6)))
3993     (pass-if (=exact  1 (round   8/6)))
3994     (pass-if (=exact  2 (round   9/6)))
3995     (pass-if (=exact  2 (round  10/6)))
3996     (pass-if (=exact  2 (round  11/6)))
3997     (pass-if (=exact  2 (round  13/6)))
3998     (pass-if (=exact  2 (round  14/6)))
3999     (pass-if (=exact  2 (round  15/6)))
4000     (pass-if (=exact  3 (round  16/6)))
4001     (pass-if (=exact  3 (round  17/6))))
4002
4003   (with-test-prefix "real"
4004     (pass-if "0.0"
4005       (and (= 0.0    (round 0.0))
4006            (inexact? (round 0.0))))
4007
4008     (pass-if "1.0"
4009       (and (= 1.0    (round 1.0))
4010            (inexact? (round 1.0))))
4011
4012     (pass-if "-1.0"
4013       (and (= -1.0   (round -1.0))
4014            (inexact? (round -1.0))))
4015
4016     (pass-if "-3.1"
4017       (and (= -3.0   (round -3.1))
4018            (inexact? (round -3.1))))
4019
4020     (pass-if "3.1"
4021       (and (= 3.0    (round 3.1))
4022            (inexact? (round 3.1))))
4023
4024     (pass-if "3.9"
4025       (and (= 4.0    (round 3.9))
4026            (inexact? (round 3.9))))
4027
4028     (pass-if "-3.9"
4029       (and (= -4.0   (round -3.9))
4030            (inexact? (round -3.9))))
4031
4032     (pass-if "1.5"
4033       (and (= 2.0    (round 1.5))
4034            (inexact? (round 1.5))))
4035
4036     (pass-if "2.5"
4037       (and (= 2.0    (round 2.5))
4038            (inexact? (round 2.5))))
4039
4040     (pass-if "3.5"
4041       (and (= 4.0    (round 3.5))
4042            (inexact? (round 3.5))))
4043
4044     (pass-if "-1.5"
4045       (and (= -2.0   (round -1.5))
4046            (inexact? (round -1.5))))
4047
4048     (pass-if "-2.5"
4049       (and (= -2.0   (round -2.5))
4050            (inexact? (round -2.5))))
4051
4052     (pass-if "-3.5"
4053       (and (= -4.0   (round -3.5))
4054            (inexact? (round -3.5))))
4055
4056     ;; prior to guile 1.6.5, on an IEEE system an inexact 2^53-1 (ie. a
4057     ;; float with mantissa all ones) came out as 2^53 from `round' (except
4058     ;; on i386 and m68k systems using the coprocessor and optimizing, where
4059     ;; extra precision hid the problem)
4060     (pass-if "2^53-1"
4061       (let ((x (exact->inexact (1- (ash 1 53)))))
4062         (and (= x      (round x))
4063              (inexact? (round x)))))
4064     (pass-if "-(2^53-1)"
4065       (let ((x (exact->inexact (- (1- (ash 1 53))))))
4066         (and (= x      (round x))
4067              (inexact? (round x)))))))
4068
4069 ;;;
4070 ;;; exact->inexact
4071 ;;;
4072
4073 (with-test-prefix "exact->inexact"
4074
4075   ;; Test "(exact->inexact n)", expect "want".
4076   (define (test name n want)
4077     (with-test-prefix name
4078       (pass-if-equal "pos" want (exact->inexact n))
4079       (pass-if-equal "neg" (- want) (exact->inexact (- n)))))
4080
4081   ;; Test "(exact->inexact n)", expect "want".
4082   ;; "i" is a index, for diagnostic purposes.
4083   (define (try-i i n want)
4084     (test (list i n want) n want))
4085
4086   (with-test-prefix "2^i, no round"
4087     (do ((i    0   (1+ i))
4088          (n    1   (* 2 n))
4089          (want 1.0 (* 2.0 want)))
4090         ((> i 100))
4091       (try-i i n want)))
4092
4093   (with-test-prefix "2^i+1, no round"
4094     (do ((i    1   (1+ i))
4095          (n    3   (1- (* 2 n)))
4096          (want 3.0 (- (* 2.0 want) 1.0)))
4097         ((>= i dbl-mant-dig))
4098       (try-i i n want)))
4099
4100   (with-test-prefix "(2^i+1)*2^100, no round"
4101     (do ((i    1   (1+ i))
4102          (n    3   (1- (* 2 n)))
4103          (want 3.0 (- (* 2.0 want) 1.0)))
4104         ((>= i dbl-mant-dig))
4105       (try-i i (ash n 100) (ash-flo want 100))))
4106
4107   ;; bit pattern: 1111....11100.00
4108   ;;              <-mantdig-><-i->
4109   ;;
4110   (with-test-prefix "mantdig ones then zeros, no rounding"
4111     (do ((i    0  (1+ i))
4112          (n    (- (ash     1   dbl-mant-dig) 1)   (* 2 n))
4113          (want (- (ash-flo 1.0 dbl-mant-dig) 1.0) (* 2.0 want)))
4114         ((> i 100))
4115       (try-i i n want)))
4116
4117   ;; bit pattern: 1111....111011..1
4118   ;;              <-mantdig-> <-i->
4119   ;; This sort of value was incorrectly rounded upwards in Guile 1.6.4 when
4120   ;; i >= 11 (that's when the total is 65 or more bits).
4121   ;;
4122   (with-test-prefix "mantdig ones then 011..11, round down"
4123     (do ((i    0  (1+ i))
4124          (n    (- (ash     1   (+ 1 dbl-mant-dig)) 2)   (+ 1 (* 2 n)))
4125          (want (- (ash-flo 1.0 (+ 1 dbl-mant-dig)) 2.0) (* 2.0 want)))
4126         ((> i 100))
4127       (try-i i n want)))
4128
4129   ;; bit pattern: 1111....111100..001
4130   ;;              <-mantdig-> <--i->
4131   ;;
4132   (with-test-prefix "mantdig ones then 100..001, round up"
4133     (do ((i    0  (1+ i))
4134          (n    (- (ash     1   (+ 2 dbl-mant-dig)) 1)  (1- (* 2 n)))
4135          (want    (ash-flo 1.0 (+ 2 dbl-mant-dig))     (* 2.0 want)))
4136         ((> i 100))
4137       (try-i i n want)))
4138
4139   ;; bit pattern: 1000....000100..001
4140   ;;              <-mantdig-> <--i->
4141   ;;
4142   (with-test-prefix "2^mantdig then 100..001, round up"
4143     (do ((i    0  (1+ i))
4144          (n    (- (ash     1   (+ 2 dbl-mant-dig)) 1)   (1- (* 2 n)))
4145          (want (+ (ash-flo 1.0 (+ 2 dbl-mant-dig)) 4.0) (* 2.0 want)))
4146         ((> i 100))
4147       (try-i i n want)))
4148
4149   (pass-if "frac big/big"
4150     (let ((big (ash 1 256)))
4151       (= 1.0 (exact->inexact (/ (1+ big) big)))))
4152
4153   ;; In guile 1.8.0 this failed, giving back "nan" because it tried to
4154   ;; convert the num and den to doubles, resulting in infs.
4155   (pass-if "frac big/big, exceeding double"
4156     (let ((big (ash 1 4096)))
4157       (= 1.0 (exact->inexact (/ (1+ big) big)))))
4158
4159   ;; In guile 2.0.9, 'exact->inexact' guaranteed proper rounding when
4160   ;; applied to non-negative fractions, but on 64-bit systems would
4161   ;; sometimes double-round when applied to negative fractions,
4162   ;; specifically when the numerator was a fixnum not exactly
4163   ;; representable as a double.
4164   (with-test-prefix "frac inum/inum, numerator not exactly representable as a double"
4165     (let ((n (+ 1 (expt 2 dbl-mant-dig))))
4166       (for-each (lambda (d)
4167                   (test (/ n d)
4168                         (/ n d)
4169                         (exact->inexact (/ n d))))
4170                 '(3 5 6 7 9 11 13 17 19 23 0.0 -0.0 +nan.0 +inf.0 -inf.0))))
4171
4172   (test "round up to odd"
4173         ;; =====================================================
4174         ;; 11111111111111111111111111111111111111111111111111000101 ->
4175         ;; 11111111111111111111111111111111111111111111111111001000
4176         (+ (expt 2   (+ dbl-mant-dig 3)) -64 #b000101)
4177         (+ (expt 2.0 (+ dbl-mant-dig 3)) -64 #b001000))
4178
4179   (test "round down to odd"
4180         ;; =====================================================
4181         ;; 11111111111111111111111111111111111111111111111111001011 ->
4182         ;; 11111111111111111111111111111111111111111111111111001000
4183         (+ (expt 2   (+ dbl-mant-dig 3)) -64 #b001011)
4184         (+ (expt 2.0 (+ dbl-mant-dig 3)) -64 #b001000))
4185
4186   (test "round tie up to even"
4187         ;; =====================================================
4188         ;; 11111111111111111111111111111111111111111111111111011100 ->
4189         ;; 11111111111111111111111111111111111111111111111111100000
4190         (+ (expt 2   (+ dbl-mant-dig 3)) -64 #b011100)
4191         (+ (expt 2.0 (+ dbl-mant-dig 3)) -64 #b100000))
4192
4193   (test "round tie down to even"
4194         ;; =====================================================
4195         ;; 11111111111111111111111111111111111111111111111111000100 ->
4196         ;; 11111111111111111111111111111111111111111111111111000000
4197         (+ (expt 2   (+ dbl-mant-dig 3)) -64 #b000100)
4198         (+ (expt 2.0 (+ dbl-mant-dig 3)) -64 #b000000))
4199
4200   (test "round tie up to next power of two"
4201         ;;  =====================================================
4202         ;;  11111111111111111111111111111111111111111111111111111100 ->
4203         ;; 100000000000000000000000000000000000000000000000000000000
4204         (+ (expt 2 (+ dbl-mant-dig 3)) -64 #b111100)
4205         (expt 2.0 (+ dbl-mant-dig 3)))
4206
4207   (test "miniscule value rounds to zero of appropriate sign"
4208         (expt 17 (- dbl-min-exp dbl-mant-dig))
4209         0.0)
4210
4211   (test "smallest inexact"
4212         (expt 2 (- dbl-min-exp dbl-mant-dig))
4213         (expt 2.0 (- dbl-min-exp dbl-mant-dig)))
4214
4215   (test "1/2 smallest inexact rounds down to zero"
4216         (* 1/2 (expt 2 (- dbl-min-exp dbl-mant-dig)))
4217         0.0)
4218
4219   (test "just over 1/2 smallest inexact rounds up"
4220         (+ (* 1/2 (expt 2 (- dbl-min-exp dbl-mant-dig)))
4221            (expt 7 (- dbl-min-exp dbl-mant-dig)))
4222         (expt 2.0 (- dbl-min-exp dbl-mant-dig)))
4223
4224   (test "3/2 smallest inexact rounds up to twice smallest inexact"
4225         (* 3/2 (expt 2 (- dbl-min-exp dbl-mant-dig)))
4226         (* 2.0 (expt 2.0 (- dbl-min-exp dbl-mant-dig))))
4227
4228   (test "just under 3/2 smallest inexact rounds down"
4229         (- (* 3/2 (expt 2 (- dbl-min-exp dbl-mant-dig)))
4230            (expt 11 (- dbl-min-exp dbl-mant-dig)))
4231         (expt 2.0 (- dbl-min-exp dbl-mant-dig)))
4232
4233   (test "5/2 smallest inexact rounds down to twice smallest inexact"
4234         (* 5/2 (expt 2 (- dbl-min-exp dbl-mant-dig)))
4235         (* 2.0 (expt 2.0 (- dbl-min-exp dbl-mant-dig))))
4236
4237   (test "just over 5/2 smallest inexact rounds up"
4238         (+ (* 5/2 (expt 2 (- dbl-min-exp dbl-mant-dig)))
4239            (expt 13 (- dbl-min-exp dbl-mant-dig)))
4240         (* 3.0 (expt 2.0 (- dbl-min-exp dbl-mant-dig))))
4241
4242   (test "one plus dbl-epsilon"
4243         (+ 1 dbl-epsilon-exact)
4244         (+ 1.0 dbl-epsilon))
4245
4246   (test "one plus 1/2 dbl-epsilon rounds down to 1.0"
4247         (+ 1 (* 1/2 dbl-epsilon-exact))
4248         1.0)
4249
4250   (test "just over one plus 1/2 dbl-epsilon rounds up"
4251         (+ 1
4252            (* 1/2 dbl-epsilon-exact)
4253            (expt 13 (- dbl-min-exp dbl-mant-dig)))
4254         (+ 1.0 dbl-epsilon))
4255
4256   (test "one plus 3/2 dbl-epsilon rounds up"
4257         (+ 1 (* 3/2 dbl-epsilon-exact))
4258         (+ 1.0 (* 2.0 dbl-epsilon)))
4259
4260   (test "just under one plus 3/2 dbl-epsilon rounds down"
4261         (+ 1
4262            (* 3/2 dbl-epsilon-exact)
4263            (- (expt 17 (- dbl-min-exp dbl-mant-dig))))
4264         (+ 1.0 dbl-epsilon))
4265
4266   (test "one plus 5/2 dbl-epsilon rounds down"
4267         (+ 1 (* 5/2 dbl-epsilon-exact))
4268         (+ 1.0 (* 2.0 dbl-epsilon)))
4269
4270   (test "just over one plus 5/2 dbl-epsilon rounds up"
4271         (+ 1
4272            (* 5/2 dbl-epsilon-exact)
4273            (expt 13 (- dbl-min-exp dbl-mant-dig)))
4274         (+ 1.0 (* 3.0 dbl-epsilon)))
4275
4276   (test "largest finite inexact"
4277         (* (- (expt 2 dbl-mant-dig) 1)
4278            (expt 2 (- dbl-max-exp dbl-mant-dig)))
4279         (* (- (expt 2.0 dbl-mant-dig) 1)
4280            (expt 2.0 (- dbl-max-exp dbl-mant-dig))))
4281
4282   (test "largest finite inexact plus 1/2 epsilon rounds up to infinity"
4283         (* (+ (expt 2 dbl-mant-dig) -1 1/2)
4284            (expt 2 (- dbl-max-exp dbl-mant-dig)))
4285         (inf))
4286
4287   (test "largest finite inexact plus just under 1/2 epsilon rounds down"
4288         (* (+ (expt 2 dbl-mant-dig) -1 1/2
4289               (- (expt 13 (- dbl-min-exp dbl-mant-dig))))
4290            (expt 2 (- dbl-max-exp dbl-mant-dig)))
4291         (* (- (expt 2.0 dbl-mant-dig) 1)
4292            (expt 2.0 (- dbl-max-exp dbl-mant-dig))))
4293
4294   (test "1/2 largest finite inexact"
4295         (* (- (expt 2 dbl-mant-dig) 1)
4296            (expt 2 (- dbl-max-exp dbl-mant-dig 1)))
4297         (* (- (expt 2.0 dbl-mant-dig) 1)
4298            (expt 2.0 (- dbl-max-exp dbl-mant-dig 1))))
4299
4300   (test "1/2 largest finite inexact plus 1/2 epsilon rounds up to next power of two"
4301         (* (+ (expt 2 dbl-mant-dig) -1 1/2)
4302            (expt 2 (- dbl-max-exp dbl-mant-dig 1)))
4303         (expt 2.0 (- dbl-max-exp 1)))
4304
4305   (test "1/2 largest finite inexact plus just over 1/2 epsilon rounds up to next power of two"
4306         (* (+ (expt 2 dbl-mant-dig) -1 1/2
4307               (expt 13 (- dbl-min-exp dbl-mant-dig)))
4308            (expt 2 (- dbl-max-exp dbl-mant-dig 1)))
4309         (expt 2.0 (- dbl-max-exp 1)))
4310
4311   (test "1/2 largest finite inexact plus just under 1/2 epsilon rounds down"
4312         (* (+ (expt 2 dbl-mant-dig) -1 1/2
4313               (- (expt 13 (- dbl-min-exp dbl-mant-dig))))
4314            (expt 2 (- dbl-max-exp dbl-mant-dig 1)))
4315         (* (- (expt 2.0 dbl-mant-dig) 1)
4316            (expt 2.0 (- dbl-max-exp dbl-mant-dig 1))))
4317
4318   )
4319
4320 ;;;
4321 ;;; expt
4322 ;;;
4323
4324 (with-test-prefix "expt"
4325   (pass-if (documented? expt))
4326
4327   ;;
4328   ;; expt no longer requires its first argument to be a scheme number,
4329   ;; for the sake of extensibility, and expt calls integer-expt for
4330   ;; integer powers.  To raise to a positive power, all that is required
4331   ;; is that it can be multiplied using `*'.  For negative powers we
4332   ;; must also be able to find the reciprocal.  If we try to raise #t to
4333   ;; any power other than 0 or 1 it may throw an exception, depending on
4334   ;; whether * has been defined for #t.  However, when raising to the 0
4335   ;; or 1 power, the first argument is not manipulated at all.
4336   ;;
4337   ;; (pass-if-exception "non-numeric base" exception:wrong-type-arg
4338   ;;                    (expt #t 0))
4339   ;;
4340
4341   (pass-if (eqv? 1 (expt 0 0)))
4342   (pass-if (eqv? 1 (expt 0.0 0)))
4343   (pass-if (eqv? 1.0 (expt 0 0.0)))
4344   (pass-if (eqv? 1.0 (expt 0.0 0.0)))
4345   (pass-if (real-nan? (expt 0 -1)))
4346   (pass-if (real-nan? (expt 0 -1.0)))
4347   (pass-if (real-nan? (expt 0.0 -1)))
4348   (pass-if (real-nan? (expt 0.0 -1.0)))
4349   (pass-if (eqv? 0 (expt 0 3)))
4350   (pass-if (= 0 (expt 0 4.0)))
4351   (pass-if (eqv? 0.0 (expt 0.0 5)))
4352   (pass-if (eqv? 0.0 (expt 0.0 6.0)))
4353   (pass-if (eqv? -2742638075.5 (expt -2742638075.5 1)))
4354   (pass-if (eqv? (* -2742638075.5 -2742638075.5)
4355                  (expt -2742638075.5 2)))
4356   (pass-if (eqv? 4.0 (expt -2.0 2.0)))
4357   (pass-if (eqv? -1/8 (expt -2 -3)))
4358   (pass-if (eqv? -0.125 (expt -2.0 -3)))
4359   (pass-if (eqv? -0.125 (expt -2 -3.0)))
4360   (pass-if (eqv? -0.125 (expt -2.0 -3.0)))
4361   (pass-if (eqv? 0.25 (expt 2.0 -2.0)))
4362   (pass-if (eqv? 32/243 (expt 2/3 5)))
4363   (pass-if (eqv? 243/32 (expt 2/3 -5)))
4364   (pass-if (eqv? 32 (expt 1/2 -5)))
4365   (pass-if (test-eqv? (* -1.0+0.0i 12398 12398) (expt +12398i 2.0)))
4366   (pass-if (eqv-loosely? +i (expt -1 0.5)))
4367   (pass-if (eqv-loosely? +i (expt -1 1/2)))
4368   (pass-if (eqv-loosely? 1.0+1.7320508075688i (expt -8 1/3)))
4369   (pass-if (eqv? +inf.0 (expt 2 +inf.0)))
4370   (pass-if (eqv? +inf.0 (expt 2.0 +inf.0)))
4371   (pass-if (eqv? 0.0 (expt 2 -inf.0)))
4372   (pass-if (eqv? 0.0 (expt 2.0 -inf.0))))
4373
4374
4375 ;;;
4376 ;;; sin
4377 ;;;
4378
4379 (with-test-prefix "sin"
4380   (pass-if (eqv? 0   (sin 0)))
4381   (pass-if (eqv? 0.0 (sin 0.0)))
4382   (pass-if (eqv-loosely? 1.0 (sin 1.57)))
4383   (pass-if (eqv-loosely? +1.175i (sin +i)))
4384   (pass-if (real-nan? (sin +nan.0)))
4385   (pass-if (real-nan? (sin +inf.0)))
4386   (pass-if (real-nan? (sin -inf.0))))
4387
4388 ;;;
4389 ;;; cos
4390 ;;;
4391
4392 (with-test-prefix "cos"
4393   (pass-if (eqv? 1   (cos 0)))
4394   (pass-if (eqv? 1.0 (cos 0.0)))
4395   (pass-if (eqv-loosely? 0.0 (cos 1.57)))
4396   (pass-if (eqv-loosely? 1.543 (cos +i)))
4397   (pass-if (real-nan? (cos +nan.0)))
4398   (pass-if (real-nan? (cos +inf.0)))
4399   (pass-if (real-nan? (cos -inf.0))))
4400
4401 ;;;
4402 ;;; tan
4403 ;;;
4404
4405 (with-test-prefix "tan"
4406   (pass-if (eqv? 0   (tan 0)))
4407   (pass-if (eqv? 0.0 (tan 0.0)))
4408   (pass-if (eqv-loosely? 1.0 (tan 0.785)))
4409   (pass-if (eqv-loosely? +0.76i (tan +i)))
4410   (pass-if (real-nan? (tan +nan.0)))
4411   (pass-if (real-nan? (tan +inf.0)))
4412   (pass-if (real-nan? (tan -inf.0))))
4413
4414 ;;;
4415 ;;; asin
4416 ;;;
4417
4418 (with-test-prefix "asin"
4419   (pass-if (complex-nan? (asin +nan.0)))
4420   (pass-if (eqv? 0 (asin 0)))
4421   (pass-if (eqv? 0.0 (asin 0.0))))
4422
4423 ;;;
4424 ;;; acos
4425 ;;;
4426
4427 (with-test-prefix "acos"
4428   (pass-if (complex-nan? (acos +nan.0)))
4429   (pass-if (eqv? 0 (acos 1)))
4430   (pass-if (eqv? 0.0 (acos 1.0))))
4431
4432 ;;;
4433 ;;; atan
4434 ;;;
4435 ;;; FIXME: add tests for two-argument atan
4436 ;;;
4437 (with-test-prefix "atan"
4438   (pass-if (real-nan? (atan +nan.0)))
4439   (pass-if (eqv? 0 (atan 0)))
4440   (pass-if (eqv? 0.0 (atan 0.0)))
4441   (pass-if (eqv-loosely?  1.57 (atan +inf.0)))
4442   (pass-if (eqv-loosely? -1.57 (atan -inf.0))))
4443
4444 ;;;
4445 ;;; sinh
4446 ;;;
4447
4448 (with-test-prefix "sinh"
4449   (pass-if (= 0 (sinh 0)))
4450   (pass-if (= 0.0 (sinh 0.0))))
4451
4452 ;;;
4453 ;;; cosh
4454 ;;;
4455
4456 (with-test-prefix "cosh"
4457   (pass-if (= 1 (cosh 0)))
4458   (pass-if (= 1.0 (cosh 0.0))))
4459
4460 ;;;
4461 ;;; tanh
4462 ;;;
4463
4464 (with-test-prefix "tanh"
4465   (pass-if (= 0 (tanh 0)))
4466   (pass-if (= 0.0 (tanh 0.0))))
4467
4468 ;;;
4469 ;;; asinh
4470 ;;;
4471
4472 (with-test-prefix "asinh"
4473   (pass-if (= 0 (asinh 0)))
4474   (pass-if (= 0.0 (asinh 0.0))))
4475
4476 ;;;
4477 ;;; acosh
4478 ;;;
4479
4480 (with-test-prefix "acosh"
4481   (pass-if (= 0 (acosh 1)))
4482   (pass-if (= 0.0 (acosh 1.0))))
4483
4484 ;;;
4485 ;;; atanh
4486 ;;;
4487
4488 (with-test-prefix "atanh"
4489   (pass-if (= 0 (atanh 0)))
4490   (pass-if (= 0.0 (atanh 0.0))))
4491
4492 ;;;
4493 ;;; make-rectangular
4494 ;;;
4495
4496 (with-test-prefix "make-rectangular"
4497   (pass-if (real?      (make-rectangular 5.0  0  )))
4498   (pass-if (not (real? (make-rectangular 5.0  0.0))))
4499   (pass-if (not (real? (make-rectangular 5.0 -0.0)))))
4500
4501 ;;;
4502 ;;; make-polar
4503 ;;;
4504
4505 (with-test-prefix "make-polar"
4506   (define pi 3.14159265358979323846)
4507   (define (almost= x y)
4508     (> 0.01 (magnitude (- x y))))
4509
4510   (pass-if (real?      (make-polar 0    1.0)))
4511   (pass-if (real?      (make-polar 5.0  0  )))
4512   (pass-if (not (real? (make-polar 5.0  0.0))))
4513   (pass-if (not (real? (make-polar 5.0 -0.0))))
4514
4515   (pass-if (eqv?  0 (make-polar  0 0)))
4516   (pass-if (eqv?  0 (make-polar  0 123.456)))
4517   (pass-if (eqv?  1 (make-polar  1 0)))
4518   (pass-if (eqv? -1 (make-polar -1 0)))
4519
4520   (pass-if (almost= 0+i (make-polar 1 (* 0.5 pi))))
4521   (pass-if (almost= -1  (make-polar 1 (* 1.0 pi))))
4522   (pass-if (almost= 0-i (make-polar 1 (* 1.5 pi))))
4523   (pass-if (almost= 1   (make-polar 1 (* 2.0 pi)))))
4524
4525 ;;;
4526 ;;; real-part
4527 ;;;
4528
4529 (with-test-prefix "real-part"
4530   (pass-if (documented? real-part))
4531   (pass-if (eqv? 5.0 (real-part  5.0)))
4532   (pass-if (eqv? 0.0 (real-part +5.0i)))
4533   (pass-if (eqv? 5   (real-part  5)))
4534   (pass-if (eqv? 1/5 (real-part  1/5)))
4535   (pass-if (eqv? (1+ fixnum-max) (real-part (1+ fixnum-max)))))
4536
4537 ;;;
4538 ;;; imag-part
4539 ;;;
4540
4541 (with-test-prefix "imag-part"
4542   (pass-if (documented? imag-part))
4543   (pass-if (eqv? 0   (imag-part  5.0)))
4544   (pass-if (eqv? 5.0 (imag-part +5.0i)))
4545   (pass-if (eqv? 0   (imag-part  5)))
4546   (pass-if (eqv? 0   (imag-part  1/5)))
4547   (pass-if (eqv? 0   (imag-part (1+ fixnum-max)))))
4548
4549 ;;;
4550 ;;; magnitude
4551 ;;;
4552
4553 (with-test-prefix "magnitude"
4554   (pass-if (documented? magnitude))
4555   (pass-if (= 0 (magnitude 0)))
4556   (pass-if (= 1 (magnitude 1)))
4557   (pass-if (= 1 (magnitude -1)))
4558   (pass-if (= 1 (magnitude 0+i)))
4559   (pass-if (= 1 (magnitude 0-i)))
4560   (pass-if (= 5 (magnitude 3+4i)))
4561   (pass-if (= 5 (magnitude 3-4i)))
4562   (pass-if (= 5 (magnitude -3+4i)))
4563   (pass-if (= 5 (magnitude -3-4i))))
4564
4565 ;;;
4566 ;;; angle
4567 ;;;
4568
4569 (with-test-prefix "angle"
4570   (define pi 3.14159265358979323846)
4571   (define (almost= x y)
4572     (> 0.000001 (magnitude (- x y))))
4573
4574   (pass-if (documented? angle))
4575
4576   (pass-if "inum +ve"   (=        0 (angle 1)))
4577   (pass-if "inum -ve"   (almost= pi (angle -1)))
4578
4579   (pass-if "bignum +ve" (=        0 (angle (1+ fixnum-max))))
4580   (pass-if "bignum -ve" (almost= pi (angle (1- fixnum-min))))
4581
4582   (pass-if "flonum +ve" (=        0 (angle 1.5)))
4583   (pass-if "flonum -ve" (almost= pi (angle -1.5)))
4584
4585   (pass-if "signed zero +ve" (=        0 (angle 0.0)))
4586   (pass-if "signed zero -ve" (almost= pi (angle -0.0))))
4587
4588 ;;;
4589 ;;; inexact->exact
4590 ;;;
4591
4592 (with-test-prefix "inexact->exact"
4593
4594   ;; Test "(inexact->exact f)", expect "want".
4595   (define (test name f want)
4596     (with-test-prefix name
4597       (pass-if-equal "pos" want (inexact->exact f))
4598       (pass-if-equal "neg" (- want) (inexact->exact (- f)))))
4599
4600   (pass-if (documented? inexact->exact))
4601
4602   (pass-if-exception "+inf" exception:out-of-range
4603     (inexact->exact +inf.0))
4604
4605   (pass-if-exception "-inf" exception:out-of-range
4606     (inexact->exact -inf.0))
4607
4608   (pass-if-exception "nan" exception:out-of-range
4609     (inexact->exact +nan.0))
4610
4611   (test "0.0" 0.0 0)
4612   (test "small even integer" 72.0 72)
4613   (test "small odd integer"  73.0 73)
4614
4615   (test "largest inexact odd integer"
4616         (- (expt 2.0 dbl-mant-dig) 1)
4617         (- (expt 2   dbl-mant-dig) 1))
4618
4619   (test "largest inexact odd integer - 1"
4620         (- (expt 2.0 dbl-mant-dig) 2)
4621         (- (expt 2   dbl-mant-dig) 2))
4622
4623   (test "largest inexact odd integer + 3"
4624         (+ (expt 2.0 dbl-mant-dig) 2)
4625         (+ (expt 2   dbl-mant-dig) 2))
4626
4627   (test "largest inexact odd integer * 2^48"
4628         (* (expt 2.0 48) (- (expt 2.0 dbl-mant-dig) 1))
4629         (* (expt 2   48) (- (expt 2   dbl-mant-dig) 1)))
4630
4631   (test "largest inexact odd integer / 2^48"
4632         (* (expt 0.5 48) (- (expt 2.0 dbl-mant-dig) 1))
4633         (* (expt 1/2 48) (- (expt 2   dbl-mant-dig) 1)))
4634
4635   (test "largest finite inexact"
4636         (* (- (expt 2.0 dbl-mant-dig) 1)
4637            (expt 2.0 (- dbl-max-exp dbl-mant-dig)))
4638         (* (- (expt 2 dbl-mant-dig) 1)
4639            (expt 2 (- dbl-max-exp dbl-mant-dig))))
4640
4641   (test "smallest inexact"
4642         (expt 2.0 (- dbl-min-exp dbl-mant-dig))
4643         (expt 2   (- dbl-min-exp dbl-mant-dig)))
4644
4645   (test "smallest inexact * 2"
4646         (* 2.0 (expt 2.0 (- dbl-min-exp dbl-mant-dig)))
4647         (* 2   (expt 2   (- dbl-min-exp dbl-mant-dig))))
4648
4649   (test "smallest inexact * 3"
4650         (* 3.0 (expt 2.0 (- dbl-min-exp dbl-mant-dig)))
4651         (* 3   (expt 2   (- dbl-min-exp dbl-mant-dig))))
4652
4653   (with-test-prefix "2.0**i to exact"
4654     (do ((i 0   (1+ i))
4655          (n 1   (* 2 n))
4656          (f 1.0 (* 2.0 f)))
4657         ((> i 100))
4658       (test (list i n) f n))))
4659
4660 ;;;
4661 ;;; integer-expt
4662 ;;;
4663
4664 (with-test-prefix "integer-expt"
4665   (pass-if (documented? integer-expt))
4666
4667   (pass-if-exception "2^+inf" exception:wrong-type-arg
4668     (integer-expt 2 +inf.0))
4669   (pass-if-exception "2^-inf" exception:wrong-type-arg
4670     (integer-expt 2 -inf.0))
4671   (pass-if-exception "2^nan" exception:wrong-type-arg
4672     (integer-expt 2 +nan.0))
4673
4674   (pass-if (eqv? 1 (integer-expt 0 0)))
4675   (pass-if (eqv? 1 (integer-expt 0.0 0)))
4676   (pass-if (real-nan? (integer-expt 0 -1)))
4677   (pass-if (real-nan? (integer-expt 0.0 -1)))
4678   (pass-if (eqv? 0 (integer-expt 0 3)))
4679   (pass-if (eqv? 0.0 (integer-expt 0.0 5)))
4680   (pass-if (eqv? -2742638075.5 (integer-expt -2742638075.5 1)))
4681   (pass-if (eqv? (* -2742638075.5 -2742638075.5)
4682                  (integer-expt -2742638075.5 2)))
4683   (pass-if (eqv? 4.0 (integer-expt -2.0 2)))
4684   (pass-if (eqv? -1/8 (integer-expt -2 -3)))
4685   (pass-if (eqv? -0.125 (integer-expt -2.0 -3)))
4686   (pass-if (eqv? 0.25 (integer-expt 2.0 -2)))
4687   (pass-if (eqv? 32/243 (integer-expt 2/3 5)))
4688   (pass-if (eqv? 243/32 (integer-expt 2/3 -5)))
4689   (pass-if (eqv? 32 (integer-expt 1/2 -5)))
4690   (pass-if (test-eqv? (* -1.0+0.0i 12398 12398) (integer-expt +12398.0i 2))))
4691
4692
4693 ;;;
4694 ;;; integer-length
4695 ;;;
4696
4697 (with-test-prefix "integer-length"
4698   (pass-if (documented? integer-length))
4699
4700   (with-test-prefix "-2^i, ...11100..00"
4701     (do ((n -1 (ash n 1))
4702          (i 0  (1+ i)))
4703         ((> i 256))
4704       (pass-if (list n "expect" i)
4705         (= i (integer-length n)))))
4706
4707   (with-test-prefix "-2^i+1 ...11100..01"
4708     (do ((n -3 (logxor 3 (ash n 1)))
4709          (i 2  (1+ i)))
4710         ((> i 256))
4711       (pass-if n
4712         (= i (integer-length n)))))
4713
4714   (with-test-prefix "-2^i-1 ...111011..11"
4715     (do ((n -2 (1+ (ash n 1)))
4716          (i 1  (1+ i)))
4717         ((> i 256))
4718       (pass-if n
4719         (= i (integer-length n))))))
4720
4721 ;;;
4722 ;;; log
4723 ;;;
4724
4725 (with-test-prefix "log"
4726   (pass-if (documented? log))
4727
4728   (pass-if-exception "no args" exception:wrong-num-args
4729     (log))
4730   (pass-if-exception "two args" exception:wrong-num-args
4731     (log 123 456))
4732   (pass-if-exception "(log 0)" exception:numerical-overflow
4733     (log 0))
4734
4735   (pass-if (test-eqv? -inf.0 (log 0.0)))
4736   (pass-if (test-eqv? +inf.0 (log +inf.0)))
4737   (pass-if (test-eqv? -inf.0+3.14159265358979i (log -0.0)))
4738   (pass-if (test-eqv? +inf.0+3.14159265358979i (log -inf.0)))
4739   (pass-if (test-eqv?  0.0 (log 1  )))
4740   (pass-if (test-eqv?  0.0 (log 1.0)))
4741   (pass-if (test-eqv?  1.0 (log const-e)))
4742   (pass-if (test-eqv?  2.0 (log const-e^2)))
4743   (pass-if (test-eqv? -1.0 (log const-1/e)))
4744   (pass-if (test-eqv? -1.0+3.14159265358979i (log (- const-1/e))))
4745   (pass-if (test-eqv?  2.30258509299405 (log 10)))
4746   (pass-if (test-eqv?  2.30258509299405+3.14159265358979i (log -10)))
4747
4748   (pass-if (test-eqv?  1.0+0.0i (log (+ const-e +0.0i))))
4749   (pass-if (test-eqv?  1.0-0.0i (log (+ const-e -0.0i))))
4750
4751   (pass-if (eqv-loosely?  230258.509299405 (log (expt 10  100000))))
4752   (pass-if (eqv-loosely? -230258.509299405 (log (expt 10 -100000))))
4753   (pass-if (eqv-loosely?  230257.410687116 (log (/ (expt 10 100000) 3))))
4754   (pass-if (eqv-loosely?  230258.509299405+3.14159265358979i
4755                           (log (- (expt 10 100000)))))
4756   (pass-if (eqv-loosely? -230258.509299405+3.14159265358979i
4757                           (log (- (expt 10 -100000)))))
4758   (pass-if (eqv-loosely?  230257.410687116+3.14159265358979i
4759                           (log (- (/ (expt 10 100000) 3)))))
4760   (pass-if (test-eqv?  3.05493636349961e-151
4761                        (log (/ (1+ (expt 2 500)) (expt 2 500)))))
4762
4763   (pass-if (eqv-loosely? 1.0+1.57079i (log 0+2.71828i)))
4764   (pass-if (eqv-loosely? 1.0-1.57079i (log 0-2.71828i)))
4765
4766   (pass-if (eqv-loosely? 0.0+3.14159i (log -1.0)))
4767   (pass-if (eqv-loosely? 1.0+3.14159i (log -2.71828)))
4768   (pass-if (eqv-loosely? 2.0+3.14159i (log (* -2.71828 2.71828)))))
4769
4770 ;;;
4771 ;;; log10
4772 ;;;
4773
4774 (with-test-prefix "log10"
4775   (pass-if (documented? log10))
4776
4777   (pass-if-exception "no args" exception:wrong-num-args
4778     (log10))
4779   (pass-if-exception "two args" exception:wrong-num-args
4780     (log10 123 456))
4781   (pass-if-exception "(log10 0)" exception:numerical-overflow
4782     (log10 0))
4783
4784   (pass-if (test-eqv? -inf.0 (log10 0.0)))
4785   (pass-if (test-eqv? +inf.0 (log10 +inf.0)))
4786   (pass-if (test-eqv? -inf.0+1.36437635384184i (log10 -0.0)))
4787   (pass-if (test-eqv? +inf.0+1.36437635384184i (log10 -inf.0)))
4788   (pass-if (test-eqv?  0.0 (log10   1  )))
4789   (pass-if (test-eqv?  0.0 (log10   1.0)))
4790   (pass-if (test-eqv?  1.0 (log10  10  )))
4791   (pass-if (test-eqv?  1.0 (log10  10.0)))
4792   (pass-if (test-eqv?  2.0 (log10 100.0)))
4793   (pass-if (test-eqv? -1.0 (log10   0.1)))
4794   (pass-if (test-eqv? -1.0+1.36437635384184i (log10  -0.1)))
4795   (pass-if (test-eqv?  1.0+1.36437635384184i (log10 -10  )))
4796
4797   (pass-if (test-eqv?  1.0+0.0i (log10  10.0+0.0i)))
4798   (pass-if (test-eqv?  1.0-0.0i (log10  10.0-0.0i)))
4799
4800   (pass-if (eqv-loosely?  100000.0 (log10 (expt 10  100000))))
4801   (pass-if (eqv-loosely? -100000.0 (log10 (expt 10 -100000))))
4802   (pass-if (eqv-loosely?   99999.5228787453 (log10 (/ (expt 10 100000) 3))))
4803   (pass-if (eqv-loosely?  100000.0+1.36437635384184i
4804                           (log10 (- (expt 10 100000)))))
4805   (pass-if (eqv-loosely? -100000.0+1.36437635384184i
4806                           (log10 (- (expt 10 -100000)))))
4807   (pass-if (eqv-loosely?   99999.5228787453+1.36437635384184i
4808                           (log10 (- (/ (expt 10 100000) 3)))))
4809   (pass-if (test-eqv?  1.32674200523347e-151
4810                        (log10 (/ (1+ (expt 2 500)) (expt 2 500)))))
4811
4812   (pass-if (eqv-loosely? 1.0+0.68218i (log10 0+10.0i)))
4813   (pass-if (eqv-loosely? 1.0-0.68218i (log10 0-10.0i)))
4814
4815   (pass-if (eqv-loosely? 0.0+1.36437i (log10   -1)))
4816   (pass-if (eqv-loosely? 1.0+1.36437i (log10  -10)))
4817   (pass-if (eqv-loosely? 2.0+1.36437i (log10 -100))))
4818
4819 ;;;
4820 ;;; logbit?
4821 ;;;
4822
4823 (with-test-prefix "logbit?"
4824   (pass-if (documented? logbit?))
4825
4826   (pass-if (eq? #f (logbit?  0 0)))
4827   (pass-if (eq? #f (logbit?  1 0)))
4828   (pass-if (eq? #f (logbit? 31 0)))
4829   (pass-if (eq? #f (logbit? 32 0)))
4830   (pass-if (eq? #f (logbit? 33 0)))
4831   (pass-if (eq? #f (logbit? 63 0)))
4832   (pass-if (eq? #f (logbit? 64 0)))
4833   (pass-if (eq? #f (logbit? 65 0)))
4834
4835   ;; prior to guile 1.6.5, testing bit 32, 64 etc of value 1 would wrap
4836   ;; around and return #t where it ought to be #f
4837   (pass-if (eq? #t (logbit?  0 1)))
4838   (pass-if (eq? #f (logbit?  1 1)))
4839   (pass-if (eq? #f (logbit? 31 1)))
4840   (pass-if (eq? #f (logbit? 32 1)))
4841   (pass-if (eq? #f (logbit? 33 1)))
4842   (pass-if (eq? #f (logbit? 63 1)))
4843   (pass-if (eq? #f (logbit? 64 1)))
4844   (pass-if (eq? #f (logbit? 65 1)))
4845   (pass-if (eq? #f (logbit? 128 1)))
4846
4847   (pass-if (eq? #t (logbit?  0 -1)))
4848   (pass-if (eq? #t (logbit?  1 -1)))
4849   (pass-if (eq? #t (logbit? 31 -1)))
4850   (pass-if (eq? #t (logbit? 32 -1)))
4851   (pass-if (eq? #t (logbit? 33 -1)))
4852   (pass-if (eq? #t (logbit? 63 -1)))
4853   (pass-if (eq? #t (logbit? 64 -1)))
4854   (pass-if (eq? #t (logbit? 65 -1))))
4855
4856 ;;;
4857 ;;; logcount
4858 ;;;
4859
4860 (with-test-prefix "logcount"
4861   (pass-if (documented? logcount))
4862
4863   (with-test-prefix "-2^i, meaning ...11100..00"
4864     (do ((n -1 (ash n 1))
4865          (i 0  (1+ i)))
4866         ((> i 256))
4867       (pass-if n
4868         (= i (logcount n)))))
4869
4870   (with-test-prefix "2^i"
4871     (do ((n 1 (ash n 1))
4872          (i 0  (1+ i)))
4873         ((> i 256))
4874       (pass-if n
4875         (= 1 (logcount n)))))
4876
4877   (with-test-prefix "2^i-1"
4878     (do ((n 0 (1+ (ash n 1)))
4879          (i 0  (1+ i)))
4880         ((> i 256))
4881       (pass-if n
4882         (= i (logcount n))))))
4883
4884 ;;;
4885 ;;; logior
4886 ;;;
4887
4888 (with-test-prefix "logior"
4889   (pass-if (documented? logior))
4890
4891   (pass-if (eqv? -1 (logior (ash -1 1) 1)))
4892
4893   ;; check that bignum or bignum+inum args will reduce to an inum
4894   (let ()
4895     (define (test x y)
4896       (pass-if (list x y '=> -1)
4897         (eqv? -1 (logior x y)))
4898       (pass-if (list y x '=> -1)
4899         (eqv? -1 (logior y x))))
4900     (test (ash -1 8) #xFF)
4901     (test (ash -1 28) #x0FFFFFFF)
4902     (test (ash -1 29) #x1FFFFFFF)
4903     (test (ash -1 30) #x3FFFFFFF)
4904     (test (ash -1 31) #x7FFFFFFF)
4905     (test (ash -1 32) #xFFFFFFFF)
4906     (test (ash -1 33) #x1FFFFFFFF)
4907     (test (ash -1 60) #x0FFFFFFFFFFFFFFF)
4908     (test (ash -1 61) #x1FFFFFFFFFFFFFFF)
4909     (test (ash -1 62) #x3FFFFFFFFFFFFFFF)
4910     (test (ash -1 63) #x7FFFFFFFFFFFFFFF)
4911     (test (ash -1 64) #xFFFFFFFFFFFFFFFF)
4912     (test (ash -1 65) #x1FFFFFFFFFFFFFFFF)
4913     (test (ash -1 128) #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)))
4914
4915 ;;;
4916 ;;; lognot
4917 ;;;
4918
4919 (with-test-prefix "lognot"
4920   (pass-if (documented? lognot))
4921
4922   (pass-if (= -1 (lognot 0)))
4923   (pass-if (= 0  (lognot -1)))
4924   (pass-if (= -2 (lognot 1)))
4925   (pass-if (= 1  (lognot -2)))
4926
4927   (pass-if (= #x-100000000000000000000000000000000
4928               (lognot #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)))
4929   (pass-if (= #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
4930               (lognot #x-100000000000000000000000000000000))))
4931
4932 ;;;
4933 ;;; exact-integer-sqrt
4934 ;;;
4935
4936 (with-test-prefix "exact-integer-sqrt"
4937   (define (non-negative-exact-integer? k)
4938     (and (integer? k) (exact? k) (>= k 0)))
4939
4940   (define (test k)
4941     (pass-if k (let-values (((s r) (exact-integer-sqrt k)))
4942                  (and (non-negative-exact-integer? s)
4943                       (non-negative-exact-integer? r)
4944                       (= k (+ r (* s s)))
4945                       (< k (* (1+ s) (1+ s)))))))
4946
4947   (define (test-wrong-type-arg k)
4948     (pass-if-exception k exception:wrong-type-arg
4949                        (let-values (((s r) (exact-integer-sqrt k)))
4950                          #t)))
4951
4952   (pass-if (documented? exact-integer-sqrt))
4953
4954   (pass-if-exception "no args" exception:wrong-num-args
4955     (exact-integer-sqrt))
4956   (pass-if-exception "two args" exception:wrong-num-args
4957     (exact-integer-sqrt 123 456))
4958
4959   (test 0)
4960   (test 1)
4961   (test 9)
4962   (test 10)
4963   (test fixnum-max)
4964   (test (1+ fixnum-max))
4965   (test (* fixnum-max fixnum-max))
4966   (test (+ 1 (* fixnum-max fixnum-max)))
4967   (test (expt 10 100))
4968   (test (+ 3 (expt 10 100)))
4969
4970   (test-wrong-type-arg -1)
4971   (test-wrong-type-arg 1/9)
4972   (test-wrong-type-arg fixnum-min)
4973   (test-wrong-type-arg (1- fixnum-min))
4974   (test-wrong-type-arg 1.0)
4975   (test-wrong-type-arg 1.5)
4976   (test-wrong-type-arg "foo")
4977   (test-wrong-type-arg 'foo))
4978
4979
4980 ;;;
4981 ;;; sqrt
4982 ;;;
4983
4984 (with-test-prefix "sqrt"
4985   (pass-if (documented? sqrt))
4986
4987   (pass-if-exception "no args" exception:wrong-num-args
4988     (sqrt))
4989   (pass-if-exception "two args" exception:wrong-num-args
4990     (sqrt 123 456))
4991
4992   (pass-if (eqv? 0 (sqrt 0)))
4993   (pass-if (eqv? 1 (sqrt 1)))
4994   (pass-if (eqv? 2 (sqrt 4)))
4995   (pass-if (eqv? 3 (sqrt 9)))
4996   (pass-if (eqv? 4 (sqrt 16)))
4997   (pass-if (eqv? fixnum-max (sqrt (expt fixnum-max 2))))
4998   (pass-if (eqv? (+ 1 fixnum-max) (sqrt (expt (+ 1 fixnum-max) 2))))
4999   (pass-if (eqv? (expt 10 400) (sqrt (expt 10 800))))
5000   (pass-if (eqv? (/ (expt 10 1000)
5001                     (expt 13 1000))
5002                  (sqrt (/ (expt 10 2000)
5003                           (expt 13 2000)))))
5004
5005   (with-test-prefix "exact sqrt"
5006
5007     (define (test root)
5008       (pass-if (list root 'exact)
5009         (eqv? root (sqrt (expt root 2))))
5010       (pass-if (list root '*2)
5011         (let ((r (sqrt (* 2 (expt root 2)))))
5012           (and (inexact? r)
5013                (eqv-loosely? (* (sqrt 2) root) r))))
5014       (pass-if (list root '-1)
5015         (let ((r (sqrt (- (expt root 2) 1))))
5016           (and (inexact? r)
5017                (eqv-loosely? root r))))
5018       (pass-if (list root '+1)
5019         (let ((r (sqrt (+ (expt root 2) 1))))
5020           (and (inexact? r)
5021                (eqv-loosely? root r))))
5022       (pass-if (list root 'negative)
5023         (eqv-loosely? (* +i root) (sqrt (- (expt root 2))))))
5024
5025     (test (exact-integer-sqrt (+ -1 (expt 2 (+  2 dbl-mant-dig)))))
5026     (test (exact-integer-sqrt (+ -1 (expt 2 (+  1 dbl-mant-dig)))))
5027     (test (exact-integer-sqrt (+ -1 (expt 2 (+  0 dbl-mant-dig)))))
5028     (test (exact-integer-sqrt (+ -1 (expt 2 (+ -1 dbl-mant-dig)))))
5029     (test (exact-integer-sqrt (+ -1 (expt 2 (+ -2 dbl-mant-dig)))))
5030
5031     ;; largest finite inexact
5032     (test (* (- (expt 2 dbl-mant-dig) 1)
5033              (expt 2 (- dbl-max-exp dbl-mant-dig)))))
5034
5035   (pass-if-equal "smallest inexact"
5036       (expt 2.0 (- dbl-min-exp dbl-mant-dig))
5037     (sqrt (/ (+ -1 (expt 2 (* 2 (- dbl-mant-dig dbl-min-exp)))))))
5038
5039   (with-test-prefix "extreme ratios"
5040     (define-syntax-rule (test want x)
5041       (pass-if 'x
5042         (let ((got (sqrt x)))
5043           (and (inexact? got)
5044                (test-eqv? 1.0 (/ want got))))))
5045     (test 1.511139943175573e176   (/ (expt 3 2001) (expt 2 2001)))
5046     (test 2.1370746022826034e176  (/ (expt 3 2001) (expt 2 2000)))
5047     (test 8.724570529756128e175   (/ (expt 3 2000) (expt 2 2001)))
5048     (test 6.6175207962444435e-177 (/ (expt 2 2001) (expt 3 2001)))
5049     (test 1.1461882239239027e-176 (/ (expt 2 2001) (expt 3 2000)))
5050     (test 4.679293829667447e-177  (/ (expt 2 2000) (expt 3 2001))))
5051
5052   (pass-if (eqv? (/ (expt 2 1000)
5053                     (expt 3 1000))
5054                  (sqrt (/ (expt 2 2000)
5055                           (expt 3 2000)))))
5056
5057   (pass-if (eqv? (/ (expt 3 1000)
5058                     (expt 2 1000))
5059                  (sqrt (/ (expt 3 2000)
5060                           (expt 2 2000)))))
5061
5062   (pass-if (eqv? +4i (sqrt -16)))
5063   (pass-if (eqv-loosely? +1.0e150i (sqrt #e-1e300)))
5064   (pass-if (eqv-loosely? +0.7071i (sqrt -1/2)))
5065
5066   (pass-if (eqv? 0.0 (sqrt 0.0)))
5067   (pass-if (eqv? 1.0 (sqrt 1.0)))
5068   (pass-if (eqv-loosely? 2.0   (sqrt 4.0)))
5069   (pass-if (eqv-loosely? 31.62 (sqrt 1000.0)))
5070
5071   (pass-if (eqv? +1.0i (sqrt -1.0)))
5072   (pass-if (eqv-loosely? +2.0i   (sqrt -4.0)))
5073   (pass-if (eqv-loosely? +31.62i (sqrt -1000.0)))
5074
5075   (pass-if "+i swings back to 45deg angle"
5076     (eqv-loosely? +0.7071+0.7071i (sqrt +1.0i)))
5077
5078   ;; Note: glibc 2.3 csqrt() had a bug affecting this test case, so if it
5079   ;; fails check whether that's the cause (there's a configure test to
5080   ;; reject it, but when cross-compiling we assume the C library is ok).
5081   (pass-if "-100i swings back to 45deg down"
5082     (eqv-loosely? +7.071-7.071i (sqrt -100.0i))))
5083
5084
5085 ;;;
5086 ;;; Tests for number-theoretic division operators:
5087 ;;;
5088 ;;; euclidean/
5089 ;;; euclidean-quotient
5090 ;;; euclidean-remainder
5091 ;;; floor/
5092 ;;; floor-quotient
5093 ;;; floor-remainder
5094 ;;; ceiling/
5095 ;;; ceiling-quotient
5096 ;;; ceiling-remainder
5097 ;;; truncate/
5098 ;;; truncate-quotient
5099 ;;; truncate-remainder
5100 ;;; centered/
5101 ;;; centered-quotient
5102 ;;; centered-remainder
5103 ;;; round/
5104 ;;; round-quotient
5105 ;;; round-remainder
5106 ;;;
5107
5108 (with-test-prefix "Number-theoretic division"
5109
5110   ;; Tests that (lo <1 x <2 hi),
5111   ;; but allowing for imprecision
5112   ;; if x is inexact.
5113   (define (test-within-range? lo <1 x <2 hi)
5114     (if (exact? x)
5115         (and (<1 lo x) (<2 x hi))
5116         (let ((lo (- lo test-epsilon))
5117               (hi (+ hi test-epsilon)))
5118           (<= lo x hi))))
5119
5120   (define (valid-euclidean-answer? x y q r)
5121     (and (eq? (exact? q)
5122               (exact? r)
5123               (and (exact? x) (exact? y)))
5124          (test-eqv? r (- x (* q y)))
5125          (if (and (finite? x) (finite? y))
5126              (and (integer? q)
5127                   (test-within-range? 0 <= r < (abs y)))
5128              (test-eqv? q (/ x y)))))
5129
5130   (define (valid-floor-answer? x y q r)
5131     (and (eq? (exact? q)
5132               (exact? r)
5133               (and (exact? x) (exact? y)))
5134          (test-eqv? r (- x (* q y)))
5135          (if (and (finite? x) (finite? y))
5136              (and (integer? q)
5137                   (if (> y 0)
5138                       (test-within-range? 0 <= r < y)
5139                       (test-within-range? y < r <= 0)))
5140              (test-eqv? q (/ x y)))))
5141
5142   (define (valid-ceiling-answer? x y q r)
5143     (and (eq? (exact? q)
5144               (exact? r)
5145               (and (exact? x) (exact? y)))
5146          (test-eqv? r (- x (* q y)))
5147          (if (and (finite? x) (finite? y))
5148              (and (integer? q)
5149                   (if (> y 0)
5150                       (test-within-range? (- y) < r <= 0)
5151                       (test-within-range?    0 <= r < (- y))))
5152              (test-eqv? q (/ x y)))))
5153
5154   (define (valid-truncate-answer? x y q r)
5155     (and (eq? (exact? q)
5156               (exact? r)
5157               (and (exact? x) (exact? y)))
5158          (test-eqv? r (- x (* q y)))
5159          (if (and (finite? x) (finite? y))
5160              (and (integer? q)
5161                   (if (> x 0)
5162                       (test-within-range?          0 <= r < (abs y))
5163                       (test-within-range? (- (abs y)) < r <= 0)))
5164              (test-eqv? q (/ x y)))))
5165
5166   (define (valid-centered-answer? x y q r)
5167     (and (eq? (exact? q)
5168               (exact? r)
5169               (and (exact? x) (exact? y)))
5170          (test-eqv? r (- x (* q y)))
5171          (if (and (finite? x) (finite? y))
5172              (and (integer? q)
5173                   (test-within-range?
5174                    (* -1/2 (abs y)) <= r < (* +1/2 (abs y))))
5175              (test-eqv? q (/ x y)))))
5176
5177   (define (valid-round-answer? x y q r)
5178     (and (eq? (exact? q)
5179               (exact? r)
5180               (and (exact? x) (exact? y)))
5181          (test-eqv? r (- x (* q y)))
5182          (if (and (finite? x) (finite? y))
5183              (and (integer? q)
5184                   (let ((ay/2 (/ (abs y) 2)))
5185                     (if (even? q)
5186                         (test-within-range? (- ay/2) <= r <= ay/2)
5187                         (test-within-range? (- ay/2) <  r <  ay/2))))
5188              (test-eqv? q (/ x y)))))
5189
5190   (define (for lsts f) (apply for-each f lsts))
5191
5192   (define big (expt 10 (1+ (inexact->exact (ceiling (log10 fixnum-max))))))
5193
5194   (define (run-division-tests quo+rem quo rem valid-answer?)
5195     (define (test n d)
5196       (run-test (list n d) #t
5197                 (lambda ()
5198                   (let-values (((q r) (quo+rem n d)))
5199                     (and (test-eqv? q (quo n d))
5200                          (test-eqv? r (rem n d))
5201                          (valid-answer? n d q r))))))
5202     (define (test+/- n d)
5203       (test n    d )
5204       (test n (- d))
5205       (cond ((not (zero? n))
5206              (test (- n)    d )
5207              (test (- n) (- d)))))
5208
5209     (define (test-for-exception n d exception)
5210       (let ((name (list n d)))
5211         (pass-if-exception name exception (quo+rem n d))
5212         (pass-if-exception name exception (quo n d))
5213         (pass-if-exception name exception (rem n d))))
5214
5215     (run-test "documented?" #t
5216               (lambda ()
5217                 (and (documented? quo+rem)
5218                      (documented? quo)
5219                      (documented? rem))))
5220
5221     (with-test-prefix "inum / inum"
5222       (with-test-prefix "fixnum-min / -1"
5223         (test fixnum-min -1))
5224       (for '((1 2 5 10))  ;; denominators
5225            (lambda (d)
5226              (for '((0 1 2 5 10))  ;; multiples
5227                   (lambda (m)
5228                     (for '((-2 -1 0 1 2 3 4 5 7 10
5229                                12 15 16 19 20))  ;; offsets
5230                          (lambda (b)
5231                            (test+/- (+ b (* m d))
5232                                     d))))))))
5233
5234     (with-test-prefix "inum / big"
5235       (with-test-prefix "fixnum-min / -fixnum-min"
5236         (test fixnum-min (- fixnum-min)))
5237       (with-test-prefix "fixnum-max / (2*fixnum-max)"
5238         (test+/- fixnum-max (* 2 fixnum-max)))
5239       (for `((0 1 2 10 ,(1- fixnum-max) ,fixnum-max))
5240            (lambda (n)
5241              (test    n  (1+ fixnum-max))
5242              (test (- n) (1+ fixnum-max))
5243              (test    n  (1- fixnum-min))
5244              (test (- n) (1- fixnum-min)))))
5245
5246     (with-test-prefix "big / inum"
5247       (with-test-prefix "-fixnum-min / fixnum-min"
5248         (test (- fixnum-min) fixnum-min))
5249       (for '((1 4 5 10))  ;; denominators
5250            (lambda (d)
5251              (for `((1 2 5 ,@(if (even? d)
5252                                  '(1/2 3/2 5/2)
5253                                  '())))  ;; multiples
5254                   (lambda (m)
5255                     (for '((-2 -1 0 1 2))  ;; offsets
5256                          (lambda (b)
5257                            (test+/- (+ b (* m d big))
5258                                     d))))))))
5259
5260     (with-test-prefix "big / big"
5261       (for `((,big ,(1+ big)))  ;; denominators
5262            (lambda (d)
5263              (for `((1 2 5 ,@(if (even? d)
5264                                  '(1/2 3/2 5/2)
5265                                  '())))  ;; multiples
5266                   (lambda (m)
5267                     (for '((-2 -1 0 1 2))  ;; offsets
5268                          (lambda (b)
5269                            (test+/- (+ b (* m d))
5270                                     d))))))))
5271
5272     (with-test-prefix "inexact"
5273       (for '((0.5 1.5 2.25 5.75))  ;; denominators
5274            (lambda (d)
5275              (for '((0 1 2 5 1/2 3/2 5/2))  ;; multiples
5276                   (lambda (m)
5277                     (for '((-2 -1 0 1 2))  ;; offsets
5278                          (lambda (b)
5279                            (test+/- (+ b (* m d))
5280                                     d))))))))
5281
5282     (with-test-prefix "fractions"
5283       (for '((1/10 16/3 10/7))  ;; denominators
5284            (lambda (d)
5285              (for '((0 1 2 5 1/2 3/2 5/2))  ;; multiples
5286                   (lambda (m)
5287                     (for '((-2/9 -1/11 0 1/3 2/3))  ;; offsets
5288                          (lambda (b)
5289                            (test+/- (+ b (* m d))
5290                                     d))))))))
5291
5292     (with-test-prefix "mixed types"
5293       (for `((10 ,big 12.0 10/7 +inf.0 -inf.0 +nan.0))  ;; denominators
5294            (lambda (d)
5295              (for `((25 ,(* 3/2 big) 130.0 15/7
5296                         0 0.0 -0.0 +inf.0 -inf.0 +nan.0))  ;; numerators
5297                   (lambda (n)
5298                     (test+/- n d))))))
5299
5300     (with-test-prefix "divide by zero"
5301       (for `((0 0.0 -0.0))  ;; denominators
5302            (lambda (d)
5303              (for `((15 ,(* 3/2 big) 18.0 33/7
5304                         0 0.0 -0.0 +inf.0 -inf.0 +nan.0))  ;; numerators
5305                   (lambda (n)
5306                     (test-for-exception
5307                      n d exception:numerical-overflow)))))))
5308
5309   (with-test-prefix "euclidean/"
5310     (run-division-tests euclidean/
5311                         euclidean-quotient
5312                         euclidean-remainder
5313                         valid-euclidean-answer?))
5314
5315   (with-test-prefix "floor/"
5316     (run-division-tests floor/
5317                         floor-quotient
5318                         floor-remainder
5319                         valid-floor-answer?))
5320
5321   (with-test-prefix "ceiling/"
5322     (run-division-tests ceiling/
5323                         ceiling-quotient
5324                         ceiling-remainder
5325                         valid-ceiling-answer?))
5326
5327   (with-test-prefix "truncate/"
5328     (run-division-tests truncate/
5329                         truncate-quotient
5330                         truncate-remainder
5331                         valid-truncate-answer?))
5332
5333   (with-test-prefix "centered/"
5334     (run-division-tests centered/
5335                         centered-quotient
5336                         centered-remainder
5337                         valid-centered-answer?))
5338
5339   (with-test-prefix "round/"
5340     (run-division-tests round/
5341                         round-quotient
5342                         round-remainder
5343                         valid-round-answer?)))
5344
5345 ;;;
5346 ;;; ash
5347 ;;; round-ash
5348 ;;;
5349
5350 (let ()
5351   (define (test-ash-variant name ash-variant round-variant)
5352     (with-test-prefix name
5353       (define (test n count)
5354         (pass-if (list n count)
5355           (eqv? (ash-variant n count)
5356                 (round-variant (* n (expt 2 count))))))
5357
5358       (pass-if "documented?"
5359         (documented? ash-variant))
5360
5361       (for-each (lambda (n)
5362                   (for-each (lambda (count) (test n count))
5363                             '(-1000 -3 -2 -1 0 1 2 3 1000)))
5364                 (list 0 1 3 23 -1 -3 -23
5365                       fixnum-max
5366                       (1+ fixnum-max)
5367                       (1- fixnum-max)
5368                       (* fixnum-max 4)
5369                       (quotient fixnum-max 4)
5370                       fixnum-min
5371                       (1+ fixnum-min)
5372                       (1- fixnum-min)
5373                       (* fixnum-min 4)
5374                       (quotient fixnum-min 4)))
5375
5376       (do ((count -2 (1- count))
5377            (vals '(1 3 5 7 9 11)
5378                  (map (lambda (n) (* 2 n)) vals)))
5379           ((> (car vals) (* 2 fixnum-max)) 'done)
5380         (for-each (lambda (n)
5381                     (test    n  count)
5382                     (test (- n) count))
5383                   vals))
5384
5385       ;; Test rounding
5386       (for-each (lambda (base)
5387                   (for-each (lambda (offset) (test (+ base offset) -3))
5388                             '(#b11001 #b11100 #b11101 #b10001 #b10100 #b10101)))
5389                 (list 0 64 -64 (* 64 fixnum-max) (* 64 fixnum-min)))))
5390
5391   (test-ash-variant       'ash       ash floor)
5392   (test-ash-variant 'round-ash round-ash round))