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