test-suite/tests/numbers.test

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