test-suite/tests/numbers.test

   1 ;;;; numbers.test --- tests guile's numbers     -*- scheme -*-
   2 ;;;; Copyright (C) 2000, 2001, 2003, 2004, 2005, 2006, 2009, 2010, 2011 Free Software Foundation, Inc.
   3 ;;;;
   4 ;;;; This library is free software; you can redistribute it and/or
   5 ;;;; modify it under the terms of the GNU Lesser General Public
   6 ;;;; License as published by the Free Software Foundation; either
   7 ;;;; version 3 of the License, or (at your option) any later version.
   8 ;;;;
   9 ;;;; This library is distributed in the hope that it will be useful,
  10 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12 ;;;; Lesser General Public License for more details.
  13 ;;;;
  14 ;;;; You should have received a copy of the GNU Lesser General Public
  15 ;;;; License along with this library; if not, write to the Free Software
  16 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  17
  18 (define-module (test-suite test-numbers)
  19   #:use-module (test-suite lib)
  20   #:use-module (ice-9 documentation)
  21   #:use-module (srfi srfi-11))  ; let-values
  22
  23 ;;;
  24 ;;; miscellaneous
  25 ;;;
  26
  27 (define exception:numerical-overflow
  28   (cons 'numerical-overflow "^Numerical overflow"))
  29
  30 (define (documented? object)
  31   (not (not (object-documentation object))))
  32
  33 (define fixnum-bit
  34   (inexact->exact (+ (/ (log (+ most-positive-fixnum 1)) (log 2)) 1)))
  35
  36 (define fixnum-min most-negative-fixnum)
  37 (define fixnum-max most-positive-fixnum)
  38
  39 ;; Divine the number of bits in the mantissa of a flonum.
  40 ;; We look for when 2.0^i+1.0 gets rounded, ie. the difference between that
  41 ;; value and 2.0^k is not 1.0.
  42 ;; Of course this assumes flonums have a fixed precision mantissa, but
  43 ;; that's the case now and probably into the forseeable future.
  44 ;; On an IEEE system, which means pretty much everywhere, the value here is
  45 ;; the usual 53.
  46 ;;
  47 (define dbl-mant-dig
  48   (let more ((i 1)
  49              (d 2.0))
  50     (if (> i 1024)
  51         (error "Oops, cannot determine number of bits in mantissa of inexact"))
  52     (let* ((sum  (+ 1.0 d))
  53            (diff (- sum d)))
  54       (if (= diff 1.0)
  55           (more (1+ i) (* 2.0 d))
  56           i))))
  57
  58 ;; like ash, but working on a flonum
  59 (define (ash-flo x n)
  60   (while (> n 0)
  61     (set! x (* 2.0 x))
  62     (set! n (1- n)))
  63   (while (< n 0)
  64     (set! x (* 0.5 x))
  65     (set! n (1+ n)))
  66   x)
  67
  68 ;; `quotient' but rounded towards -infinity, like `modulo' or `ash' do
  69 ;; note only positive D supported (that's all that's currently required)
  70 (define-public (quotient-floor n d)
  71   (if (negative? n)
  72       (quotient (- n d -1) d)  ;; neg/pos
  73       (quotient n d)))         ;; pos/pos
  74
  75 ;; return true of X is in the range LO to HI, inclusive
  76 (define (within-range? lo hi x)
  77   (and (>= x (min lo hi))
  78        (<= x (max lo hi))))
  79
  80 ;; return true if GOT is within +/- 0.01 of GOT
  81 ;; for a complex number both real and imaginary parts must be in that range
  82 (define (eqv-loosely? want got)
  83   (and (within-range? (- (real-part want) 0.01)
  84                       (+ (real-part want) 0.01)
  85                       (real-part got))
  86        (within-range? (- (imag-part want) 0.01)
  87                       (+ (imag-part want) 0.01)
  88                       (imag-part got))))
  89
  90 ;; return true if OBJ is negative infinity
  91 (define (negative-infinity? obj)
  92   (and (real? obj)
  93        (negative? obj)
  94        (inf? obj)))
  95
  96 ;;
  97 ;; Tolerance used by test-eqv? for inexact numbers.
  98 ;;
  99 (define test-epsilon 1e-10)
 100
 101 ;;
 102 ;; Like eqv?, except that inexact finite numbers need only be within
 103 ;; test-epsilon (1e-10) to be considered equal.  An exception is made
 104 ;; for zeroes, however.  If X is zero, then it is tested using eqv?
 105 ;; without any allowance for imprecision.  In particular, 0.0 is
 106 ;; considered distinct from -0.0.  For non-real complex numbers,
 107 ;; each component is tested according to these rules.  The intent
 108 ;; is that the known-correct value will be the first parameter.
 109 ;;
 110 (define (test-eqv? x y)
 111   (cond ((real? x)
 112          (and (real? y) (test-real-eqv? x y)))
 113         ((complex? x)
 114          (and (not (real? y))
 115               (test-real-eqv? (real-part x) (real-part y))
 116               (test-real-eqv? (imag-part x) (imag-part y))))
 117         (else (eqv? x y))))
 118
 119 ;; Auxiliary predicate used by test-eqv?
 120 (define (test-real-eqv? x y)
 121   (cond ((or (exact? x) (zero? x) (nan? x) (inf? x))
 122          (eqv? x y))
 123         (else (and (inexact? y) (> test-epsilon (abs (- x y)))))))
 124
 125 (define const-e    2.7182818284590452354)
 126 (define const-e^2  7.3890560989306502274)
 127 (define const-1/e  0.3678794411714423215)
 128
 129
 130 ;;;
 131 ;;; 1+
 132 ;;;
 133
 134 (with-test-prefix/c&e "1+"
 135
 136   (pass-if "documented?"
 137     (documented? 1+))
 138
 139   (pass-if "0"   (eqv? 1 (1+ 0)))
 140   (pass-if "-1"   (eqv? 0 (1+ -1)))
 141   (pass-if "100"  (eqv? 101 (1+ 100)))
 142   (pass-if "-100" (eqv? -99 (1+ -100)))
 143
 144   ;; The maximum fixnum on a 32-bit architecture: 2^29 - 1.
 145   (pass-if "1+ fixnum = bignum (32-bit)"
 146     (eqv? 536870912 (1+ 536870911)))
 147
 148   ;; The maximum fixnum on a 64-bit architecture: 2^61 - 1.
 149   (pass-if "1+ fixnum = bignum (64-bit)"
 150     (eqv? 2305843009213693952 (1+ 2305843009213693951))))
 151
 152 ;;;
 153 ;;; 1-
 154 ;;;
 155
 156 (with-test-prefix/c&e "1-"
 157
 158   (pass-if "documented?"
 159     (documented? 1-))
 160
 161   (pass-if "0"    (eqv? -1 (1- 0)))
 162   (pass-if "1"    (eqv? 0 (1- 1)))
 163   (pass-if "100"  (eqv? 99 (1- 100)))
 164   (pass-if "-100" (eqv? -101 (1- -100)))
 165
 166   ;; The minimum fixnum on a 32-bit architecture: -2^29.
 167   (pass-if "1- fixnum = bignum (32-bit)"
 168     (eqv? -536870913 (1- -536870912)))
 169
 170   ;; The minimum fixnum on a 64-bit architecture: -2^61.
 171   (pass-if "1- fixnum = bignum (64-bit)"
 172     (eqv? -2305843009213693953 (1- -2305843009213693952))))
 173
 174 ;;;
 175 ;;; ash
 176 ;;;
 177
 178 (with-test-prefix "ash"
 179
 180   (pass-if "documented?"
 181     (documented? ash))
 182
 183   (pass-if (eqv? 0 (ash 0 0)))
 184   (pass-if (eqv? 0 (ash 0 1)))
 185   (pass-if (eqv? 0 (ash 0 1000)))
 186   (pass-if (eqv? 0 (ash 0 -1)))
 187   (pass-if (eqv? 0 (ash 0 -1000)))
 188
 189   (pass-if (eqv? 1 (ash 1 0)))
 190   (pass-if (eqv? 2 (ash 1 1)))
 191   (pass-if (eqv? 340282366920938463463374607431768211456 (ash 1 128)))
 192   (pass-if (eqv? 0 (ash 1 -1)))
 193   (pass-if (eqv? 0 (ash 1 -1000)))
 194
 195   (pass-if (eqv? -1 (ash -1 0)))
 196   (pass-if (eqv? -2 (ash -1 1)))
 197   (pass-if (eqv? -340282366920938463463374607431768211456 (ash -1 128)))
 198   (pass-if (eqv? -1 (ash -1 -1)))
 199   (pass-if (eqv? -1 (ash -1 -1000)))
 200
 201   (pass-if (eqv? -3 (ash -3 0)))
 202   (pass-if (eqv? -6 (ash -3 1)))
 203   (pass-if (eqv? -1020847100762815390390123822295304634368 (ash -3 128)))
 204   (pass-if (eqv? -2 (ash -3 -1)))
 205   (pass-if (eqv? -1 (ash -3 -1000)))
 206
 207   (pass-if (eqv? -6 (ash -23 -2)))
 208
 209   (pass-if (eqv? most-positive-fixnum       (ash most-positive-fixnum 0)))
 210   (pass-if (eqv? (* 2 most-positive-fixnum) (ash most-positive-fixnum 1)))
 211   (pass-if (eqv? (* 4 most-positive-fixnum) (ash most-positive-fixnum 2)))
 212   (pass-if
 213       (eqv? (* most-positive-fixnum 340282366920938463463374607431768211456)
 214             (ash most-positive-fixnum 128)))
 215   (pass-if (eqv? (quotient most-positive-fixnum 2)
 216                  (ash most-positive-fixnum -1)))
 217   (pass-if (eqv? 0 (ash most-positive-fixnum -1000)))
 218
 219   (let ((mpf4 (quotient most-positive-fixnum 4)))
 220     (pass-if (eqv? (* 2 mpf4) (ash mpf4 1)))
 221     (pass-if (eqv? (* 4 mpf4) (ash mpf4 2)))
 222     (pass-if (eqv? (* 8 mpf4) (ash mpf4 3))))
 223
 224   (pass-if (eqv? most-negative-fixnum       (ash most-negative-fixnum 0)))
 225   (pass-if (eqv? (* 2 most-negative-fixnum) (ash most-negative-fixnum 1)))
 226   (pass-if (eqv? (* 4 most-negative-fixnum) (ash most-negative-fixnum 2)))
 227   (pass-if
 228       (eqv? (* most-negative-fixnum 340282366920938463463374607431768211456)
 229             (ash most-negative-fixnum 128)))
 230   (pass-if (eqv? (quotient-floor most-negative-fixnum 2)
 231                  (ash most-negative-fixnum -1)))
 232   (pass-if (eqv? -1 (ash most-negative-fixnum -1000)))
 233
 234   (let ((mnf4 (quotient-floor most-negative-fixnum 4)))
 235     (pass-if (eqv? (* 2 mnf4) (ash mnf4 1)))
 236     (pass-if (eqv? (* 4 mnf4) (ash mnf4 2)))
 237     (pass-if (eqv? (* 8 mnf4) (ash mnf4 3)))))
 238
 239 ;;;
 240 ;;; exact?
 241 ;;;
 242
 243 (with-test-prefix "exact?"
 244
 245   (pass-if "documented?"
 246     (documented? exact?))
 247
 248   (with-test-prefix "integers"
 249
 250     (pass-if "0"
 251       (exact? 0))
 252
 253     (pass-if "fixnum-max"
 254       (exact? fixnum-max))
 255
 256     (pass-if "fixnum-max + 1"
 257       (exact? (+ fixnum-max 1)))
 258
 259     (pass-if "fixnum-min"
 260       (exact? fixnum-min))
 261
 262     (pass-if "fixnum-min - 1"
 263       (exact? (- fixnum-min 1))))
 264
 265   (with-test-prefix "reals"
 266
 267     ;; (FIXME: need better examples.)
 268
 269     (pass-if "sqrt (fixnum-max^2 - 1)"
 270       (eq? #f (exact? (sqrt (- (expt fixnum-max 2) 1)))))
 271
 272     (pass-if "sqrt ((fixnum-max+1)^2 - 1)"
 273       (eq? #f (exact? (sqrt (- (expt (+ fixnum-max 1) 2) 1)))))
 274
 275     (pass-if (not (exact? +inf.0)))
 276     (pass-if (not (exact? -inf.0)))
 277     (pass-if (not (exact? +nan.0)))))
 278
 279 ;;;
 280 ;;; exp
 281 ;;;
 282
 283 (with-test-prefix "exp"
 284   (pass-if (documented? exp))
 285
 286   (pass-if-exception "no args" exception:wrong-num-args
 287     (exp))
 288   (pass-if-exception "two args" exception:wrong-num-args
 289     (exp 123 456))
 290
 291   (pass-if (eqv? 0.0 (exp -inf.0)))
 292   (pass-if (eqv-loosely? 1.0 (exp 0)))
 293   (pass-if (eqv-loosely? 1.0 (exp 0.0)))
 294   (pass-if (eqv-loosely? const-e   (exp 1.0)))
 295   (pass-if (eqv-loosely? const-e^2 (exp 2.0)))
 296   (pass-if (eqv-loosely? const-1/e (exp -1)))
 297
 298   (pass-if "exp(pi*i) = -1"
 299     (eqv-loosely? -1.0 (exp 0+3.14159i)))
 300   (pass-if "exp(-pi*i) = -1"
 301     (eqv-loosely? -1.0 (exp 0-3.14159i)))
 302   (pass-if "exp(2*pi*i) = +1"
 303     (eqv-loosely? 1.0 (exp 0+6.28318i)))
 304
 305   (pass-if "exp(2-pi*i) = -e^2"
 306     (eqv-loosely? (- const-e^2) (exp 2.0-3.14159i))))
 307
 308 ;;;
 309 ;;; odd?
 310 ;;;
 311
 312 (with-test-prefix "odd?"
 313   (pass-if (documented? odd?))
 314   (pass-if (odd? 1))
 315   (pass-if (odd? -1))
 316   (pass-if (not (odd? 0)))
 317   (pass-if (not (odd? 2)))
 318   (pass-if (not (odd? -2)))
 319   (pass-if (odd? (+ (* 2 fixnum-max) 1)))
 320   (pass-if (not (odd? (* 2 fixnum-max))))
 321   (pass-if (odd? (- (* 2 fixnum-min) 1)))
 322   (pass-if (not (odd? (* 2 fixnum-min)))))
 323
 324 ;;;
 325 ;;; even?
 326 ;;;
 327
 328 (with-test-prefix "even?"
 329   (pass-if (documented? even?))
 330   (pass-if (even? 2))
 331   (pass-if (even? -2))
 332   (pass-if (even? 0))
 333   (pass-if (not (even? 1)))
 334   (pass-if (not (even? -1)))
 335   (pass-if (not (even? (+ (* 2 fixnum-max) 1))))
 336   (pass-if (even? (* 2 fixnum-max)))
 337   (pass-if (not (even? (- (* 2 fixnum-min) 1))))
 338   (pass-if (even? (* 2 fixnum-min))))
 339
 340 ;;;
 341 ;;; finite?
 342 ;;;
 343
 344 (with-test-prefix "finite?"
 345   (pass-if (documented? finite?))
 346   (pass-if (not (finite? (inf))))
 347   (pass-if (not (finite? +inf.0)))
 348   (pass-if (not (finite? -inf.0)))
 349   (pass-if-exception
 350    "complex numbers not in domain of finite?"
 351    exception:wrong-type-arg
 352    (finite? +inf.0+1i))
 353   (pass-if-exception
 354    "complex numbers not in domain of finite? (2)"
 355    exception:wrong-type-arg
 356    (finite? +1+inf.0i))
 357   (pass-if-exception
 358    "complex numbers not in domain of finite? (3)"
 359    exception:wrong-type-arg
 360    (finite? +1+1i))
 361   (pass-if (finite? 3+0i))
 362   (pass-if (not (finite? (nan))))
 363   (pass-if (not (finite? +nan.0)))
 364   (pass-if (finite? 0))
 365   (pass-if (finite? 0.0))
 366   (pass-if (finite? -0.0))
 367   (pass-if (finite? 42.0))
 368   (pass-if (finite? 1/2))
 369   (pass-if (finite? (+ fixnum-max 1)))
 370   (pass-if (finite? (- fixnum-min 1))))
 371
 372 ;;;
 373 ;;; inf? and inf
 374 ;;;
 375
 376 (with-test-prefix "inf?"
 377   (pass-if (documented? inf?))
 378   (pass-if (inf? (inf)))
 379   ;; FIXME: what are the expected behaviors?
 380   ;; (pass-if (inf? (/ 1.0 0.0))
 381   ;; (pass-if (inf? (/ 1 0.0))
 382   (pass-if-exception
 383    "complex numbers not in domain of inf?"
 384    exception:wrong-type-arg
 385    (inf? +1+inf.0i))
 386   (pass-if (inf? +inf.0+0i))
 387   (pass-if (not (inf? 0)))
 388   (pass-if (not (inf? 42.0)))
 389   (pass-if (not (inf? (+ fixnum-max 1))))
 390   (pass-if (not (inf? (- fixnum-min 1)))))
 391
 392 ;;;
 393 ;;; nan? and nan
 394 ;;;
 395
 396 (with-test-prefix "nan?"
 397   (pass-if (documented? nan?))
 398   (pass-if (nan? (nan)))
 399   ;; FIXME: other ways we should be able to generate NaN?
 400   (pass-if (not (nan? 0)))
 401   (pass-if (not (nan? 42.0)))
 402   (pass-if (not (nan? (+ fixnum-max 1))))
 403   (pass-if (not (nan? (- fixnum-min 1)))))
 404
 405 ;;;
 406 ;;; abs
 407 ;;;
 408
 409 (with-test-prefix "abs"
 410   (pass-if (documented? abs))
 411   (pass-if (zero? (abs 0)))
 412   (pass-if (= 1 (abs 1)))
 413   (pass-if (= 1 (abs -1)))
 414   (pass-if (= (+ fixnum-max 1) (abs (+ fixnum-max 1))))
 415   (pass-if (= (+ (- fixnum-min) 1) (abs (- fixnum-min 1))))
 416   (pass-if (= 0.0 (abs 0.0)))
 417   (pass-if (= 1.0 (abs 1.0)))
 418   (pass-if (= 1.0 (abs -1.0)))
 419   (pass-if (nan? (abs +nan.0)))
 420   (pass-if (= +inf.0 (abs +inf.0)))
 421   (pass-if (= +inf.0 (abs -inf.0))))
 422
 423 ;;;
 424 ;;; quotient
 425 ;;;
 426
 427 (with-test-prefix "quotient"
 428   (pass-if (documented? quotient))
 429
 430   (with-test-prefix "0 / n"
 431
 432     (pass-if "n = 1"
 433       (eqv? 0 (quotient 0 1)))
 434
 435     (pass-if "n = -1"
 436       (eqv? 0 (quotient 0 -1)))
 437
 438     (pass-if "n = 2"
 439       (eqv? 0 (quotient 0 2)))
 440
 441     (pass-if "n = fixnum-max"
 442       (eqv? 0 (quotient 0 fixnum-max)))
 443
 444     (pass-if "n = fixnum-max + 1"
 445       (eqv? 0 (quotient 0 (+ fixnum-max 1))))
 446
 447     (pass-if "n = fixnum-min"
 448       (eqv? 0 (quotient 0 fixnum-min)))
 449
 450     (pass-if "n = fixnum-min - 1"
 451       (eqv? 0 (quotient 0 (- fixnum-min 1)))))
 452
 453   (with-test-prefix "1 / n"
 454
 455     (pass-if "n = 1"
 456       (eqv? 1 (quotient 1 1)))
 457
 458     (pass-if "n = -1"
 459       (eqv? -1 (quotient 1 -1)))
 460
 461     (pass-if "n = 2"
 462       (eqv? 0 (quotient 1 2)))
 463
 464     (pass-if "n = fixnum-max"
 465       (eqv? 0 (quotient 1 fixnum-max)))
 466
 467     (pass-if "n = fixnum-max + 1"
 468       (eqv? 0 (quotient 1 (+ fixnum-max 1))))
 469
 470     (pass-if "n = fixnum-min"
 471       (eqv? 0 (quotient 1 fixnum-min)))
 472
 473     (pass-if "n = fixnum-min - 1"
 474       (eqv? 0 (quotient 1 (- fixnum-min 1)))))
 475
 476   (with-test-prefix "-1 / n"
 477
 478     (pass-if "n = 1"
 479       (eqv? -1 (quotient -1 1)))
 480
 481     (pass-if "n = -1"
 482       (eqv? 1 (quotient -1 -1)))
 483
 484     (pass-if "n = 2"
 485       (eqv? 0 (quotient -1 2)))
 486
 487     (pass-if "n = fixnum-max"
 488       (eqv? 0 (quotient -1 fixnum-max)))
 489
 490     (pass-if "n = fixnum-max + 1"
 491       (eqv? 0 (quotient -1 (+ fixnum-max 1))))
 492
 493     (pass-if "n = fixnum-min"
 494       (eqv? 0 (quotient -1 fixnum-min)))
 495
 496     (pass-if "n = fixnum-min - 1"
 497       (eqv? 0 (quotient -1 (- fixnum-min 1)))))
 498
 499   (with-test-prefix "fixnum-max / n"
 500
 501     (pass-if "n = 1"
 502       (eqv? fixnum-max (quotient fixnum-max 1)))
 503
 504     (pass-if "n = -1"
 505       (eqv? (- fixnum-max) (quotient fixnum-max -1)))
 506
 507     (pass-if "n = 2"
 508       (eqv? fixnum-max (+ (* (quotient fixnum-max 2) 2) 1)))
 509
 510     (pass-if "n = fixnum-max"
 511       (eqv? 1 (quotient fixnum-max fixnum-max)))
 512
 513     (pass-if "n = fixnum-max + 1"
 514       (eqv? 0 (quotient fixnum-max (+ fixnum-max 1))))
 515
 516     (pass-if "n = fixnum-min"
 517       (eqv? 0 (quotient fixnum-max fixnum-min)))
 518
 519     (pass-if "n = fixnum-min - 1"
 520       (eqv? 0 (quotient fixnum-max (- fixnum-min 1)))))
 521
 522   (with-test-prefix "(fixnum-max + 1) / n"
 523
 524     (pass-if "n = 1"
 525       (eqv? (+ fixnum-max 1) (quotient (+ fixnum-max 1) 1)))
 526
 527     (pass-if "n = -1"
 528       (eqv? (- (+ fixnum-max 1)) (quotient (+ fixnum-max 1) -1)))
 529
 530     (pass-if "n = 2"
 531       (eqv? (+ fixnum-max 1) (* (quotient (+ fixnum-max 1) 2) 2)))
 532
 533     (pass-if "n = fixnum-max"
 534       (eqv? 1 (quotient (+ fixnum-max 1) fixnum-max)))
 535
 536     (pass-if "n = fixnum-max + 1"
 537       (eqv? 1 (quotient (+ fixnum-max 1) (+ fixnum-max 1))))
 538
 539     (pass-if "n = fixnum-min"
 540       (eqv? -1 (quotient (+ fixnum-max 1) fixnum-min)))
 541
 542     (pass-if "n = fixnum-min - 1"
 543       (eqv? 0 (quotient (+ fixnum-max 1) (- fixnum-min 1)))))
 544
 545   (with-test-prefix "fixnum-min / n"
 546
 547     (pass-if "n = 1"
 548       (eqv? fixnum-min (quotient fixnum-min 1)))
 549
 550     (pass-if "n = -1"
 551       (eqv? (- fixnum-min) (quotient fixnum-min -1)))
 552
 553     (pass-if "n = 2"
 554       (eqv? fixnum-min (* (quotient fixnum-min 2) 2)))
 555
 556     (pass-if "n = fixnum-max"
 557       (eqv? -1 (quotient fixnum-min fixnum-max)))
 558
 559     (pass-if "n = fixnum-max + 1"
 560       (eqv? -1 (quotient fixnum-min (+ fixnum-max 1))))
 561
 562     (pass-if "n = fixnum-min"
 563       (eqv? 1 (quotient fixnum-min fixnum-min)))
 564
 565     (pass-if "n = fixnum-min - 1"
 566       (eqv? 0 (quotient fixnum-min (- fixnum-min 1))))
 567
 568     (pass-if "n = - fixnum-min - 1"
 569       (eqv? -1 (quotient fixnum-min (1- (- fixnum-min)))))
 570
 571     ;; special case, normally inum/big is zero
 572     (pass-if "n = - fixnum-min"
 573       (eqv? -1 (quotient fixnum-min (- fixnum-min))))
 574
 575     (pass-if "n = - fixnum-min + 1"
 576       (eqv? 0 (quotient fixnum-min (1+ (- fixnum-min))))))
 577
 578   (with-test-prefix "(fixnum-min - 1) / n"
 579
 580     (pass-if "n = 1"
 581       (eqv? (- fixnum-min 1) (quotient (- fixnum-min 1) 1)))
 582
 583     (pass-if "n = -1"
 584       (eqv? (- (- fixnum-min 1)) (quotient (- fixnum-min 1) -1)))
 585
 586     (pass-if "n = 2"
 587       (eqv? fixnum-min (* (quotient (- fixnum-min 1) 2) 2)))
 588
 589     (pass-if "n = fixnum-max"
 590       (eqv? -1 (quotient (- fixnum-min 1) fixnum-max)))
 591
 592     (pass-if "n = fixnum-max + 1"
 593       (eqv? -1 (quotient (- fixnum-min 1) (+ fixnum-max 1))))
 594
 595     (pass-if "n = fixnum-min"
 596       (eqv? 1 (quotient (- fixnum-min 1) fixnum-min)))
 597
 598     (pass-if "n = fixnum-min - 1"
 599       (eqv? 1 (quotient (- fixnum-min 1) (- fixnum-min 1)))))
 600
 601   ;; Positive dividend and divisor
 602
 603   (pass-if "35 / 7"
 604     (eqv? 5 (quotient 35 7)))
 605
 606   ;; Negative dividend, positive divisor
 607
 608   (pass-if "-35 / 7"
 609     (eqv? -5 (quotient -35 7)))
 610
 611   ;; Positive dividend, negative divisor
 612
 613   (pass-if "35 / -7"
 614     (eqv? -5 (quotient 35 -7)))
 615
 616   ;; Negative dividend and divisor
 617
 618   (pass-if "-35 / -7"
 619     (eqv? 5 (quotient -35 -7)))
 620
 621   ;; Are numerical overflows detected correctly?
 622
 623   (with-test-prefix "division by zero"
 624
 625     (pass-if-exception "(quotient 1 0)"
 626       exception:numerical-overflow
 627       (quotient 1 0))
 628
 629     (pass-if-exception "(quotient bignum 0)"
 630       exception:numerical-overflow
 631       (quotient (+ fixnum-max 1) 0)))
 632
 633   ;; Are wrong type arguments detected correctly?
 634
 635   )
 636
 637 ;;;
 638 ;;; remainder
 639 ;;;
 640
 641 (with-test-prefix "remainder"
 642   (pass-if (documented? remainder))
 643
 644   (with-test-prefix "0 / n"
 645
 646     (pass-if "n = 1"
 647       (eqv? 0 (remainder 0 1)))
 648
 649     (pass-if "n = -1"
 650       (eqv? 0 (remainder 0 -1)))
 651
 652     (pass-if "n = fixnum-max"
 653       (eqv? 0 (remainder 0 fixnum-max)))
 654
 655     (pass-if "n = fixnum-max + 1"
 656       (eqv? 0 (remainder 0 (+ fixnum-max 1))))
 657
 658     (pass-if "n = fixnum-min"
 659       (eqv? 0 (remainder 0 fixnum-min)))
 660
 661     (pass-if "n = fixnum-min - 1"
 662       (eqv? 0 (remainder 0 (- fixnum-min 1)))))
 663
 664   (with-test-prefix "1 / n"
 665
 666     (pass-if "n = 1"
 667       (eqv? 0 (remainder 1 1)))
 668
 669     (pass-if "n = -1"
 670       (eqv? 0 (remainder 1 -1)))
 671
 672     (pass-if "n = fixnum-max"
 673       (eqv? 1 (remainder 1 fixnum-max)))
 674
 675     (pass-if "n = fixnum-max + 1"
 676       (eqv? 1 (remainder 1 (+ fixnum-max 1))))
 677
 678     (pass-if "n = fixnum-min"
 679       (eqv? 1 (remainder 1 fixnum-min)))
 680
 681     (pass-if "n = fixnum-min - 1"
 682       (eqv? 1 (remainder 1 (- fixnum-min 1)))))
 683
 684   (with-test-prefix "-1 / n"
 685
 686     (pass-if "n = 1"
 687       (eqv? 0 (remainder -1 1)))
 688
 689     (pass-if "n = -1"
 690       (eqv? 0 (remainder -1 -1)))
 691
 692     (pass-if "n = fixnum-max"
 693       (eqv? -1 (remainder -1 fixnum-max)))
 694
 695     (pass-if "n = fixnum-max + 1"
 696       (eqv? -1 (remainder -1 (+ fixnum-max 1))))
 697
 698     (pass-if "n = fixnum-min"
 699       (eqv? -1 (remainder -1 fixnum-min)))
 700
 701     (pass-if "n = fixnum-min - 1"
 702       (eqv? -1 (remainder -1 (- fixnum-min 1)))))
 703
 704   (with-test-prefix "fixnum-max / n"
 705
 706     (pass-if "n = 1"
 707       (eqv? 0 (remainder fixnum-max 1)))
 708
 709     (pass-if "n = -1"
 710       (eqv? 0 (remainder fixnum-max -1)))
 711
 712     (pass-if "n = fixnum-max"
 713       (eqv? 0 (remainder fixnum-max fixnum-max)))
 714
 715     (pass-if "n = fixnum-max + 1"
 716       (eqv? fixnum-max (remainder fixnum-max (+ fixnum-max 1))))
 717
 718     (pass-if "n = fixnum-min"
 719       (eqv? fixnum-max (remainder fixnum-max fixnum-min)))
 720
 721     (pass-if "n = fixnum-min - 1"
 722       (eqv? fixnum-max (remainder fixnum-max (- fixnum-min 1)))))
 723
 724   (with-test-prefix "(fixnum-max + 1) / n"
 725
 726     (pass-if "n = 1"
 727       (eqv? 0 (remainder (+ fixnum-max 1) 1)))
 728
 729     (pass-if "n = -1"
 730       (eqv? 0 (remainder (+ fixnum-max 1) -1)))
 731
 732     (pass-if "n = fixnum-max"
 733       (eqv? 1 (remainder (+ fixnum-max 1) fixnum-max)))
 734
 735     (pass-if "n = fixnum-max + 1"
 736       (eqv? 0 (remainder (+ fixnum-max 1) (+ fixnum-max 1))))
 737
 738     (pass-if "n = fixnum-min"
 739       (eqv? 0 (remainder (+ fixnum-max 1) fixnum-min)))
 740
 741     (pass-if "n = fixnum-min - 1"
 742       (eqv? (+ fixnum-max 1) (remainder (+ fixnum-max 1) (- fixnum-min 1)))))
 743
 744   (with-test-prefix "fixnum-min / n"
 745
 746     (pass-if "n = 1"
 747       (eqv? 0 (remainder fixnum-min 1)))
 748
 749     (pass-if "n = -1"
 750       (eqv? 0 (remainder fixnum-min -1)))
 751
 752     (pass-if "n = fixnum-max"
 753       (eqv? -1 (remainder fixnum-min fixnum-max)))
 754
 755     (pass-if "n = fixnum-max + 1"
 756       (eqv? 0 (remainder fixnum-min (+ fixnum-max 1))))
 757
 758     (pass-if "n = fixnum-min"
 759       (eqv? 0 (remainder fixnum-min fixnum-min)))
 760
 761     (pass-if "n = fixnum-min - 1"
 762       (eqv? fixnum-min (remainder fixnum-min (- fixnum-min 1))))
 763
 764     (pass-if "n = - fixnum-min - 1"
 765       (eqv? -1 (remainder fixnum-min (1- (- fixnum-min)))))
 766
 767     ;; special case, normally inum%big is the inum
 768     (pass-if "n = - fixnum-min"
 769       (eqv? 0 (remainder fixnum-min (- fixnum-min))))
 770
 771     (pass-if "n = - fixnum-min + 1"
 772       (eqv? fixnum-min (remainder fixnum-min (1+ (- fixnum-min))))))
 773
 774   (with-test-prefix "(fixnum-min - 1) / n"
 775
 776     (pass-if "n = 1"
 777       (eqv? 0 (remainder (- fixnum-min 1) 1)))
 778
 779     (pass-if "n = -1"
 780       (eqv? 0 (remainder (- fixnum-min 1) -1)))
 781
 782     (pass-if "n = fixnum-max"
 783       (eqv? -2 (remainder (- fixnum-min 1) fixnum-max)))
 784
 785     (pass-if "n = fixnum-max + 1"
 786       (eqv? -1 (remainder (- fixnum-min 1) (+ fixnum-max 1))))
 787
 788     (pass-if "n = fixnum-min"
 789       (eqv? -1 (remainder (- fixnum-min 1) fixnum-min)))
 790
 791     (pass-if "n = fixnum-min - 1"
 792       (eqv? 0 (remainder (- fixnum-min 1) (- fixnum-min 1)))))
 793
 794   ;; Positive dividend and divisor
 795
 796   (pass-if "35 / 7"
 797     (eqv? 0 (remainder 35 7)))
 798
 799   ;; Negative dividend, positive divisor
 800
 801   (pass-if "-35 / 7"
 802     (eqv? 0 (remainder -35 7)))
 803
 804   ;; Positive dividend, negative divisor
 805
 806   (pass-if "35 / -7"
 807     (eqv? 0 (remainder 35 -7)))
 808
 809   ;; Negative dividend and divisor
 810
 811   (pass-if "-35 / -7"
 812     (eqv? 0 (remainder -35 -7)))
 813
 814   ;; Are numerical overflows detected correctly?
 815
 816   (with-test-prefix "division by zero"
 817
 818     (pass-if-exception "(remainder 1 0)"
 819       exception:numerical-overflow
 820       (remainder 1 0))
 821
 822     (pass-if-exception "(remainder bignum 0)"
 823       exception:numerical-overflow
 824       (remainder (+ fixnum-max 1) 0)))
 825
 826   ;; Are wrong type arguments detected correctly?
 827
 828   )
 829
 830 ;;;
 831 ;;; modulo
 832 ;;;
 833
 834 (with-test-prefix "modulo"
 835   (pass-if (documented? modulo))
 836
 837   (with-test-prefix "0 % n"
 838
 839     (pass-if "n = 1"
 840       (eqv? 0 (modulo 0 1)))
 841
 842     (pass-if "n = -1"
 843       (eqv? 0 (modulo 0 -1)))
 844
 845     (pass-if "n = fixnum-max"
 846       (eqv? 0 (modulo 0 fixnum-max)))
 847
 848     (pass-if "n = fixnum-max + 1"
 849       (eqv? 0 (modulo 0 (+ fixnum-max 1))))
 850
 851     (pass-if "n = fixnum-min"
 852       (eqv? 0 (modulo 0 fixnum-min)))
 853
 854     (pass-if "n = fixnum-min - 1"
 855       (eqv? 0 (modulo 0 (- fixnum-min 1)))))
 856
 857   (with-test-prefix "1 % n"
 858
 859     (pass-if "n = 1"
 860       (eqv? 0 (modulo 1 1)))
 861
 862     (pass-if "n = -1"
 863       (eqv? 0 (modulo 1 -1)))
 864
 865     (pass-if "n = fixnum-max"
 866       (eqv? 1 (modulo 1 fixnum-max)))
 867
 868     (pass-if "n = fixnum-max + 1"
 869       (eqv? 1 (modulo 1 (+ fixnum-max 1))))
 870
 871     (pass-if "n = fixnum-min"
 872       (eqv? (+ fixnum-min 1) (modulo 1 fixnum-min)))
 873
 874     (pass-if "n = fixnum-min - 1"
 875       (eqv? fixnum-min (modulo 1 (- fixnum-min 1)))))
 876
 877   (with-test-prefix "-1 % n"
 878
 879     (pass-if "n = 1"
 880       (eqv? 0 (modulo -1 1)))
 881
 882     (pass-if "n = -1"
 883       (eqv? 0 (modulo -1 -1)))
 884
 885     (pass-if "n = fixnum-max"
 886       (eqv? (- fixnum-max 1) (modulo -1 fixnum-max)))
 887
 888     (pass-if "n = fixnum-max + 1"
 889       (eqv? fixnum-max (modulo -1 (+ fixnum-max 1))))
 890
 891     (pass-if "n = fixnum-min"
 892       (eqv? -1 (modulo -1 fixnum-min)))
 893
 894     (pass-if "n = fixnum-min - 1"
 895       (eqv? -1 (modulo -1 (- fixnum-min 1)))))
 896
 897   (with-test-prefix "fixnum-max % n"
 898
 899     (pass-if "n = 1"
 900       (eqv? 0 (modulo fixnum-max 1)))
 901
 902     (pass-if "n = -1"
 903       (eqv? 0 (modulo fixnum-max -1)))
 904
 905     (pass-if "n = fixnum-max"
 906       (eqv? 0 (modulo fixnum-max fixnum-max)))
 907
 908     (pass-if "n = fixnum-max + 1"
 909       (eqv? fixnum-max (modulo fixnum-max (+ fixnum-max 1))))
 910
 911     (pass-if "n = fixnum-min"
 912       (eqv? -1 (modulo fixnum-max fixnum-min)))
 913
 914     (pass-if "n = fixnum-min - 1"
 915       (eqv? -2 (modulo fixnum-max (- fixnum-min 1)))))
 916
 917   (with-test-prefix "(fixnum-max + 1) % n"
 918
 919     (pass-if "n = 1"
 920       (eqv? 0 (modulo (+ fixnum-max 1) 1)))
 921
 922     (pass-if "n = -1"
 923       (eqv? 0 (modulo (+ fixnum-max 1) -1)))
 924
 925     (pass-if "n = fixnum-max"
 926       (eqv? 1 (modulo (+ fixnum-max 1) fixnum-max)))
 927
 928     (pass-if "n = fixnum-max + 1"
 929       (eqv? 0 (modulo (+ fixnum-max 1) (+ fixnum-max 1))))
 930
 931     (pass-if "n = fixnum-min"
 932       (eqv? 0 (modulo (+ fixnum-max 1) fixnum-min)))
 933
 934     (pass-if "n = fixnum-min - 1"
 935       (eqv? -1 (modulo (+ fixnum-max 1) (- fixnum-min 1)))))
 936
 937   (with-test-prefix "fixnum-min % n"
 938
 939     (pass-if "n = 1"
 940       (eqv? 0 (modulo fixnum-min 1)))
 941
 942     (pass-if "n = -1"
 943       (eqv? 0 (modulo fixnum-min -1)))
 944
 945     (pass-if "n = fixnum-max"
 946       (eqv? (- fixnum-max 1) (modulo fixnum-min fixnum-max)))
 947
 948     (pass-if "n = fixnum-max + 1"
 949       (eqv? 0 (modulo fixnum-min (+ fixnum-max 1))))
 950
 951     (pass-if "n = fixnum-min"
 952       (eqv? 0 (modulo fixnum-min fixnum-min)))
 953
 954     (pass-if "n = fixnum-min - 1"
 955       (eqv? fixnum-min (modulo fixnum-min (- fixnum-min 1)))))
 956
 957   (with-test-prefix "(fixnum-min - 1) % n"
 958
 959     (pass-if "n = 1"
 960       (eqv? 0 (modulo (- fixnum-min 1) 1)))
 961
 962     (pass-if "n = -1"
 963       (eqv? 0 (modulo (- fixnum-min 1) -1)))
 964
 965     (pass-if "n = fixnum-max"
 966       (eqv? (- fixnum-max 2) (modulo (- fixnum-min 1) fixnum-max)))
 967
 968     (pass-if "n = fixnum-max + 1"
 969       (eqv? fixnum-max (modulo (- fixnum-min 1) (+ fixnum-max 1))))
 970
 971     (pass-if "n = fixnum-min"
 972       (eqv? -1 (modulo (- fixnum-min 1) fixnum-min)))
 973
 974     (pass-if "n = fixnum-min - 1"
 975       (eqv? 0 (modulo (- fixnum-min 1) (- fixnum-min 1)))))
 976
 977   ;; Positive dividend and divisor
 978
 979   (pass-if "13 % 4"
 980     (eqv? 1 (modulo 13 4)))
 981
 982   (pass-if "2177452800 % 86400"
 983     (eqv? 0 (modulo 2177452800 86400)))
 984
 985   ;; Negative dividend, positive divisor
 986
 987   (pass-if "-13 % 4"
 988     (eqv? 3 (modulo -13 4)))
 989
 990   (pass-if "-2177452800 % 86400"
 991     (eqv? 0 (modulo -2177452800 86400)))
 992
 993   ;; Positive dividend, negative divisor
 994
 995   (pass-if "13 % -4"
 996     (eqv? -3 (modulo 13 -4)))
 997
 998   (pass-if "2177452800 % -86400"
 999     (eqv? 0 (modulo 2177452800 -86400)))
1000
1001   ;; Negative dividend and divisor
1002
1003   (pass-if "-13 % -4"
1004     (eqv? -1 (modulo -13 -4)))
1005
1006   (pass-if "-2177452800 % -86400"
1007     (eqv? 0 (modulo -2177452800 -86400)))
1008
1009   ;; Are numerical overflows detected correctly?
1010
1011   (with-test-prefix "division by zero"
1012
1013     (pass-if-exception "(modulo 1 0)"
1014       exception:numerical-overflow
1015       (modulo 1 0))
1016
1017     (pass-if-exception "(modulo bignum 0)"
1018       exception:numerical-overflow
1019       (modulo (+ fixnum-max 1) 0)))
1020
1021   ;; Are wrong type arguments detected correctly?
1022
1023   )
1024
1025 ;;;
1026 ;;; modulo-expt
1027 ;;;
1028
1029 (with-test-prefix "modulo-expt"
1030    (pass-if (= 1 (modulo-expt 17 23 47)))
1031
1032    (pass-if (= 1 (modulo-expt 17 -23 47)))
1033
1034    (pass-if (= 17 (modulo-expt 17 -22 47)))
1035
1036    (pass-if (= 36 (modulo-expt 17 22 47)))
1037
1038    (pass-if (= 183658794479969134816674175082294846241553725240 (modulo-expt 111122223333444455556666 111122223333444455556666 1153478690012629968439432872520758982731022934717)))
1039
1040    (pass-if-exception
1041     "Proper exception with 0 modulus"
1042     exception:numerical-overflow
1043     (modulo-expt 17 23 0))
1044
1045    (pass-if-exception
1046     "Proper exception when result not invertible"
1047     exception:numerical-overflow
1048     (modulo-expt 10 -1 48))
1049
1050    (pass-if-exception
1051     "Proper exception with wrong type argument"
1052     exception:wrong-type-arg
1053     (modulo-expt "Sam" 23 10))
1054
1055    (pass-if-exception
1056     "Proper exception with wrong type argument"
1057     exception:wrong-type-arg
1058     (modulo-expt 17 9.9 10))
1059
1060     (pass-if-exception
1061     "Proper exception with wrong type argument"
1062     exception:wrong-type-arg
1063     (modulo-expt 17 23 'Ethel)))
1064
1065 ;;;
1066 ;;; numerator
1067 ;;;
1068
1069 (with-test-prefix "numerator"
1070   (pass-if "0"
1071     (eqv? 0 (numerator 0)))
1072   (pass-if "1"
1073     (eqv? 1 (numerator 1)))
1074   (pass-if "2"
1075     (eqv? 2 (numerator 2)))
1076   (pass-if "-1"
1077     (eqv? -1 (numerator -1)))
1078   (pass-if "-2"
1079     (eqv? -2 (numerator -2)))
1080
1081   (pass-if "0.0"
1082     (eqv? 0.0 (numerator 0.0)))
1083   (pass-if "1.0"
1084     (eqv? 1.0 (numerator 1.0)))
1085   (pass-if "2.0"
1086     (eqv? 2.0 (numerator 2.0)))
1087   (pass-if "-1.0"
1088     (eqv? -1.0 (numerator -1.0)))
1089   (pass-if "-2.0"
1090     (eqv? -2.0 (numerator -2.0)))
1091
1092   (pass-if "0.5"
1093     (eqv? 1.0 (numerator 0.5)))
1094   (pass-if "0.25"
1095     (eqv? 1.0 (numerator 0.25)))
1096   (pass-if "0.75"
1097     (eqv? 3.0 (numerator 0.75))))
1098
1099 ;;;
1100 ;;; denominator
1101 ;;;
1102
1103 (with-test-prefix "denominator"
1104   (pass-if "0"
1105     (eqv? 1 (denominator 0)))
1106   (pass-if "1"
1107     (eqv? 1 (denominator 1)))
1108   (pass-if "2"
1109     (eqv? 1 (denominator 2)))
1110   (pass-if "-1"
1111     (eqv? 1 (denominator -1)))
1112   (pass-if "-2"
1113     (eqv? 1 (denominator -2)))
1114
1115   (pass-if "0.0"
1116     (eqv? 1.0 (denominator 0.0)))
1117   (pass-if "1.0"
1118     (eqv? 1.0 (denominator 1.0)))
1119   (pass-if "2.0"
1120     (eqv? 1.0 (denominator 2.0)))
1121   (pass-if "-1.0"
1122     (eqv? 1.0 (denominator -1.0)))
1123   (pass-if "-2.0"
1124     (eqv? 1.0 (denominator -2.0)))
1125
1126   (pass-if "0.5"
1127     (eqv? 2.0 (denominator 0.5)))
1128   (pass-if "0.25"
1129     (eqv? 4.0 (denominator 0.25)))
1130   (pass-if "0.75"
1131     (eqv? 4.0 (denominator 0.75))))
1132
1133 ;;;
1134 ;;; gcd
1135 ;;;
1136
1137 (with-test-prefix "gcd"
1138
1139   (pass-if "documented?"
1140     (documented? gcd))
1141
1142   (with-test-prefix "(n)"
1143
1144     (pass-if "n = -2"
1145       (eqv? 2 (gcd -2))))
1146
1147   (with-test-prefix "(0 n)"
1148
1149     (pass-if "n = 0"
1150       (eqv? 0 (gcd 0 0)))
1151
1152     (pass-if "n = 1"
1153       (eqv? 1 (gcd 0 1)))
1154
1155     (pass-if "n = -1"
1156       (eqv? 1 (gcd 0 -1)))
1157
1158     (pass-if "n = fixnum-max"
1159       (eqv? fixnum-max (gcd 0 fixnum-max)))
1160
1161     (pass-if "n = fixnum-max + 1"
1162       (eqv? (+ fixnum-max 1) (gcd 0 (+ fixnum-max 1))))
1163
1164     (pass-if "n = fixnum-min"
1165       (eqv? (- fixnum-min) (gcd 0 fixnum-min)))
1166
1167     (pass-if "n = fixnum-min - 1"
1168       (eqv? (- (- fixnum-min 1)) (gcd 0 (- fixnum-min 1)))))
1169
1170   (with-test-prefix "(n 0)"
1171
1172     (pass-if "n = 2^128 * fixnum-max"
1173       (eqv? (ash fixnum-max 128) (gcd (ash fixnum-max 128) 0))))
1174
1175   (with-test-prefix "(1 n)"
1176
1177     (pass-if "n = 0"
1178       (eqv? 1 (gcd 1 0)))
1179
1180     (pass-if "n = 1"
1181       (eqv? 1 (gcd 1 1)))
1182
1183     (pass-if "n = -1"
1184       (eqv? 1 (gcd 1 -1)))
1185
1186     (pass-if "n = fixnum-max"
1187       (eqv? 1 (gcd 1 fixnum-max)))
1188
1189     (pass-if "n = fixnum-max + 1"
1190       (eqv? 1 (gcd 1 (+ fixnum-max 1))))
1191
1192     (pass-if "n = fixnum-min"
1193       (eqv? 1 (gcd 1 fixnum-min)))
1194
1195     (pass-if "n = fixnum-min - 1"
1196       (eqv? 1 (gcd 1 (- fixnum-min 1)))))
1197
1198   (with-test-prefix "(-1 n)"
1199
1200     (pass-if "n = 0"
1201       (eqv? 1 (gcd -1 0)))
1202
1203     (pass-if "n = 1"
1204       (eqv? 1 (gcd -1 1)))
1205
1206     (pass-if "n = -1"
1207       (eqv? 1 (gcd -1 -1)))
1208
1209     (pass-if "n = fixnum-max"
1210       (eqv? 1 (gcd -1 fixnum-max)))
1211
1212     (pass-if "n = fixnum-max + 1"
1213       (eqv? 1 (gcd -1 (+ fixnum-max 1))))
1214
1215     (pass-if "n = fixnum-min"
1216       (eqv? 1 (gcd -1 fixnum-min)))
1217
1218     (pass-if "n = fixnum-min - 1"
1219       (eqv? 1 (gcd -1 (- fixnum-min 1)))))
1220
1221   (with-test-prefix "(fixnum-max n)"
1222
1223     (pass-if "n = 0"
1224       (eqv? fixnum-max (gcd fixnum-max 0)))
1225
1226     (pass-if "n = 1"
1227       (eqv? 1 (gcd fixnum-max 1)))
1228
1229     (pass-if "n = -1"
1230       (eqv? 1 (gcd fixnum-max -1)))
1231
1232     (pass-if "n = fixnum-max"
1233       (eqv? fixnum-max (gcd fixnum-max fixnum-max)))
1234
1235     (pass-if "n = fixnum-max + 1"
1236       (eqv? 1 (gcd fixnum-max (+ fixnum-max 1))))
1237
1238     (pass-if "n = fixnum-min"
1239       (eqv? 1 (gcd fixnum-max fixnum-min)))
1240
1241     (pass-if "n = fixnum-min - 1"
1242       (eqv? 1 (gcd fixnum-max (- fixnum-min 1)))))
1243
1244   (with-test-prefix "((+ fixnum-max 1) n)"
1245
1246     (pass-if "n = 0"
1247       (eqv? (+ fixnum-max 1) (gcd (+ fixnum-max 1) 0)))
1248
1249     (pass-if "n = 1"
1250       (eqv? 1 (gcd (+ fixnum-max 1) 1)))
1251
1252     (pass-if "n = -1"
1253       (eqv? 1 (gcd (+ fixnum-max 1) -1)))
1254
1255     (pass-if "n = fixnum-max"
1256       (eqv? 1 (gcd (+ fixnum-max 1) fixnum-max)))
1257
1258     (pass-if "n = fixnum-max + 1"
1259       (eqv? (+ fixnum-max 1) (gcd (+ fixnum-max 1) (+ fixnum-max 1))))
1260
1261     (pass-if "n = fixnum-min"
1262       (eqv? (+ fixnum-max 1) (gcd (+ fixnum-max 1) fixnum-min)))
1263
1264     (pass-if "n = fixnum-min - 1"
1265       (eqv? 1 (gcd (+ fixnum-max 1) (- fixnum-min 1)))))
1266
1267   (with-test-prefix "(fixnum-min n)"
1268
1269     (pass-if "n = 0"
1270       (eqv? (- fixnum-min) (gcd fixnum-min 0)))
1271
1272     (pass-if "n = 1"
1273       (eqv? 1 (gcd fixnum-min 1)))
1274
1275     (pass-if "n = -1"
1276       (eqv? 1 (gcd fixnum-min -1)))
1277
1278     (pass-if "n = fixnum-max"
1279       (eqv? 1 (gcd fixnum-min fixnum-max)))
1280
1281     (pass-if "n = fixnum-max + 1"
1282       (eqv? (+ fixnum-max 1) (gcd fixnum-min (+ fixnum-max 1))))
1283
1284     (pass-if "n = fixnum-min"
1285       (eqv? (- fixnum-min) (gcd fixnum-min fixnum-min)))
1286
1287     (pass-if "n = fixnum-min - 1"
1288       (eqv? 1 (gcd fixnum-min (- fixnum-min 1)))))
1289
1290   (with-test-prefix "((- fixnum-min 1) n)"
1291
1292     (pass-if "n = 0"
1293       (eqv? (- (- fixnum-min 1)) (gcd (- fixnum-min 1) 0)))
1294
1295     (pass-if "n = 1"
1296       (eqv? 1 (gcd (- fixnum-min 1) 1)))
1297
1298     (pass-if "n = -1"
1299       (eqv? 1 (gcd (- fixnum-min 1) -1)))
1300
1301     (pass-if "n = fixnum-max"
1302       (eqv? 1 (gcd (- fixnum-min 1) fixnum-max)))
1303
1304     (pass-if "n = fixnum-max + 1"
1305       (eqv? 1 (gcd (- fixnum-min 1) (+ fixnum-max 1))))
1306
1307     (pass-if "n = fixnum-min"
1308       (eqv? 1 (gcd (- fixnum-min 1) fixnum-min)))
1309
1310     (pass-if "n = fixnum-min - 1"
1311       (eqv? (- (- fixnum-min 1)) (gcd (- fixnum-min 1) (- fixnum-min 1)))))
1312
1313   ;; Are wrong type arguments detected correctly?
1314
1315   )
1316
1317 ;;;
1318 ;;; lcm
1319 ;;;
1320
1321 (with-test-prefix "lcm"
1322   ;; FIXME: more tests?
1323   ;; (some of these are already in r4rs.test)
1324   (pass-if (documented? lcm))
1325   (pass-if (= (lcm) 1))
1326   (pass-if (= (lcm 32 -36) 288))
1327   (let ((big-n 115792089237316195423570985008687907853269984665640564039457584007913129639936) ; 2 ^ 256
1328         (lcm-of-big-n-and-11 1273712981610478149659280835095566986385969831322046204434033424087044426039296))
1329     (pass-if (= lcm-of-big-n-and-11 (lcm big-n 11)))
1330     (pass-if (= lcm-of-big-n-and-11 (lcm 11 big-n 11)))))
1331
1332 ;;;
1333 ;;; number->string
1334 ;;;
1335
1336 (with-test-prefix "number->string"
1337   (let ((num->str->num
1338          (lambda (n radix)
1339            (string->number (number->string n radix) radix))))
1340
1341     (pass-if (documented? number->string))
1342     (pass-if (string=? (number->string 0) "0"))
1343     (pass-if (string=? (number->string 171) "171"))
1344     (pass-if (= (+ fixnum-max 1) (num->str->num (+ fixnum-max 1) 10)))
1345     (pass-if (= (- fixnum-min 1) (num->str->num (- fixnum-min 1) 10)))
1346     (pass-if (= (inf) (num->str->num (inf) 10)))
1347     (pass-if (= 1.3 (num->str->num 1.3 10)))
1348
1349     ;; XXX - some results depend on whether Guile is compiled optimzed
1350     ;; or not.  It is clearly undesirable to have number->string to be
1351     ;; influenced by this.
1352
1353     (pass-if (string=? (number->string 35.25 36) "z.9"))
1354     (pass-if (or (string=? (number->string 0.25 2) "0.01")
1355                  (string=? (number->string 0.25 2) "0.010")))
1356     (pass-if (string=? (number->string 255.0625 16) "ff.1"))
1357     (pass-if (string=? (number->string (/ 1 3) 3) "1/10"))
1358
1359     (pass-if (string=? (number->string 10) "10"))
1360     (pass-if (string=? (number->string 10 11) "a"))
1361     (pass-if (string=? (number->string 36 36) "10"))
1362     (pass-if (= (num->str->num 36 36) 36))
1363     (pass-if (= (string->number "z" 36) 35))
1364     (pass-if (= (string->number "Z" 36) 35))
1365     (pass-if (not (string->number "Z" 35)))
1366     (pass-if (string=? (number->string 35 36) "z"))
1367     (pass-if (= (num->str->num 35 36) 35))
1368
1369     ;; Numeric conversion from decimal is not precise, in its current
1370     ;; implementation, so 11.333... and 1.324... can't be expected to
1371     ;; reliably come out to precise values.  These tests did actually work
1372     ;; for a while, but something in gcc changed, affecting the conversion
1373     ;; code.
1374     ;;
1375     ;; (pass-if (or (string=? (number->string 11.33333333333333333 12)
1376     ;;                        "B.4")
1377     ;;              (string=? (number->string 11.33333333333333333 12)
1378     ;;                        "B.400000000000009")))
1379     ;; (pass-if (or (string=? (number->string 1.324e44 16)
1380     ;;                        "5.EFE0A14FAFEe24")
1381     ;;              (string=? (number->string 1.324e44 16)
1382     ;;                        "5.EFE0A14FAFDF8e24")))
1383     ))
1384
1385 ;;;
1386 ;;; string->number
1387 ;;;
1388
1389 (with-test-prefix "string->number"
1390
1391   (pass-if "documented?"
1392     (documented? string->number))
1393
1394   (pass-if "non number strings"
1395     (for-each (lambda (x) (if (string->number x) (throw 'fail)))
1396               '("" "q" "1q" "6+7iq" "8+9q" "10+11" "13+" "18@19q" "20@q" "23@"
1397                 "+25iq" "26i" "-q" "-iq" "i" "5#.0" "8/" "10#11" ".#" "."
1398                 "#o.2" "3.4q" "15.16e17q" "18.19e+q" ".q" ".17#18" "10q" "#b2"
1399                 "#b3" "#b4" "#b5" "#b6" "#b7" "#b8" "#b9" "#ba" "#bb" "#bc"
1400                 "#bd" "#be" "#bf" "#q" "#b#b1" "#o#o1" "#d#d1" "#x#x1" "#e#e1"
1401                 "#i#i1" "12@12+0i"))
1402     #t)
1403
1404   (pass-if "valid number strings"
1405     (for-each (lambda (couple)
1406                 (apply
1407                  (lambda (x y)
1408                    (let ((xx (string->number x)))
1409                      (if (or (eq? xx #f) (not (eqv? xx y)))
1410                          (begin
1411                            (pk x y)
1412                            (throw 'fail)))))
1413                  couple))
1414               `(;; Radix:
1415                 ("#b0" 0) ("#B0" 0) ("#b1" 1) ("#B1" 1) ("#o0" 0) ("#O0" 0)
1416                 ("#o1" 1) ("#O1" 1) ("#o2" 2) ("#O2" 2) ("#o3" 3) ("#O3" 3)
1417                 ("#o4" 4) ("#O4" 4) ("#o5" 5) ("#O5" 5) ("#o6" 6) ("#O6" 6)
1418                 ("#o7" 7) ("#O7" 7) ("#d0" 0) ("#D0" 0) ("#d1" 1) ("#D1" 1)
1419                 ("#d2" 2) ("#D2" 2) ("#d3" 3) ("#D3" 3) ("#d4" 4) ("#D4" 4)
1420                 ("#d5" 5) ("#D5" 5) ("#d6" 6) ("#D6" 6) ("#d7" 7) ("#D7" 7)
1421                 ("#d8" 8) ("#D8" 8) ("#d9" 9) ("#D9" 9)
1422                 ("#xa" 10) ("#Xa" 10) ("#xb" 11) ("#Xb" 11)
1423                 ("#xc" 12) ("#Xc" 12) ("#xd" 13) ("#Xd" 13)
1424                 ("#xe" 14) ("#Xe" 14) ("#xf" 15) ("#Xf" 15)
1425                 ("#b1010" 10)
1426                 ("#o12345670" 2739128)
1427                 ("#d1234567890" 1234567890)
1428                 ("#x1234567890abcdef" 1311768467294899695)
1429                 ;; Exactness:
1430                 ("#e1" 1) ("#e1.2" 12/10)
1431                 ("#i1.1" 1.1) ("#i1" 1.0)
1432                 ;; Integers:
1433                 ("1" ,(1+ 0)) ("23" ,(+ 9 9 5)) ("-1" ,(- 0 1))
1434                 ("-45" ,(- 0 45)) ("2#" 20.0) ("2##" 200.0) ("12##" 1200.0)
1435                 ("#b#i100" 4.0)
1436                 ;; Fractions:
1437                 ("1/1" 1) ("1/2" 1/2) ("-1/2" -1/2) ("1#/1" 10.0)
1438                 ("10/1#" 1.0) ("1#/1#" 1.0) ("#e9/10" 9/10) ("#e10/1#" 1)
1439                 ("#i6/8" 0.75) ("#i1/1" 1.0)
1440                 ;; Decimal numbers:
1441                 ;; * <uinteger 10> <suffix>
1442                 ("1e2" 100.0) ("1E2" 100.0) ("1s2" 100.0) ("1S2" 100.0)
1443                 ("1f2" 100.0) ("1F2" 100.0) ("1d2" 100.0) ("1D2" 100.0)
1444                 ("1l2" 100.0) ("1L2" 100.0) ("1e+2" 100.0) ("1e-2" 0.01)
1445                 ;; * . <digit 10>+ #* <suffix>
1446                 (".1" .1) (".0123456789" 123456789e-10) (".16#" 0.16)
1447                 (".0123456789e10" 123456789.0) (".16#e3" 160.0) ("#d.3" 0.3)
1448                 ;; * <digit 10>+ . <digit 10>* #* <suffix>
1449                 ("3." ,(exact->inexact 3)) ("3.e0" ,(exact->inexact 3))
1450                 ("3.1" ,(exact->inexact 31/10)) ("3.1e0" 3.1) ("3.1#" 3.1)
1451                 ("3.1#e0" 3.1)
1452                 ;; * <digit 10>+ #+ . #* <suffix>
1453                 ("3#." 30.0) ("3#.e0" 30.0) ("3#.#" 30.0) ("3#.#e0" 30.0)
1454                 ;; Complex:
1455                 ("1@0" 1.0) ("1@+0" 1.0) ("1@-0" 1.0)
1456                 ("2+3i" ,(+ 2 (* 3 +i))) ("4-5i" ,(- 4 (* 5 +i)))
1457                 ("1+i" 1+1i) ("1-i" 1-1i) ("+1i" 0+1i) ("-1i" 0-1i)
1458                 ("+i" +1i) ("-i" -1i)
1459                 ("1.0+.1i" 1.0+0.1i)
1460                 ("1.0-.1i" 1.0-0.1i)
1461                 (".1+.0i" 0.1)
1462                 ("1.+.0i" 1.0)
1463                 (".1+.1i" 0.1+0.1i)
1464                 ("1e1+.1i" 10+0.1i)
1465                 ))
1466     #t)
1467
1468   (pass-if-exception "exponent too big"
1469     exception:out-of-range
1470     (string->number "12.13e141414"))
1471
1472   ;; in guile 1.6.7 and earlier, bad polar forms (where the conversion of
1473   ;; the angle gave #f) caused a segv
1474   (pass-if "1@a"
1475     (eq? #f (string->number "1@a"))))
1476
1477 ;;;
1478 ;;; number?
1479 ;;;
1480
1481 (with-test-prefix "number?"
1482   (pass-if (documented? number?))
1483   (pass-if (number? 0))
1484   (pass-if (number? 7))
1485   (pass-if (number? -7))
1486   (pass-if (number? 1.3))
1487   (pass-if (number? (+ 1 fixnum-max)))
1488   (pass-if (number? (- 1 fixnum-min)))
1489   (pass-if (number? 3+4i))
1490   (pass-if (not (number? #\a)))
1491   (pass-if (not (number? "a")))
1492   (pass-if (not (number? (make-vector 0))))
1493   (pass-if (not (number? (cons 1 2))))
1494   (pass-if (not (number? #t)))
1495   (pass-if (not (number? (lambda () #t))))
1496   (pass-if (not (number? (current-input-port)))))
1497
1498 ;;;
1499 ;;; complex?
1500 ;;;
1501
1502 (with-test-prefix "complex?"
1503   (pass-if (documented? complex?))
1504   (pass-if (complex? 0))
1505   (pass-if (complex? 7))
1506   (pass-if (complex? -7))
1507   (pass-if (complex? (+ 1 fixnum-max)))
1508   (pass-if (complex? (- 1 fixnum-min)))
1509   (pass-if (complex? 1.3))
1510   (pass-if (complex? 3+4i))
1511   (pass-if (not (complex? #\a)))
1512   (pass-if (not (complex? "a")))
1513   (pass-if (not (complex? (make-vector 0))))
1514   (pass-if (not (complex? (cons 1 2))))
1515   (pass-if (not (complex? #t)))
1516   (pass-if (not (complex? (lambda () #t))))
1517   (pass-if (not (complex? (current-input-port)))))
1518
1519 ;;;
1520 ;;; real?
1521 ;;;
1522
1523 (with-test-prefix "real?"
1524   (pass-if (documented? real?))
1525   (pass-if (real? 0))
1526   (pass-if (real? 7))
1527   (pass-if (real? -7))
1528   (pass-if (real? (+ 1 fixnum-max)))
1529   (pass-if (real? (- 1 fixnum-min)))
1530   (pass-if (real? 1.3))
1531   (pass-if (real? +inf.0))
1532   (pass-if (real? -inf.0))
1533   (pass-if (real? +nan.0))
1534   (pass-if (not (real? +inf.0-inf.0i)))
1535   (pass-if (not (real? +nan.0+nan.0i)))
1536   (pass-if (not (real? 3+4i)))
1537   (pass-if (not (real? #\a)))
1538   (pass-if (not (real? "a")))
1539   (pass-if (not (real? (make-vector 0))))
1540   (pass-if (not (real? (cons 1 2))))
1541   (pass-if (not (real? #t)))
1542   (pass-if (not (real? (lambda () #t))))
1543   (pass-if (not (real? (current-input-port)))))
1544
1545 ;;;
1546 ;;; rational?
1547 ;;;
1548
1549 (with-test-prefix "rational?"
1550   (pass-if (documented? rational?))
1551   (pass-if (rational? 0))
1552   (pass-if (rational? 7))
1553   (pass-if (rational? -7))
1554   (pass-if (rational? (+ 1 fixnum-max)))
1555   (pass-if (rational? (- 1 fixnum-min)))
1556   (pass-if (rational? 1.3))
1557   (pass-if (not (rational? +inf.0)))
1558   (pass-if (not (rational? -inf.0)))
1559   (pass-if (not (rational? +nan.0)))
1560   (pass-if (not (rational? +inf.0-inf.0i)))
1561   (pass-if (not (rational? +nan.0+nan.0i)))
1562   (pass-if (not (rational? 3+4i)))
1563   (pass-if (not (rational? #\a)))
1564   (pass-if (not (rational? "a")))
1565   (pass-if (not (rational? (make-vector 0))))
1566   (pass-if (not (rational? (cons 1 2))))
1567   (pass-if (not (rational? #t)))
1568   (pass-if (not (rational? (lambda () #t))))
1569   (pass-if (not (rational? (current-input-port)))))
1570
1571 ;;;
1572 ;;; integer?
1573 ;;;
1574
1575 (with-test-prefix "integer?"
1576   (pass-if (documented? integer?))
1577   (pass-if (integer? 0))
1578   (pass-if (integer? 7))
1579   (pass-if (integer? -7))
1580   (pass-if (integer? (+ 1 fixnum-max)))
1581   (pass-if (integer? (- 1 fixnum-min)))
1582   (pass-if (and (= 3+0i (round 3+0i)) (integer? 3+0i)))
1583   (pass-if (and (= 1.0 (round 1.0)) (integer? 1.0)))
1584   (pass-if (not (integer? 1.3)))
1585   (pass-if (not (integer? +inf.0)))
1586   (pass-if (not (integer? -inf.0)))
1587   (pass-if (not (integer? +nan.0)))
1588   (pass-if (not (integer? 3+4i)))
1589   (pass-if (not (integer? #\a)))
1590   (pass-if (not (integer? "a")))
1591   (pass-if (not (integer? (make-vector 0))))
1592   (pass-if (not (integer? (cons 1 2))))
1593   (pass-if (not (integer? #t)))
1594   (pass-if (not (integer? (lambda () #t))))
1595   (pass-if (not (integer? (current-input-port)))))
1596
1597 ;;;
1598 ;;; inexact?
1599 ;;;
1600
1601 (with-test-prefix "inexact?"
1602   (pass-if (documented? inexact?))
1603   (pass-if (not (inexact? 0)))
1604   (pass-if (not (inexact? 7)))
1605   (pass-if (not (inexact? -7)))
1606   (pass-if (not (inexact? (+ 1 fixnum-max))))
1607   (pass-if (not (inexact? (- 1 fixnum-min))))
1608   (pass-if (inexact? 1.3))
1609   (pass-if (inexact? 3.1+4.2i))
1610   (pass-if (inexact? +inf.0))
1611   (pass-if (inexact? -inf.0))
1612   (pass-if (inexact? +nan.0))
1613   (pass-if-exception "char"
1614                      exception:wrong-type-arg
1615                      (not (inexact? #\a)))
1616   (pass-if-exception "string"
1617                      exception:wrong-type-arg
1618                      (not (inexact? "a")))
1619   (pass-if-exception "vector"
1620                      exception:wrong-type-arg
1621                      (not (inexact? (make-vector 0))))
1622   (pass-if-exception "cons"
1623                      exception:wrong-type-arg
1624                      (not (inexact? (cons 1 2))))
1625   (pass-if-exception "bool"
1626                      exception:wrong-type-arg
1627                      (not (inexact? #t)))
1628   (pass-if-exception "procedure"
1629                      exception:wrong-type-arg
1630                      (not (inexact? (lambda () #t))))
1631   (pass-if-exception "port"
1632                      exception:wrong-type-arg
1633                      (not (inexact? (current-input-port)))))
1634
1635 ;;;
1636 ;;; equal?
1637 ;;;
1638
1639 (with-test-prefix "equal?"
1640   (pass-if (documented? equal?))
1641
1642   ;; The following test will fail on platforms
1643   ;; without distinct signed zeroes 0.0 and -0.0.
1644   (pass-if (not (equal? 0.0 -0.0)))
1645
1646   (pass-if (equal? 0 0))
1647   (pass-if (equal? 7 7))
1648   (pass-if (equal? -7 -7))
1649   (pass-if (equal? (+ 1 fixnum-max) (+ 1 fixnum-max)))
1650   (pass-if (equal? (- fixnum-min 1) (- fixnum-min 1)))
1651   (pass-if (equal?  0.0  0.0))
1652   (pass-if (equal? -0.0 -0.0))
1653   (pass-if (not (equal? 0 1)))
1654   (pass-if (not (equal? 0 0.0)))
1655   (pass-if (not (equal? 1 1.0)))
1656   (pass-if (not (equal? 0.0 0)))
1657   (pass-if (not (equal? 1.0 1)))
1658   (pass-if (not (equal? -1.0 -1)))
1659   (pass-if (not (equal? fixnum-max (+ 1 fixnum-max))))
1660   (pass-if (not (equal? (+ 1 fixnum-max) fixnum-max)))
1661   (pass-if (not (equal? (+ 1 fixnum-max) (+ 2 fixnum-max))))
1662   (pass-if (not (equal? fixnum-min (- fixnum-min 1))))
1663   (pass-if (not (equal? (- fixnum-min 1) fixnum-min)))
1664   (pass-if (not (equal? (- fixnum-min 1) (- fixnum-min 2))))
1665   (pass-if (not (equal? (+ fixnum-max 1) (- fixnum-min 1))))
1666
1667   (pass-if (not (equal? (ash 1 256) +inf.0)))
1668   (pass-if (not (equal? +inf.0 (ash 1 256))))
1669   (pass-if (not (equal? (ash 1 256) -inf.0)))
1670   (pass-if (not (equal? -inf.0 (ash 1 256))))
1671
1672   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
1673   ;; sure we've avoided that
1674   (pass-if (not (equal? (ash 1 1024) +inf.0)))
1675   (pass-if (not (equal? +inf.0 (ash 1 1024))))
1676   (pass-if (not (equal? (- (ash 1 1024)) -inf.0)))
1677   (pass-if (not (equal? -inf.0 (- (ash 1 1024)))))
1678
1679   (pass-if (equal? +nan.0 +nan.0))
1680   (pass-if (equal? +nan.0 +nan.0))
1681   (pass-if (not (equal? +nan.0 0.0+nan.0i)))
1682
1683   (pass-if (not (equal? 0 +nan.0)))
1684   (pass-if (not (equal? +nan.0 0)))
1685   (pass-if (not (equal? 1 +nan.0)))
1686   (pass-if (not (equal? +nan.0 1)))
1687   (pass-if (not (equal? -1 +nan.0)))
1688   (pass-if (not (equal? +nan.0 -1)))
1689
1690   (pass-if (not (equal? (ash 1 256) +nan.0)))
1691   (pass-if (not (equal? +nan.0 (ash 1 256))))
1692   (pass-if (not (equal? (- (ash 1 256)) +nan.0)))
1693   (pass-if (not (equal? +nan.0 (- (ash 1 256)))))
1694
1695   (pass-if (not (equal? (ash 1 8192) +nan.0)))
1696   (pass-if (not (equal? +nan.0 (ash 1 8192))))
1697   (pass-if (not (equal? (- (ash 1 8192)) +nan.0)))
1698   (pass-if (not (equal? +nan.0 (- (ash 1 8192)))))
1699
1700   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
1701   ;; sure we've avoided that
1702   (pass-if (not (equal? (ash 3 1023) +nan.0)))
1703   (pass-if (not (equal? +nan.0 (ash 3 1023)))))
1704
1705 ;;;
1706 ;;; eqv?
1707 ;;;
1708
1709 (with-test-prefix "eqv?"
1710   (pass-if (documented? eqv?))
1711
1712   ;; The following test will fail on platforms
1713   ;; without distinct signed zeroes 0.0 and -0.0.
1714   (pass-if (not (eqv? 0.0 -0.0)))
1715
1716   (pass-if (eqv? 0 0))
1717   (pass-if (eqv? 7 7))
1718   (pass-if (eqv? -7 -7))
1719   (pass-if (eqv? (+ 1 fixnum-max) (+ 1 fixnum-max)))
1720   (pass-if (eqv? (- fixnum-min 1) (- fixnum-min 1)))
1721   (pass-if (eqv?  0.0  0.0))
1722   (pass-if (eqv? -0.0 -0.0))
1723   (pass-if (not (eqv? 0 1)))
1724   (pass-if (not (eqv? 0 0.0)))
1725   (pass-if (not (eqv? 1 1.0)))
1726   (pass-if (not (eqv? 0.0 0)))
1727   (pass-if (not (eqv? 1.0 1)))
1728   (pass-if (not (eqv? -1.0 -1)))
1729   (pass-if (not (eqv? fixnum-max (+ 1 fixnum-max))))
1730   (pass-if (not (eqv? (+ 1 fixnum-max) fixnum-max)))
1731   (pass-if (not (eqv? (+ 1 fixnum-max) (+ 2 fixnum-max))))
1732   (pass-if (not (eqv? fixnum-min (- fixnum-min 1))))
1733   (pass-if (not (eqv? (- fixnum-min 1) fixnum-min)))
1734   (pass-if (not (eqv? (- fixnum-min 1) (- fixnum-min 2))))
1735   (pass-if (not (eqv? (+ fixnum-max 1) (- fixnum-min 1))))
1736
1737   (pass-if (not (eqv? (ash 1 256) +inf.0)))
1738   (pass-if (not (eqv? +inf.0 (ash 1 256))))
1739   (pass-if (not (eqv? (ash 1 256) -inf.0)))
1740   (pass-if (not (eqv? -inf.0 (ash 1 256))))
1741
1742   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
1743   ;; sure we've avoided that
1744   (pass-if (not (eqv? (ash 1 1024) +inf.0)))
1745   (pass-if (not (eqv? +inf.0 (ash 1 1024))))
1746   (pass-if (not (eqv? (- (ash 1 1024)) -inf.0)))
1747   (pass-if (not (eqv? -inf.0 (- (ash 1 1024)))))
1748
1749   (pass-if (eqv? +nan.0 +nan.0))
1750   (pass-if (not (eqv? +nan.0 0.0+nan.0i)))
1751
1752   (pass-if (not (eqv? 0 +nan.0)))
1753   (pass-if (not (eqv? +nan.0 0)))
1754   (pass-if (not (eqv? 1 +nan.0)))
1755   (pass-if (not (eqv? +nan.0 1)))
1756   (pass-if (not (eqv? -1 +nan.0)))
1757   (pass-if (not (eqv? +nan.0 -1)))
1758
1759   (pass-if (not (eqv? (ash 1 256) +nan.0)))
1760   (pass-if (not (eqv? +nan.0 (ash 1 256))))
1761   (pass-if (not (eqv? (- (ash 1 256)) +nan.0)))
1762   (pass-if (not (eqv? +nan.0 (- (ash 1 256)))))
1763
1764   (pass-if (not (eqv? (ash 1 8192) +nan.0)))
1765   (pass-if (not (eqv? +nan.0 (ash 1 8192))))
1766   (pass-if (not (eqv? (- (ash 1 8192)) +nan.0)))
1767   (pass-if (not (eqv? +nan.0 (- (ash 1 8192)))))
1768
1769   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
1770   ;; sure we've avoided that
1771   (pass-if (not (eqv? (ash 3 1023) +nan.0)))
1772   (pass-if (not (eqv? +nan.0 (ash 3 1023)))))
1773
1774 ;;;
1775 ;;; =
1776 ;;;
1777
1778 (with-test-prefix "="
1779   (pass-if (documented? =))
1780   (pass-if (= 0 0))
1781   (pass-if (= 7 7))
1782   (pass-if (= -7 -7))
1783   (pass-if (= (+ 1 fixnum-max) (+ 1 fixnum-max)))
1784   (pass-if (= (- fixnum-min 1) (- fixnum-min 1)))
1785   (pass-if (not (= 0 1)))
1786   (pass-if (not (= fixnum-max (+ 1 fixnum-max))))
1787   (pass-if (not (= (+ 1 fixnum-max) fixnum-max)))
1788   (pass-if (not (= (+ 1 fixnum-max) (+ 2 fixnum-max))))
1789   (pass-if (not (= fixnum-min (- fixnum-min 1))))
1790   (pass-if (not (= (- fixnum-min 1) fixnum-min)))
1791   (pass-if (not (= (- fixnum-min 1) (- fixnum-min 2))))
1792   (pass-if (not (= (+ fixnum-max 1) (- fixnum-min 1))))
1793
1794   (pass-if (not (= (ash 1 256) +inf.0)))
1795   (pass-if (not (= +inf.0 (ash 1 256))))
1796   (pass-if (not (= (ash 1 256) -inf.0)))
1797   (pass-if (not (= -inf.0 (ash 1 256))))
1798
1799   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
1800   ;; sure we've avoided that
1801   (pass-if (not (= (ash 1 1024) +inf.0)))
1802   (pass-if (not (= +inf.0 (ash 1 1024))))
1803   (pass-if (not (= (- (ash 1 1024)) -inf.0)))
1804   (pass-if (not (= -inf.0 (- (ash 1 1024)))))
1805
1806   (pass-if (not (= +nan.0 +nan.0)))
1807   (pass-if (not (= 0 +nan.0)))
1808   (pass-if (not (= +nan.0 0)))
1809   (pass-if (not (= 1 +nan.0)))
1810   (pass-if (not (= +nan.0 1)))
1811   (pass-if (not (= -1 +nan.0)))
1812   (pass-if (not (= +nan.0 -1)))
1813
1814   (pass-if (not (= (ash 1 256) +nan.0)))
1815   (pass-if (not (= +nan.0 (ash 1 256))))
1816   (pass-if (not (= (- (ash 1 256)) +nan.0)))
1817   (pass-if (not (= +nan.0 (- (ash 1 256)))))
1818
1819   (pass-if (not (= (ash 1 8192) +nan.0)))
1820   (pass-if (not (= +nan.0 (ash 1 8192))))
1821   (pass-if (not (= (- (ash 1 8192)) +nan.0)))
1822   (pass-if (not (= +nan.0 (- (ash 1 8192)))))
1823
1824   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
1825   ;; sure we've avoided that
1826   (pass-if (not (= (ash 3 1023) +nan.0)))
1827   (pass-if (not (= +nan.0 (ash 3 1023))))
1828
1829   (pass-if (= 1/2 0.5))
1830   (pass-if (not (= 1/3 0.333333333333333333333333333333333)))
1831   (pass-if (not (= 2/3 0.5)))
1832   (pass-if (not (= 0.5 (+ 1/2 (/ 1 (ash 1 1000))))))
1833
1834   (pass-if (= 1/2 0.5+0i))
1835   (pass-if (not (= 0.333333333333333333333333333333333 1/3)))
1836   (pass-if (not (= 2/3 0.5+0i)))
1837   (pass-if (not (= 1/2 0+0.5i)))
1838
1839   (pass-if (= 0.5 1/2))
1840   (pass-if (not (= 0.5 2/3)))
1841   (pass-if (not (= (+ 1/2 (/ 1 (ash 1 1000))) 0.5)))
1842
1843   (pass-if (= 0.5+0i 1/2))
1844   (pass-if (not (= 0.5+0i 2/3)))
1845   (pass-if (not (= 0+0.5i 1/2)))
1846
1847   ;; prior to guile 1.8, inum/flonum comparisons were done just by
1848   ;; converting the inum to a double, which on a 64-bit would round making
1849   ;; say inexact 2^58 appear equal to exact 2^58+1
1850   (pass-if (= (ash-flo 1.0 58) (ash 1 58)))
1851   (pass-if (not (= (ash-flo 1.0 58) (1+ (ash 1 58)))))
1852   (pass-if (not (= (ash-flo 1.0 58) (1- (ash 1 58)))))
1853   (pass-if (= (ash 1 58) (ash-flo 1.0 58)))
1854   (pass-if (not (= (1+ (ash 1 58)) (ash-flo 1.0 58))))
1855   (pass-if (not (= (1- (ash 1 58)) (ash-flo 1.0 58)))))
1856
1857 ;;;
1858 ;;; <
1859 ;;;
1860
1861 (with-test-prefix "<"
1862
1863   (pass-if "documented?"
1864     (documented? <))
1865
1866   (with-test-prefix "(< 0 n)"
1867
1868     (pass-if "n = 0"
1869       (not (< 0 0)))
1870
1871     (pass-if "n = 0.0"
1872       (not (< 0 0.0)))
1873
1874     (pass-if "n = 1"
1875       (< 0 1))
1876
1877     (pass-if "n = 1.0"
1878       (< 0 1.0))
1879
1880     (pass-if "n = -1"
1881       (not (< 0 -1)))
1882
1883     (pass-if "n = -1.0"
1884       (not (< 0 -1.0)))
1885
1886     (pass-if "n = fixnum-max"
1887       (< 0 fixnum-max))
1888
1889     (pass-if "n = fixnum-max + 1"
1890       (< 0 (+ fixnum-max 1)))
1891
1892     (pass-if "n = fixnum-min"
1893       (not (< 0 fixnum-min)))
1894
1895     (pass-if "n = fixnum-min - 1"
1896       (not (< 0 (- fixnum-min 1)))))
1897
1898   (with-test-prefix "(< 0.0 n)"
1899
1900     (pass-if "n = 0"
1901       (not (< 0.0 0)))
1902
1903     (pass-if "n = 0.0"
1904       (not (< 0.0 0.0)))
1905
1906     (pass-if "n = 1"
1907       (< 0.0 1))
1908
1909     (pass-if "n = 1.0"
1910       (< 0.0 1.0))
1911
1912     (pass-if "n = -1"
1913       (not (< 0.0 -1)))
1914
1915     (pass-if "n = -1.0"
1916       (not (< 0.0 -1.0)))
1917
1918     (pass-if "n = fixnum-max"
1919       (< 0.0 fixnum-max))
1920
1921     (pass-if "n = fixnum-max + 1"
1922       (< 0.0 (+ fixnum-max 1)))
1923
1924     (pass-if "n = fixnum-min"
1925       (not (< 0.0 fixnum-min)))
1926
1927     (pass-if "n = fixnum-min - 1"
1928       (not (< 0.0 (- fixnum-min 1)))))
1929
1930   (with-test-prefix "(< 1 n)"
1931
1932     (pass-if "n = 0"
1933       (not (< 1 0)))
1934
1935     (pass-if "n = 0.0"
1936       (not (< 1 0.0)))
1937
1938     (pass-if "n = 1"
1939       (not (< 1 1)))
1940
1941     (pass-if "n = 1.0"
1942       (not (< 1 1.0)))
1943
1944     (pass-if "n = -1"
1945       (not (< 1 -1)))
1946
1947     (pass-if "n = -1.0"
1948       (not (< 1 -1.0)))
1949
1950     (pass-if "n = fixnum-max"
1951       (< 1 fixnum-max))
1952
1953     (pass-if "n = fixnum-max + 1"
1954       (< 1 (+ fixnum-max 1)))
1955
1956     (pass-if "n = fixnum-min"
1957       (not (< 1 fixnum-min)))
1958
1959     (pass-if "n = fixnum-min - 1"
1960       (not (< 1 (- fixnum-min 1)))))
1961
1962   (with-test-prefix "(< 1.0 n)"
1963
1964     (pass-if "n = 0"
1965       (not (< 1.0 0)))
1966
1967     (pass-if "n = 0.0"
1968       (not (< 1.0 0.0)))
1969
1970     (pass-if "n = 1"
1971       (not (< 1.0 1)))
1972
1973     (pass-if "n = 1.0"
1974       (not (< 1.0 1.0)))
1975
1976     (pass-if "n = -1"
1977       (not (< 1.0 -1)))
1978
1979     (pass-if "n = -1.0"
1980       (not (< 1.0 -1.0)))
1981
1982     (pass-if "n = fixnum-max"
1983       (< 1.0 fixnum-max))
1984
1985     (pass-if "n = fixnum-max + 1"
1986       (< 1.0 (+ fixnum-max 1)))
1987
1988     (pass-if "n = fixnum-min"
1989       (not (< 1.0 fixnum-min)))
1990
1991     (pass-if "n = fixnum-min - 1"
1992       (not (< 1.0 (- fixnum-min 1)))))
1993
1994   (with-test-prefix "(< -1 n)"
1995
1996     (pass-if "n = 0"
1997       (< -1 0))
1998
1999     (pass-if "n = 0.0"
2000       (< -1 0.0))
2001
2002     (pass-if "n = 1"
2003       (< -1 1))
2004
2005     (pass-if "n = 1.0"
2006       (< -1 1.0))
2007
2008     (pass-if "n = -1"
2009       (not (< -1 -1)))
2010
2011     (pass-if "n = -1.0"
2012       (not (< -1 -1.0)))
2013
2014     (pass-if "n = fixnum-max"
2015       (< -1 fixnum-max))
2016
2017     (pass-if "n = fixnum-max + 1"
2018       (< -1 (+ fixnum-max 1)))
2019
2020     (pass-if "n = fixnum-min"
2021       (not (< -1 fixnum-min)))
2022
2023     (pass-if "n = fixnum-min - 1"
2024       (not (< -1 (- fixnum-min 1)))))
2025
2026   (with-test-prefix "(< -1.0 n)"
2027
2028     (pass-if "n = 0"
2029       (< -1.0 0))
2030
2031     (pass-if "n = 0.0"
2032       (< -1.0 0.0))
2033
2034     (pass-if "n = 1"
2035       (< -1.0 1))
2036
2037     (pass-if "n = 1.0"
2038       (< -1.0 1.0))
2039
2040     (pass-if "n = -1"
2041       (not (< -1.0 -1)))
2042
2043     (pass-if "n = -1.0"
2044       (not (< -1.0 -1.0)))
2045
2046     (pass-if "n = fixnum-max"
2047       (< -1.0 fixnum-max))
2048
2049     (pass-if "n = fixnum-max + 1"
2050       (< -1.0 (+ fixnum-max 1)))
2051
2052     (pass-if "n = fixnum-min"
2053       (not (< -1.0 fixnum-min)))
2054
2055     (pass-if "n = fixnum-min - 1"
2056       (not (< -1.0 (- fixnum-min 1)))))
2057
2058   (with-test-prefix "(< fixnum-max n)"
2059
2060     (pass-if "n = 0"
2061       (not (< fixnum-max 0)))
2062
2063     (pass-if "n = 0.0"
2064       (not (< fixnum-max 0.0)))
2065
2066     (pass-if "n = 1"
2067       (not (< fixnum-max 1)))
2068
2069     (pass-if "n = 1.0"
2070       (not (< fixnum-max 1.0)))
2071
2072     (pass-if "n = -1"
2073       (not (< fixnum-max -1)))
2074
2075     (pass-if "n = -1.0"
2076       (not (< fixnum-max -1.0)))
2077
2078     (pass-if "n = fixnum-max"
2079       (not (< fixnum-max fixnum-max)))
2080
2081     (pass-if "n = fixnum-max + 1"
2082       (< fixnum-max (+ fixnum-max 1)))
2083
2084     (pass-if "n = fixnum-min"
2085       (not (< fixnum-max fixnum-min)))
2086
2087     (pass-if "n = fixnum-min - 1"
2088       (not (< fixnum-max (- fixnum-min 1)))))
2089
2090   (with-test-prefix "(< (+ fixnum-max 1) n)"
2091
2092     (pass-if "n = 0"
2093       (not (< (+ fixnum-max 1) 0)))
2094
2095     (pass-if "n = 0.0"
2096       (not (< (+ fixnum-max 1) 0.0)))
2097
2098     (pass-if "n = 1"
2099       (not (< (+ fixnum-max 1) 1)))
2100
2101     (pass-if "n = 1.0"
2102       (not (< (+ fixnum-max 1) 1.0)))
2103
2104     (pass-if "n = -1"
2105       (not (< (+ fixnum-max 1) -1)))
2106
2107     (pass-if "n = -1.0"
2108       (not (< (+ fixnum-max 1) -1.0)))
2109
2110     (pass-if "n = fixnum-max"
2111       (not (< (+ fixnum-max 1) fixnum-max)))
2112
2113     (pass-if "n = fixnum-max + 1"
2114       (not (< (+ fixnum-max 1) (+ fixnum-max 1))))
2115
2116     (pass-if "n = fixnum-min"
2117       (not (< (+ fixnum-max 1) fixnum-min)))
2118
2119     (pass-if "n = fixnum-min - 1"
2120       (not (< (+ fixnum-max 1) (- fixnum-min 1)))))
2121
2122   (with-test-prefix "(< fixnum-min n)"
2123
2124     (pass-if "n = 0"
2125       (< fixnum-min 0))
2126
2127     (pass-if "n = 0.0"
2128       (< fixnum-min 0.0))
2129
2130     (pass-if "n = 1"
2131       (< fixnum-min 1))
2132
2133     (pass-if "n = 1.0"
2134       (< fixnum-min 1.0))
2135
2136     (pass-if "n = -1"
2137       (< fixnum-min -1))
2138
2139     (pass-if "n = -1.0"
2140       (< fixnum-min -1.0))
2141
2142     (pass-if "n = fixnum-max"
2143       (< fixnum-min fixnum-max))
2144
2145     (pass-if "n = fixnum-max + 1"
2146       (< fixnum-min (+ fixnum-max 1)))
2147
2148     (pass-if "n = fixnum-min"
2149       (not (< fixnum-min fixnum-min)))
2150
2151     (pass-if "n = fixnum-min - 1"
2152       (not (< fixnum-min (- fixnum-min 1)))))
2153
2154   (with-test-prefix "(< (- fixnum-min 1) n)"
2155
2156     (pass-if "n = 0"
2157       (< (- fixnum-min 1) 0))
2158
2159     (pass-if "n = 0.0"
2160       (< (- fixnum-min 1) 0.0))
2161
2162     (pass-if "n = 1"
2163       (< (- fixnum-min 1) 1))
2164
2165     (pass-if "n = 1.0"
2166       (< (- fixnum-min 1) 1.0))
2167
2168     (pass-if "n = -1"
2169       (< (- fixnum-min 1) -1))
2170
2171     (pass-if "n = -1.0"
2172       (< (- fixnum-min 1) -1.0))
2173
2174     (pass-if "n = fixnum-max"
2175       (< (- fixnum-min 1) fixnum-max))
2176
2177     (pass-if "n = fixnum-max + 1"
2178       (< (- fixnum-min 1) (+ fixnum-max 1)))
2179
2180     (pass-if "n = fixnum-min"
2181       (< (- fixnum-min 1) fixnum-min))
2182
2183     (pass-if "n = fixnum-min - 1"
2184       (not (< (- fixnum-min 1) (- fixnum-min 1)))))
2185
2186   (pass-if (< (ash 1 256) +inf.0))
2187   (pass-if (not (< +inf.0 (ash 1 256))))
2188   (pass-if (not (< (ash 1 256) -inf.0)))
2189   (pass-if (< -inf.0 (ash 1 256)))
2190
2191   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
2192   ;; sure we've avoided that
2193   (pass-if (< (1- (ash 1 1024)) +inf.0))
2194   (pass-if (<     (ash 1 1024)  +inf.0))
2195   (pass-if (< (1+ (ash 1 1024)) +inf.0))
2196   (pass-if (not (< +inf.0 (1- (ash 1 1024)))))
2197   (pass-if (not (< +inf.0     (ash 1 1024))))
2198   (pass-if (not (< +inf.0 (1+ (ash 1 1024)))))
2199   (pass-if (< -inf.0 (- (1- (ash 1 1024)))))
2200   (pass-if (< -inf.0 (-     (ash 1 1024))))
2201   (pass-if (< -inf.0 (- (1+ (ash 1 1024)))))
2202   (pass-if (not (< (- (1- (ash 1 1024))) -inf.0)))
2203   (pass-if (not (< (-     (ash 1 1024))  -inf.0)))
2204   (pass-if (not (< (- (1+ (ash 1 1024))) -inf.0)))
2205
2206   (pass-if (not (< +nan.0 +nan.0)))
2207   (pass-if (not (< 0 +nan.0)))
2208   (pass-if (not (< +nan.0 0)))
2209   (pass-if (not (< 1 +nan.0)))
2210   (pass-if (not (< +nan.0 1)))
2211   (pass-if (not (< -1 +nan.0)))
2212   (pass-if (not (< +nan.0 -1)))
2213
2214   (pass-if (not (< (ash 1 256) +nan.0)))
2215   (pass-if (not (< +nan.0 (ash 1 256))))
2216   (pass-if (not (< (- (ash 1 256)) +nan.0)))
2217   (pass-if (not (< +nan.0 (- (ash 1 256)))))
2218
2219   (pass-if (not (< (ash 1 8192) +nan.0)))
2220   (pass-if (not (< +nan.0 (ash 1 8192))))
2221   (pass-if (not (< (- (ash 1 8192)) +nan.0)))
2222   (pass-if (not (< +nan.0 (- (ash 1 8192)))))
2223
2224   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
2225   ;; sure we've avoided that
2226   (pass-if (not (< (ash 3 1023) +nan.0)))
2227   (pass-if (not (< (1+ (ash 3 1023)) +nan.0)))
2228   (pass-if (not (< (1- (ash 3 1023)) +nan.0)))
2229   (pass-if (not (< +nan.0 (ash 3 1023))))
2230   (pass-if (not (< +nan.0 (1+ (ash 3 1023)))))
2231   (pass-if (not (< +nan.0 (1- (ash 3 1023)))))
2232
2233   (with-test-prefix "inum/frac"
2234     (pass-if (< 2 9/4))
2235     (pass-if (< -2 9/4))
2236     (pass-if (< -2 7/4))
2237     (pass-if (< -2 -7/4))
2238     (pass-if (eq? #f (< 2 7/4)))
2239     (pass-if (eq? #f (< 2 -7/4)))
2240     (pass-if (eq? #f (< 2 -9/4)))
2241     (pass-if (eq? #f (< -2 -9/4))))
2242
2243   (with-test-prefix "bignum/frac"
2244     (let ((x (ash 1 2048)))
2245       (pass-if (< x (* 4/3 x)))
2246       (pass-if (< (- x) (* 4/3 x)))
2247       (pass-if (< (- x) (* 2/3 x)))
2248       (pass-if (< (- x) (* -2/3 x)))
2249       (pass-if (eq? #f (< x (* 2/3 x))))
2250       (pass-if (eq? #f (< x (* -2/3 x))))
2251       (pass-if (eq? #f (< x (* -4/3 x))))
2252       (pass-if (eq? #f (< (- x) (* -4/3 x))))))
2253
2254   (with-test-prefix "flonum/frac"
2255     (pass-if (< 0.75 4/3))
2256     (pass-if (< -0.75 4/3))
2257     (pass-if (< -0.75 2/3))
2258     (pass-if (< -0.75 -2/3))
2259     (pass-if (eq? #f (< 0.75 2/3)))
2260     (pass-if (eq? #f (< 0.75 -2/3)))
2261     (pass-if (eq? #f (< 0.75 -4/3)))
2262     (pass-if (eq? #f (< -0.75 -4/3)))
2263
2264     (pass-if (< -inf.0 4/3))
2265     (pass-if (< -inf.0 -4/3))
2266     (pass-if (eq? #f (< +inf.0 4/3)))
2267     (pass-if (eq? #f (< +inf.0 -4/3)))
2268
2269     (pass-if (eq? #f (< +nan.0 4/3)))
2270     (pass-if (eq? #f (< +nan.0 -4/3))))
2271
2272   (with-test-prefix "frac/inum"
2273     (pass-if (< 7/4 2))
2274     (pass-if (< -7/4 2))
2275     (pass-if (< -9/4 2))
2276     (pass-if (< -9/4 -2))
2277     (pass-if (eq? #f (< 9/4 2)))
2278     (pass-if (eq? #f (< 9/4 -2)))
2279     (pass-if (eq? #f (< 7/4 -2)))
2280     (pass-if (eq? #f (< -7/4 -2))))
2281
2282   (with-test-prefix "frac/bignum"
2283     (let ((x (ash 1 2048)))
2284       (pass-if (< (* 2/3 x) x))
2285       (pass-if (< (* -2/3 x) x))
2286       (pass-if (< (* -4/3 x) x))
2287       (pass-if (< (* -4/3 x) (- x)))
2288       (pass-if (eq? #f (< (* 4/3 x) x)))
2289       (pass-if (eq? #f (< (* 4/3 x) (- x))))
2290       (pass-if (eq? #f (< (* 2/3 x) (- x))))
2291       (pass-if (eq? #f (< (* -2/3 x) (- x))))))
2292
2293   (with-test-prefix "frac/flonum"
2294     (pass-if (< 2/3 0.75))
2295     (pass-if (< -2/3 0.75))
2296     (pass-if (< -4/3 0.75))
2297     (pass-if (< -4/3 -0.75))
2298     (pass-if (eq? #f (< 4/3 0.75)))
2299     (pass-if (eq? #f (< 4/3 -0.75)))
2300     (pass-if (eq? #f (< 2/3 -0.75)))
2301     (pass-if (eq? #f (< -2/3 -0.75)))
2302
2303     (pass-if (< 4/3 +inf.0))
2304     (pass-if (< -4/3 +inf.0))
2305     (pass-if (eq? #f (< 4/3 -inf.0)))
2306     (pass-if (eq? #f (< -4/3 -inf.0)))
2307
2308     (pass-if (eq? #f (< 4/3 +nan.0)))
2309     (pass-if (eq? #f (< -4/3 +nan.0))))
2310
2311   (with-test-prefix "frac/frac"
2312     (pass-if (< 2/3 6/7))
2313     (pass-if (< -2/3 6/7))
2314     (pass-if (< -4/3 6/7))
2315     (pass-if (< -4/3 -6/7))
2316     (pass-if (eq? #f (< 4/3 6/7)))
2317     (pass-if (eq? #f (< 4/3 -6/7)))
2318     (pass-if (eq? #f (< 2/3 -6/7)))
2319     (pass-if (eq? #f (< -2/3 -6/7)))))
2320
2321 ;;;
2322 ;;; >
2323 ;;;
2324
2325 ;; currently not tested -- implementation is trivial
2326 ;; (> x y) is implemented as (< y x)
2327 ;; FIXME: tests should probably be added in case we change implementation.
2328
2329 ;;;
2330 ;;; <=
2331 ;;;
2332
2333 ;; currently not tested -- implementation is trivial
2334 ;; (<= x y) is implemented as (not (< y x))
2335 ;; FIXME: tests should probably be added in case we change implementation.
2336
2337 ;;;
2338 ;;; >=
2339 ;;;
2340
2341 ;; currently not tested -- implementation is trivial
2342 ;; (>= x y) is implemented as (not (< x y))
2343 ;; FIXME: tests should probably be added in case we change implementation.
2344
2345 ;;;
2346 ;;; zero?
2347 ;;;
2348
2349 (with-test-prefix "zero?"
2350   (pass-if (documented? zero?))
2351   (pass-if (zero? 0))
2352   (pass-if (not (zero? 7)))
2353   (pass-if (not (zero? -7)))
2354   (pass-if (not (zero? (+ 1 fixnum-max))))
2355   (pass-if (not (zero? (- 1 fixnum-min))))
2356   (pass-if (not (zero? 1.3)))
2357   (pass-if (not (zero? 3.1+4.2i))))
2358
2359 ;;;
2360 ;;; positive?
2361 ;;;
2362
2363 (with-test-prefix "positive?"
2364   (pass-if (documented? positive?))
2365   (pass-if (positive? 1))
2366   (pass-if (positive? (+ fixnum-max 1)))
2367   (pass-if (positive? 1.3))
2368   (pass-if (not (positive? 0)))
2369   (pass-if (not (positive? -1)))
2370   (pass-if (not (positive? (- fixnum-min 1))))
2371   (pass-if (not (positive? -1.3))))
2372
2373 ;;;
2374 ;;; negative?
2375 ;;;
2376
2377 (with-test-prefix "negative?"
2378   (pass-if (documented? negative?))
2379   (pass-if (not (negative? 1)))
2380   (pass-if (not (negative? (+ fixnum-max 1))))
2381   (pass-if (not (negative? 1.3)))
2382   (pass-if (not (negative? 0)))
2383   (pass-if (negative? -1))
2384   (pass-if (negative? (- fixnum-min 1)))
2385   (pass-if (negative? -1.3)))
2386
2387 ;;;
2388 ;;; max
2389 ;;;
2390
2391 (with-test-prefix "max"
2392   (pass-if-exception "no args" exception:wrong-num-args
2393     (max))
2394
2395   (pass-if-exception "one complex" exception:wrong-type-arg
2396     (max 1+i))
2397
2398   (pass-if-exception "inum/complex" exception:wrong-type-arg
2399     (max 123 1+i))
2400   (pass-if-exception "big/complex" exception:wrong-type-arg
2401     (max 9999999999999999999999999999999999999999 1+i))
2402   (pass-if-exception "real/complex" exception:wrong-type-arg
2403     (max 123.0 1+i))
2404   (pass-if-exception "frac/complex" exception:wrong-type-arg
2405     (max 123/456 1+i))
2406
2407   (pass-if-exception "complex/inum" exception:wrong-type-arg
2408     (max 1+i 123))
2409   (pass-if-exception "complex/big" exception:wrong-type-arg
2410     (max 1+i 9999999999999999999999999999999999999999))
2411   (pass-if-exception "complex/real" exception:wrong-type-arg
2412     (max 1+i 123.0))
2413   (pass-if-exception "complex/frac" exception:wrong-type-arg
2414     (max 1+i 123/456))
2415
2416   (let ((big*2 (* fixnum-max 2))
2417         (big*3 (* fixnum-max 3))
2418         (big*4 (* fixnum-max 4))
2419         (big*5 (* fixnum-max 5)))
2420
2421     (with-test-prefix "inum / frac"
2422       (pass-if (= 3 (max 3 5/2)))
2423       (pass-if (= 5/2 (max 2 5/2))))
2424
2425     (with-test-prefix "frac / inum"
2426       (pass-if (= 3 (max 5/2 3)))
2427       (pass-if (= 5/2 (max 5/2 2))))
2428
2429     (with-test-prefix "inum / real"
2430       (pass-if (nan? (max 123 +nan.0))))
2431
2432     (with-test-prefix "real / inum"
2433       (pass-if (nan? (max +nan.0 123))))
2434
2435     (with-test-prefix "big / frac"
2436       (pass-if (= big*2 (max big*2 5/2)))
2437       (pass-if (= 5/2 (max (- big*2) 5/2))))
2438
2439     (with-test-prefix "frac / big"
2440       (pass-if (= big*2 (max 5/2 big*2)))
2441       (pass-if (= 5/2 (max 5/2 (- big*2)))))
2442
2443     (with-test-prefix "big / real"
2444       (pass-if (nan? (max big*5 +nan.0)))
2445       (pass-if (eqv? (exact->inexact big*5)  (max big*5 -inf.0)))
2446       (pass-if (eqv? (exact->inexact big*5)  (max big*5 1.0)))
2447       (pass-if (eqv? +inf.0                  (max big*5 +inf.0)))
2448       (pass-if (eqv? 1.0                     (max (- big*5) 1.0))))
2449
2450     (with-test-prefix "real / big"
2451       (pass-if (nan? (max +nan.0 big*5)))
2452       (pass-if (eqv? (exact->inexact big*5)  (max -inf.0 big*5)))
2453       (pass-if (eqv? (exact->inexact big*5)  (max 1.0 big*5)))
2454       (pass-if (eqv? +inf.0                  (max +inf.0 big*5)))
2455       (pass-if (eqv? 1.0                     (max 1.0 (- big*5)))))
2456
2457     (with-test-prefix "frac / frac"
2458       (pass-if (= 2/3 (max 1/2 2/3)))
2459       (pass-if (= 2/3 (max 2/3 1/2)))
2460       (pass-if (= -1/2 (max -1/2 -2/3)))
2461       (pass-if (= -1/2 (max -2/3 -1/2))))
2462
2463     (with-test-prefix "real / real"
2464       (pass-if (nan? (max 123.0 +nan.0)))
2465       (pass-if (nan? (max +nan.0 123.0)))
2466       (pass-if (nan? (max +nan.0 +nan.0)))
2467       (pass-if (= 456.0 (max 123.0 456.0)))
2468       (pass-if (= 456.0 (max 456.0 123.0)))))
2469
2470   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
2471   ;; sure we've avoided that
2472   (for-each (lambda (b)
2473               (pass-if (list b +inf.0)
2474                 (= +inf.0 (max b +inf.0)))
2475               (pass-if (list +inf.0 b)
2476                 (= +inf.0 (max b +inf.0)))
2477               (pass-if (list b -inf.0)
2478                 (= (exact->inexact b) (max b -inf.0)))
2479               (pass-if (list -inf.0 b)
2480                 (= (exact->inexact b) (max b -inf.0))))
2481             (list (1- (ash 1 1024))
2482                   (ash 1 1024)
2483                   (1+ (ash 1 1024))
2484                   (- (1- (ash 1 1024)))
2485                   (- (ash 1 1024))
2486                   (- (1+ (ash 1 1024)))))
2487
2488   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
2489   ;; sure we've avoided that
2490   (pass-if (nan? (max (ash 1 2048) +nan.0)))
2491   (pass-if (nan? (max +nan.0 (ash 1 2048)))))
2492
2493 ;;;
2494 ;;; min
2495 ;;;
2496
2497 ;; FIXME: unfinished...
2498
2499 (with-test-prefix "min"
2500   (pass-if-exception "no args" exception:wrong-num-args
2501     (min))
2502
2503   (pass-if-exception "one complex" exception:wrong-type-arg
2504     (min 1+i))
2505
2506   (pass-if-exception "inum/complex" exception:wrong-type-arg
2507     (min 123 1+i))
2508   (pass-if-exception "big/complex" exception:wrong-type-arg
2509     (min 9999999999999999999999999999999999999999 1+i))
2510   (pass-if-exception "real/complex" exception:wrong-type-arg
2511     (min 123.0 1+i))
2512   (pass-if-exception "frac/complex" exception:wrong-type-arg
2513     (min 123/456 1+i))
2514
2515   (pass-if-exception "complex/inum" exception:wrong-type-arg
2516     (min 1+i 123))
2517   (pass-if-exception "complex/big" exception:wrong-type-arg
2518     (min 1+i 9999999999999999999999999999999999999999))
2519   (pass-if-exception "complex/real" exception:wrong-type-arg
2520     (min 1+i 123.0))
2521   (pass-if-exception "complex/frac" exception:wrong-type-arg
2522     (min 1+i 123/456))
2523
2524   (let ((big*2 (* fixnum-max 2))
2525         (big*3 (* fixnum-max 3))
2526         (big*4 (* fixnum-max 4))
2527         (big*5 (* fixnum-max 5)))
2528
2529     (pass-if (documented? min))
2530     (pass-if (= 1 (min 7 3 1 5)))
2531     (pass-if (= 1 (min 1 7 3 5)))
2532     (pass-if (= 1 (min 7 3 5 1)))
2533     (pass-if (= -7 (min 2 3 4 -2 5 -7 1 -1 4 2)))
2534     (pass-if (= -7 (min -7 2 3 4 -2 5 1 -1 4 2)))
2535     (pass-if (= -7 (min 2 3 4 -2 5 1 -1 4 2 -7)))
2536     (pass-if (= big*2 (min big*3 big*5 big*2 big*4)))
2537     (pass-if (= big*2 (min big*2 big*3 big*5 big*4)))
2538     (pass-if (= big*2 (min big*3 big*5 big*4 big*2)))
2539     (pass-if
2540         (= (- fixnum-min 1) (min 2 4 (- fixnum-min 1) 3 (* 2 fixnum-max))))
2541     (pass-if
2542         (= (- fixnum-min 1) (min (- fixnum-min 1) 2 4 3 (* 2 fixnum-max))))
2543     (pass-if
2544         (= (- fixnum-min 1) (min 2 4 3 (* 2 fixnum-max) (- fixnum-min 1))))
2545
2546     (with-test-prefix "inum / frac"
2547       (pass-if (= 5/2 (min 3 5/2)))
2548       (pass-if (= 2   (min 2 5/2))))
2549
2550     (with-test-prefix "frac / inum"
2551       (pass-if (= 5/2 (min 5/2 3)))
2552       (pass-if (= 2   (min 5/2 2))))
2553
2554     (with-test-prefix "inum / real"
2555       (pass-if (nan? (min 123 +nan.0))))
2556
2557     (with-test-prefix "real / inum"
2558       (pass-if (nan? (min +nan.0 123))))
2559
2560     (with-test-prefix "big / frac"
2561       (pass-if (= 5/2       (min big*2 5/2)))
2562       (pass-if (= (- big*2) (min (- big*2) 5/2))))
2563
2564     (with-test-prefix "frac / big"
2565       (pass-if (= 5/2       (min 5/2 big*2)))
2566       (pass-if (= (- big*2) (min 5/2 (- big*2)))))
2567
2568     (with-test-prefix "big / real"
2569       (pass-if (nan? (min big*5 +nan.0)))
2570       (pass-if (eqv? (exact->inexact big*5)      (min big*5  +inf.0)))
2571       (pass-if (eqv? -inf.0                      (min big*5  -inf.0)))
2572       (pass-if (eqv? 1.0                         (min big*5 1.0)))
2573       (pass-if (eqv? (exact->inexact (- big*5))  (min (- big*5) 1.0))))
2574
2575     (with-test-prefix "real / big"
2576       (pass-if (nan? (min +nan.0 big*5)))
2577       (pass-if (eqv? (exact->inexact big*5)      (min +inf.0 big*5)))
2578       (pass-if (eqv? -inf.0                      (min -inf.0 big*5)))
2579       (pass-if (eqv? 1.0                         (min 1.0 big*5)))
2580       (pass-if (eqv? (exact->inexact (- big*5))  (min 1.0 (- big*5)))))
2581
2582     (with-test-prefix "frac / frac"
2583       (pass-if (= 1/2 (min 1/2 2/3)))
2584       (pass-if (= 1/2 (min 2/3 1/2)))
2585       (pass-if (= -2/3 (min -1/2 -2/3)))
2586       (pass-if (= -2/3 (min -2/3 -1/2))))
2587
2588     (with-test-prefix "real / real"
2589       (pass-if (nan? (min 123.0 +nan.0)))
2590       (pass-if (nan? (min +nan.0 123.0)))
2591       (pass-if (nan? (min +nan.0 +nan.0)))
2592       (pass-if (= 123.0 (min 123.0 456.0)))
2593       (pass-if (= 123.0 (min 456.0 123.0)))))
2594
2595
2596   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
2597   ;; sure we've avoided that
2598   (for-each (lambda (b)
2599               (pass-if (list b +inf.0)
2600                 (= (exact->inexact b) (min b +inf.0)))
2601               (pass-if (list +inf.0 b)
2602                 (= (exact->inexact b) (min b +inf.0)))
2603               (pass-if (list b -inf.0)
2604                 (= -inf.0 (min b -inf.0)))
2605               (pass-if (list -inf.0 b)
2606                 (= -inf.0 (min b -inf.0))))
2607             (list (1- (ash 1 1024))
2608                   (ash 1 1024)
2609                   (1+ (ash 1 1024))
2610                   (- (1- (ash 1 1024)))
2611                   (- (ash 1 1024))
2612                   (- (1+ (ash 1 1024)))))
2613
2614   ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
2615   ;; sure we've avoided that
2616   (pass-if (nan? (min (- (ash 1 2048)) (- +nan.0))))
2617   (pass-if (nan? (min (- +nan.0) (- (ash 1 2048))))))
2618
2619 ;;;
2620 ;;; +
2621 ;;;
2622
2623 (with-test-prefix/c&e "+"
2624
2625   (pass-if "documented?"
2626     (documented? +))
2627
2628   ;; The maximum fixnum on a 32-bit architecture: 2^29 - 1.
2629   (pass-if "fixnum + fixnum = bignum (32-bit)"
2630     (eqv? 536870912 (+ 536870910 2)))
2631
2632   ;; The maximum fixnum on a 64-bit architecture: 2^61 - 1.
2633   (pass-if "fixnum + fixnum = bignum (64-bit)"
2634     (eqv? 2305843009213693952 (+ 2305843009213693950 2)))
2635
2636   (pass-if "bignum + fixnum = fixnum"
2637     (eqv? 0 (+ (1+ most-positive-fixnum) most-negative-fixnum))))
2638
2639 ;;;
2640 ;;; -
2641 ;;;
2642
2643 (with-test-prefix/c&e "-"
2644
2645   (pass-if "double-negation of fixnum-min: ="
2646     (=      fixnum-min (- (- fixnum-min))))
2647   (pass-if "double-negation of fixnum-min: eqv?"
2648     (eqv?   fixnum-min (- (- fixnum-min))))
2649   (pass-if "double-negation of fixnum-min: equal?"
2650     (equal? fixnum-min (- (- fixnum-min))))
2651
2652   (pass-if "binary double-negation of fixnum-min: ="
2653     (=      fixnum-min (- 0 (- 0 fixnum-min))))
2654   (pass-if "binary double-negation of fixnum-min: eqv?"
2655     (eqv?   fixnum-min (- 0 (- 0 fixnum-min))))
2656   (pass-if "binary double-negation of fixnum-min: equal?"
2657     (equal? fixnum-min (- 0 (- 0 fixnum-min))))
2658
2659   (pass-if "-inum - +bignum"
2660     (= #x-100000000000000000000000000000001
2661        (- -1 #x100000000000000000000000000000000)))
2662
2663   (pass-if "big - inum"
2664     (= #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
2665        (- #x100000000000000000000000000000000 1)))
2666
2667   (pass-if "big - -inum"
2668     (= #x100000000000000000000000000000001
2669        (- #x100000000000000000000000000000000 -1)))
2670
2671   ;; The mininum fixnum on a 32-bit architecture: -2^29.
2672   (pass-if "fixnum - fixnum = bignum (32-bit)"
2673     (eqv? -536870912 (- -536870910 2)))
2674
2675   ;; The minimum fixnum on a 64-bit architecture: -2^61.
2676   (pass-if "fixnum - fixnum = bignum (64-bit)"
2677     (eqv? -2305843009213693952 (- -2305843009213693950 2)))
2678
2679   (pass-if "bignum - fixnum = fixnum"
2680     (eqv? most-positive-fixnum (- (1+ most-positive-fixnum) 1))))
2681
2682 ;;;
2683 ;;; *
2684 ;;;
2685
2686 (with-test-prefix "*"
2687
2688   (with-test-prefix "double-negation of fixnum-min"
2689     (pass-if (=      fixnum-min (* -1 (* -1 fixnum-min))))
2690     (pass-if (eqv?   fixnum-min (* -1 (* -1 fixnum-min))))
2691     (pass-if (equal? fixnum-min (* -1 (* -1 fixnum-min))))
2692     (pass-if (=      fixnum-min (* (* fixnum-min -1) -1)))
2693     (pass-if (eqv?   fixnum-min (* (* fixnum-min -1) -1)))
2694     (pass-if (equal? fixnum-min (* (* fixnum-min -1) -1))))
2695
2696   (with-test-prefix "inum * bignum"
2697
2698     (pass-if "0 * 2^256 = 0"
2699       (eqv? 0 (* 0 (ash 1 256)))))
2700
2701   (with-test-prefix "inum * flonum"
2702
2703     (pass-if "0 * 1.0 = 0"
2704       (eqv? 0 (* 0 1.0))))
2705
2706   (with-test-prefix "inum * complex"
2707
2708     (pass-if "0 * 1+1i = 0"
2709       (eqv? 0 (* 0 1+1i))))
2710
2711   (with-test-prefix "inum * frac"
2712
2713     (pass-if "0 * 2/3 = 0"
2714       (eqv? 0 (* 0 2/3))))
2715
2716   (with-test-prefix "bignum * inum"
2717
2718     (pass-if "2^256 * 0 = 0"
2719       (eqv? 0 (* (ash 1 256) 0))))
2720
2721   (with-test-prefix "flonum * inum"
2722
2723     ;; in guile 1.6.8 and 1.8.1 and earlier this returned inexact 0.0
2724     (pass-if "1.0 * 0 = 0"
2725       (eqv? 0 (* 1.0 0))))
2726
2727   (with-test-prefix "complex * inum"
2728
2729     ;; in guile 1.6.8 and 1.8.1 and earlier this returned inexact 0.0
2730     (pass-if "1+1i * 0 = 0"
2731       (eqv? 0 (* 1+1i 0))))
2732
2733   (pass-if "complex * bignum"
2734     (let ((big (ash 1 90)))
2735       (= (make-rectangular big big)
2736          (* 1+1i big))))
2737
2738   (with-test-prefix "frac * inum"
2739
2740     (pass-if "2/3 * 0 = 0"
2741       (eqv? 0 (* 2/3 0)))))
2742
2743 ;;;
2744 ;;; /
2745 ;;;
2746
2747 (with-test-prefix "/"
2748
2749   (with-test-prefix "double-negation of fixnum-min"
2750     (pass-if (=      fixnum-min (/ (/ fixnum-min -1) -1)))
2751     (pass-if (eqv?   fixnum-min (/ (/ fixnum-min -1) -1)))
2752     (pass-if (equal? fixnum-min (/ (/ fixnum-min -1) -1))))
2753
2754   (pass-if "documented?"
2755     (documented? /))
2756
2757   (with-test-prefix "division by zero"
2758
2759     (pass-if-exception "(/ 0)"
2760         exception:numerical-overflow
2761       (/ 0))
2762
2763     (pass-if "(/ 0.0)"
2764       (= +inf.0 (/ 0.0)))
2765
2766     (pass-if-exception "(/ 1 0)"
2767         exception:numerical-overflow
2768       (/ 1 0))
2769
2770     (pass-if "(/ 1 0.0)"
2771       (= +inf.0 (/ 1 0.0)))
2772
2773     (pass-if-exception "(/ bignum 0)"
2774         exception:numerical-overflow
2775       (/ (+ fixnum-max 1) 0))
2776
2777     (pass-if "(/ bignum 0.0)"
2778       (= +inf.0 (/ (+ fixnum-max 1) 0.0)))
2779
2780     (pass-if-exception "(/ 1.0 0)"
2781         exception:numerical-overflow
2782       (/ 1.0 0))
2783
2784     (pass-if "(/ 1.0 0.0)"
2785       (= +inf.0 (/ 1.0 0.0)))
2786
2787     (pass-if-exception "(/ +i 0)"
2788         exception:numerical-overflow
2789       (/ +i 0))
2790
2791     (pass-if "(/ +i 0.0)"
2792       (= +inf.0 (imag-part (/ +i 0.0)))))
2793
2794   (with-test-prefix "1/complex"
2795
2796     (pass-if "0+1i"
2797       (eqv? 0-1i (/ 0+1i)))
2798
2799     ;; in guile 1.6 through 1.6.7 this incorrectly resulted in nans
2800     (pass-if "0-1i"
2801       (eqv? 0+1i (/ 0-1i)))
2802
2803     (pass-if "1+1i"
2804       (eqv? 0.5-0.5i (/ 1+1i)))
2805
2806     (pass-if "1-1i"
2807       (eqv? 0.5+0.5i (/ 1-1i)))
2808
2809     (pass-if "-1+1i"
2810       (eqv? -0.5-0.5i (/ -1+1i)))
2811
2812     (pass-if "-1-1i"
2813       (eqv? -0.5+0.5i (/ -1-1i)))
2814
2815     (pass-if "(/ 3+4i)"
2816       (= (/ 3+4i) 0.12-0.16i))
2817
2818     (pass-if "(/ 4+3i)"
2819       (= (/ 4+3i) 0.16-0.12i))
2820
2821     (pass-if "(/ 1e200+1e200i)"
2822       (= (/ 1e200+1e200i) 5.0e-201-5.0e-201i)))
2823
2824   (with-test-prefix "inum/complex"
2825
2826     (pass-if "(/ 25 3+4i)"
2827       (= (/ 25 3+4i) 3.0-4.0i))
2828
2829     (pass-if "(/ 25 4+3i)"
2830       (= (/ 25 4+3i) 4.0-3.0i)))
2831
2832   (with-test-prefix "complex/complex"
2833
2834     (pass-if "(/ 25+125i 3+4i)"
2835       (= (/ 25+125i 3+4i) 23.0+11.0i))
2836
2837     (pass-if "(/ 25+125i 4+3i)"
2838       (= (/ 25+125i 4+3i) 19.0+17.0i))))
2839
2840 ;;;
2841 ;;; truncate
2842 ;;;
2843
2844 (with-test-prefix "truncate"
2845   (pass-if (=  1 (truncate  1.75)))
2846   (pass-if (=  1 (truncate  1.5)))
2847   (pass-if (=  1 (truncate  1.25)))
2848   (pass-if (=  0 (truncate  0.75)))
2849   (pass-if (=  0 (truncate  0.5)))
2850   (pass-if (=  0 (truncate  0.0)))
2851   (pass-if (=  0 (truncate -0.5)))
2852   (pass-if (= -1 (truncate -1.25)))
2853   (pass-if (= -1 (truncate -1.5))))
2854
2855 ;;;
2856 ;;; round
2857 ;;;
2858
2859 (with-test-prefix "round"
2860   (pass-if (=  2 (round  1.75)))
2861   (pass-if (=  2 (round  1.5)))
2862   (pass-if (=  1 (round  1.25)))
2863   (pass-if (=  1 (round  0.75)))
2864   (pass-if (=  0 (round  0.5)))
2865   (pass-if (=  0 (round  0.0)))
2866   (pass-if (=  0 (round -0.5)))
2867   (pass-if (= -1 (round -1.25)))
2868   (pass-if (= -2 (round -1.5)))
2869
2870   (with-test-prefix "inum"
2871     (pass-if "0"
2872       (and (= 0    (round 0))
2873            (exact? (round 0))))
2874
2875     (pass-if "1"
2876       (and (= 1    (round 1))
2877            (exact? (round 1))))
2878
2879     (pass-if "-1"
2880       (and (= -1   (round -1))
2881            (exact? (round -1)))))
2882
2883   (with-test-prefix "bignum"
2884     (let ((x (1+ most-positive-fixnum)))
2885       (pass-if "(1+ most-positive-fixnum)"
2886         (and (= x    (round x))
2887              (exact? (round x)))))
2888
2889     (let ((x (1- most-negative-fixnum)))
2890       (pass-if "(1- most-negative-fixnum)"
2891         (and (= x    (round x))
2892              (exact? (round x))))))
2893
2894   (with-test-prefix "frac"
2895     (define (=exact x y)
2896       (and (= x y)
2897            (exact? y)))
2898
2899     (pass-if (=exact -2 (round -7/3)))
2900     (pass-if (=exact -2 (round -5/3)))
2901     (pass-if (=exact -1 (round -4/3)))
2902     (pass-if (=exact -1 (round -2/3)))
2903     (pass-if (=exact  0 (round -1/3)))
2904     (pass-if (=exact  0 (round  1/3)))
2905     (pass-if (=exact  1 (round  2/3)))
2906     (pass-if (=exact  1 (round  4/3)))
2907     (pass-if (=exact  2 (round  5/3)))
2908     (pass-if (=exact  2 (round  7/3)))
2909
2910     (pass-if (=exact -3 (round -17/6)))
2911     (pass-if (=exact -3 (round -16/6)))
2912     (pass-if (=exact -2 (round -15/6)))
2913     (pass-if (=exact -2 (round -14/6)))
2914     (pass-if (=exact -2 (round -13/6)))
2915     (pass-if (=exact -2 (round -11/6)))
2916     (pass-if (=exact -2 (round -10/6)))
2917     (pass-if (=exact -2 (round  -9/6)))
2918     (pass-if (=exact -1 (round  -8/6)))
2919     (pass-if (=exact -1 (round  -7/6)))
2920     (pass-if (=exact -1 (round  -5/6)))
2921     (pass-if (=exact -1 (round  -4/6)))
2922     (pass-if (=exact  0 (round  -3/6)))
2923     (pass-if (=exact  0 (round  -2/6)))
2924     (pass-if (=exact  0 (round  -1/6)))
2925     (pass-if (=exact  0 (round   1/6)))
2926     (pass-if (=exact  0 (round   2/6)))
2927     (pass-if (=exact  0 (round   3/6)))
2928     (pass-if (=exact  1 (round   4/6)))
2929     (pass-if (=exact  1 (round   5/6)))
2930     (pass-if (=exact  1 (round   7/6)))
2931     (pass-if (=exact  1 (round   8/6)))
2932     (pass-if (=exact  2 (round   9/6)))
2933     (pass-if (=exact  2 (round  10/6)))
2934     (pass-if (=exact  2 (round  11/6)))
2935     (pass-if (=exact  2 (round  13/6)))
2936     (pass-if (=exact  2 (round  14/6)))
2937     (pass-if (=exact  2 (round  15/6)))
2938     (pass-if (=exact  3 (round  16/6)))
2939     (pass-if (=exact  3 (round  17/6))))
2940
2941   (with-test-prefix "real"
2942     (pass-if "0.0"
2943       (and (= 0.0    (round 0.0))
2944            (inexact? (round 0.0))))
2945
2946     (pass-if "1.0"
2947       (and (= 1.0    (round 1.0))
2948            (inexact? (round 1.0))))
2949
2950     (pass-if "-1.0"
2951       (and (= -1.0   (round -1.0))
2952            (inexact? (round -1.0))))
2953
2954     (pass-if "-3.1"
2955       (and (= -3.0   (round -3.1))
2956            (inexact? (round -3.1))))
2957
2958     (pass-if "3.1"
2959       (and (= 3.0    (round 3.1))
2960            (inexact? (round 3.1))))
2961
2962     (pass-if "3.9"
2963       (and (= 4.0    (round 3.9))
2964            (inexact? (round 3.9))))
2965
2966     (pass-if "-3.9"
2967       (and (= -4.0   (round -3.9))
2968            (inexact? (round -3.9))))
2969
2970     (pass-if "1.5"
2971       (and (= 2.0    (round 1.5))
2972            (inexact? (round 1.5))))
2973
2974     (pass-if "2.5"
2975       (and (= 2.0    (round 2.5))
2976            (inexact? (round 2.5))))
2977
2978     (pass-if "3.5"
2979       (and (= 4.0    (round 3.5))
2980            (inexact? (round 3.5))))
2981
2982     (pass-if "-1.5"
2983       (and (= -2.0   (round -1.5))
2984            (inexact? (round -1.5))))
2985
2986     (pass-if "-2.5"
2987       (and (= -2.0   (round -2.5))
2988            (inexact? (round -2.5))))
2989
2990     (pass-if "-3.5"
2991       (and (= -4.0   (round -3.5))
2992            (inexact? (round -3.5))))
2993
2994     ;; prior to guile 1.6.5, on an IEEE system an inexact 2^53-1 (ie. a
2995     ;; float with mantissa all ones) came out as 2^53 from `round' (except
2996     ;; on i386 and m68k systems using the coprocessor and optimizing, where
2997     ;; extra precision hid the problem)
2998     (pass-if "2^53-1"
2999       (let ((x (exact->inexact (1- (ash 1 53)))))
3000         (and (= x      (round x))
3001              (inexact? (round x)))))
3002     (pass-if "-(2^53-1)"
3003       (let ((x (exact->inexact (- (1- (ash 1 53))))))
3004         (and (= x      (round x))
3005              (inexact? (round x)))))))
3006
3007 ;;;
3008 ;;; exact->inexact
3009 ;;;
3010
3011 (with-test-prefix "exact->inexact"
3012
3013   ;; Test "(exact->inexact n)", expect "want".
3014   ;; "i" is a index, for diagnostic purposes.
3015   (define (try-i i n want)
3016     (with-test-prefix (list i n want)
3017       (with-test-prefix "pos"
3018         (let ((got (exact->inexact n)))
3019           (pass-if "inexact?" (inexact? got))
3020           (pass-if (list "=" got) (= want got))))
3021       (set! n    (- n))
3022       (set! want (- want))
3023       (with-test-prefix "neg"
3024         (let ((got (exact->inexact n)))
3025           (pass-if "inexact?" (inexact? got))
3026           (pass-if (list "=" got) (= want got))))))
3027
3028   (with-test-prefix "2^i, no round"
3029     (do ((i    0   (1+ i))
3030          (n    1   (* 2 n))
3031          (want 1.0 (* 2.0 want)))
3032         ((> i 100))
3033       (try-i i n want)))
3034
3035   (with-test-prefix "2^i+1, no round"
3036     (do ((i    1   (1+ i))
3037          (n    3   (1- (* 2 n)))
3038          (want 3.0 (- (* 2.0 want) 1.0)))
3039         ((>= i dbl-mant-dig))
3040       (try-i i n want)))
3041
3042   (with-test-prefix "(2^i+1)*2^100, no round"
3043     (do ((i    1   (1+ i))
3044          (n    3   (1- (* 2 n)))
3045          (want 3.0 (- (* 2.0 want) 1.0)))
3046         ((>= i dbl-mant-dig))
3047       (try-i i (ash n 100) (ash-flo want 100))))
3048
3049   ;; bit pattern: 1111....11100.00
3050   ;;              <-mantdig-><-i->
3051   ;;
3052   (with-test-prefix "mantdig ones then zeros, no rounding"
3053     (do ((i    0  (1+ i))
3054          (n    (- (ash     1   dbl-mant-dig) 1)   (* 2 n))
3055          (want (- (ash-flo 1.0 dbl-mant-dig) 1.0) (* 2.0 want)))
3056         ((> i 100))
3057       (try-i i n want)))
3058
3059   ;; bit pattern: 1111....111011..1
3060   ;;              <-mantdig-> <-i->
3061   ;; This sort of value was incorrectly rounded upwards in Guile 1.6.4 when
3062   ;; i >= 11 (that's when the total is 65 or more bits).
3063   ;;
3064   (with-test-prefix "mantdig ones then 011..11, round down"
3065     (do ((i    0  (1+ i))
3066          (n    (- (ash     1   (+ 1 dbl-mant-dig)) 2)   (+ 1 (* 2 n)))
3067          (want (- (ash-flo 1.0 (+ 1 dbl-mant-dig)) 2.0) (* 2.0 want)))
3068         ((> i 100))
3069       (try-i i n want)))
3070
3071   ;; bit pattern: 1111....111100..001
3072   ;;              <-mantdig-> <--i->
3073   ;;
3074   (with-test-prefix "mantdig ones then 100..001, round up"
3075     (do ((i    0  (1+ i))
3076          (n    (- (ash     1   (+ 2 dbl-mant-dig)) 1)  (1- (* 2 n)))
3077          (want    (ash-flo 1.0 (+ 2 dbl-mant-dig))     (* 2.0 want)))
3078         ((> i 100))
3079       (try-i i n want)))
3080
3081   ;; bit pattern: 1000....000100..001
3082   ;;              <-mantdig-> <--i->
3083   ;;
3084   (with-test-prefix "2^mantdig then 100..001, round up"
3085     (do ((i    0  (1+ i))
3086          (n    (- (ash     1   (+ 2 dbl-mant-dig)) 1)   (1- (* 2 n)))
3087          (want (+ (ash-flo 1.0 (+ 2 dbl-mant-dig)) 4.0) (* 2.0 want)))
3088         ((> i 100))
3089       (try-i i n want)))
3090
3091   (pass-if "frac big/big"
3092     (let ((big (ash 1 256)))
3093       (= 1.0 (exact->inexact (/ (1+ big) big)))))
3094
3095   ;; In guile 1.8.0 this failed, giving back "nan" because it tried to
3096   ;; convert the num and den to doubles, resulting in infs.
3097   (pass-if "frac big/big, exceeding double"
3098     (let ((big (ash 1 4096)))
3099       (= 1.0 (exact->inexact (/ (1+ big) big))))))
3100
3101 ;;;
3102 ;;; floor
3103 ;;;
3104
3105 ;;;
3106 ;;; ceiling
3107 ;;;
3108
3109 ;;;
3110 ;;; expt
3111 ;;;
3112
3113 (with-test-prefix "expt"
3114   (pass-if (documented? expt))
3115   (pass-if-exception "non-numeric base" exception:wrong-type-arg
3116                      (expt #t 0))
3117   (pass-if (eqv? 1 (expt 0 0)))
3118   (pass-if (eqv? 1 (expt 0.0 0)))
3119   (pass-if (eqv? 1.0 (expt 0 0.0)))
3120   (pass-if (eqv? 1.0 (expt 0.0 0.0)))
3121   (pass-if (nan? (expt 0 -1)))
3122   (pass-if (nan? (expt 0 -1.0)))
3123   (pass-if (nan? (expt 0.0 -1)))
3124   (pass-if (nan? (expt 0.0 -1.0)))
3125   (pass-if (eqv? 0 (expt 0 3)))
3126   (pass-if (= 0 (expt 0 4.0)))
3127   (pass-if (eqv? 0.0 (expt 0.0 5)))
3128   (pass-if (eqv? 0.0 (expt 0.0 6.0)))
3129   (pass-if (eqv? -2742638075.5 (expt -2742638075.5 1)))
3130   (pass-if (eqv? (* -2742638075.5 -2742638075.5)
3131                  (expt -2742638075.5 2)))
3132   (pass-if (eqv? 4.0 (expt -2.0 2.0)))
3133   (pass-if (eqv? -1/8 (expt -2 -3)))
3134   (pass-if (eqv? -0.125 (expt -2.0 -3)))
3135   (pass-if (eqv? -0.125 (expt -2 -3.0)))
3136   (pass-if (eqv? -0.125 (expt -2.0 -3.0)))
3137   (pass-if (eqv? 0.25 (expt 2.0 -2.0)))
3138   (pass-if (eqv? (* -1.0 12398 12398) (expt +12398i 2.0)))
3139   (pass-if (eqv-loosely? +i (expt -1 0.5)))
3140   (pass-if (eqv-loosely? +i (expt -1 1/2)))
3141   (pass-if (eqv-loosely? 1.0+1.7320508075688i (expt -8 1/3)))
3142   (pass-if (eqv? +inf.0 (expt 2 +inf.0)))
3143   (pass-if (eqv? +inf.0 (expt 2.0 +inf.0)))
3144   (pass-if (eqv? 0.0 (expt 2 -inf.0)))
3145   (pass-if (eqv? 0.0 (expt 2.0 -inf.0))))
3146
3147
3148 ;;;
3149 ;;; asinh
3150 ;;;
3151
3152 (with-test-prefix "asinh"
3153   (pass-if (= 0 (asinh 0))))
3154
3155 ;;;
3156 ;;; acosh
3157 ;;;
3158
3159 (with-test-prefix "acosh"
3160   (pass-if (= 0 (acosh 1))))
3161
3162 ;;;
3163 ;;; atanh
3164 ;;;
3165
3166 (with-test-prefix "atanh"
3167   (pass-if (= 0 (atanh 0))))
3168
3169 ;;;
3170 ;;; make-rectangular
3171 ;;;
3172
3173 ;;;
3174 ;;; make-polar
3175 ;;;
3176
3177 (with-test-prefix "make-polar"
3178   (define pi 3.14159265358979323846)
3179   (define (almost= x y)
3180     (> 0.01 (magnitude (- x y))))
3181
3182   (pass-if (= 0 (make-polar 0 0)))
3183   (pass-if (= 0 (make-polar 0 123.456)))
3184   (pass-if (= 1 (make-polar 1 0)))
3185   (pass-if (= -1 (make-polar -1 0)))
3186
3187   (pass-if (almost= 0+i (make-polar 1 (* 0.5 pi))))
3188   (pass-if (almost= -1  (make-polar 1 (* 1.0 pi))))
3189   (pass-if (almost= 0-i (make-polar 1 (* 1.5 pi))))
3190   (pass-if (almost= 1   (make-polar 1 (* 2.0 pi)))))
3191
3192 ;;;
3193 ;;; real-part
3194 ;;;
3195
3196 (with-test-prefix "real-part"
3197   (pass-if (documented? real-part))
3198   (pass-if (eqv? 5.0 (real-part  5.0)))
3199   (pass-if (eqv? 0.0 (real-part +5.0i)))
3200   (pass-if (eqv? 5   (real-part  5)))
3201   (pass-if (eqv? 1/5 (real-part  1/5)))
3202   (pass-if (eqv? (1+ fixnum-max) (real-part (1+ fixnum-max)))))
3203
3204 ;;;
3205 ;;; imag-part
3206 ;;;
3207
3208 (with-test-prefix "imag-part"
3209   (pass-if (documented? imag-part))
3210   (pass-if (eqv? 0.0 (imag-part  5.0)))
3211   (pass-if (eqv? 5.0 (imag-part +5.0i)))
3212   (pass-if (eqv? 0   (imag-part  5)))
3213   (pass-if (eqv? 0   (imag-part  1/5)))
3214   (pass-if (eqv? 0   (imag-part (1+ fixnum-max)))))
3215
3216 ;;;
3217 ;;; magnitude
3218 ;;;
3219
3220 (with-test-prefix "magnitude"
3221   (pass-if (documented? magnitude))
3222   (pass-if (= 0 (magnitude 0)))
3223   (pass-if (= 1 (magnitude 1)))
3224   (pass-if (= 1 (magnitude -1)))
3225   (pass-if (= 1 (magnitude 0+i)))
3226   (pass-if (= 1 (magnitude 0-i)))
3227   (pass-if (= 5 (magnitude 3+4i)))
3228   (pass-if (= 5 (magnitude 3-4i)))
3229   (pass-if (= 5 (magnitude -3+4i)))
3230   (pass-if (= 5 (magnitude -3-4i))))
3231
3232 ;;;
3233 ;;; angle
3234 ;;;
3235
3236 (with-test-prefix "angle"
3237   (define pi 3.14159265358979323846)
3238   (define (almost= x y)
3239     (> 0.01 (magnitude (- x y))))
3240
3241   (pass-if (documented? angle))
3242
3243   (pass-if "inum +ve"   (=        0 (angle 1)))
3244   (pass-if "inum -ve"   (almost= pi (angle -1)))
3245
3246   (pass-if "bignum +ve" (=        0 (angle (1+ fixnum-max))))
3247   (pass-if "bignum -ve" (almost= pi (angle (1- fixnum-min))))
3248
3249   (pass-if "flonum +ve" (=        0 (angle 1.5)))
3250   (pass-if "flonum -ve" (almost= pi (angle -1.5))))
3251
3252 ;;;
3253 ;;; inexact->exact
3254 ;;;
3255
3256 (with-test-prefix "inexact->exact"
3257   (pass-if (documented? inexact->exact))
3258
3259   (pass-if-exception "+inf" exception:out-of-range
3260     (inexact->exact +inf.0))
3261
3262   (pass-if-exception "-inf" exception:out-of-range
3263     (inexact->exact -inf.0))
3264
3265   (pass-if-exception "nan" exception:out-of-range
3266     (inexact->exact +nan.0))
3267
3268   (with-test-prefix "2.0**i to exact and back"
3269     (do ((i 0   (1+ i))
3270          (n 1.0 (* 2.0 n)))
3271         ((> i 100))
3272       (pass-if (list i n)
3273         (= n (inexact->exact (exact->inexact n)))))))
3274
3275 ;;;
3276 ;;; integer-expt
3277 ;;;
3278
3279 (with-test-prefix "integer-expt"
3280   (pass-if (documented? integer-expt))
3281
3282   (pass-if-exception "non-numeric base" exception:wrong-type-arg
3283                      (integer-expt #t 0))
3284   (pass-if-exception "2^+inf" exception:wrong-type-arg
3285     (integer-expt 2 +inf.0))
3286   (pass-if-exception "2^-inf" exception:wrong-type-arg
3287     (integer-expt 2 -inf.0))
3288   (pass-if-exception "2^nan" exception:wrong-type-arg
3289     (integer-expt 2 +nan.0))
3290
3291   (pass-if (eqv? 1 (integer-expt 0 0)))
3292   (pass-if (eqv? 1 (integer-expt 0.0 0)))
3293   (pass-if (nan? (integer-expt 0 -1)))
3294   (pass-if (nan? (integer-expt 0.0 -1)))
3295   (pass-if (eqv? 0 (integer-expt 0 3)))
3296   (pass-if (eqv? 0.0 (integer-expt 0.0 5)))
3297   (pass-if (eqv? -2742638075.5 (integer-expt -2742638075.5 1)))
3298   (pass-if (eqv? (* -2742638075.5 -2742638075.5)
3299                  (integer-expt -2742638075.5 2)))
3300   (pass-if (eqv? 4.0 (integer-expt -2.0 2)))
3301   (pass-if (eqv? -1/8 (integer-expt -2 -3)))
3302   (pass-if (eqv? -0.125 (integer-expt -2.0 -3)))
3303   (pass-if (eqv? 0.25 (integer-expt 2.0 -2)))
3304   (pass-if (eqv? (* -1.0 12398 12398) (integer-expt +12398.0i 2))))
3305
3306
3307 ;;;
3308 ;;; integer-length
3309 ;;;
3310
3311 (with-test-prefix "integer-length"
3312   (pass-if (documented? integer-length))
3313
3314   (with-test-prefix "-2^i, ...11100..00"
3315     (do ((n -1 (ash n 1))
3316          (i 0  (1+ i)))
3317         ((> i 256))
3318       (pass-if (list n "expect" i)
3319         (= i (integer-length n)))))
3320
3321   (with-test-prefix "-2^i+1 ...11100..01"
3322     (do ((n -3 (logxor 3 (ash n 1)))
3323          (i 2  (1+ i)))
3324         ((> i 256))
3325       (pass-if n
3326         (= i (integer-length n)))))
3327
3328   (with-test-prefix "-2^i-1 ...111011..11"
3329     (do ((n -2 (1+ (ash n 1)))
3330          (i 1  (1+ i)))
3331         ((> i 256))
3332       (pass-if n
3333         (= i (integer-length n))))))
3334
3335 ;;;
3336 ;;; log
3337 ;;;
3338
3339 (with-test-prefix "log"
3340   (pass-if (documented? log))
3341
3342   (pass-if-exception "no args" exception:wrong-num-args
3343     (log))
3344   (pass-if-exception "two args" exception:wrong-num-args
3345     (log 123 456))
3346
3347   (pass-if (negative-infinity? (log 0)))
3348   (pass-if (negative-infinity? (log 0.0)))
3349   (pass-if (eqv? 0.0 (log 1)))
3350   (pass-if (eqv? 0.0 (log 1.0)))
3351   (pass-if (eqv-loosely? 1.0  (log const-e)))
3352   (pass-if (eqv-loosely? 2.0  (log const-e^2)))
3353   (pass-if (eqv-loosely? -1.0 (log const-1/e)))
3354
3355   (pass-if (eqv-loosely? 1.0+1.57079i (log 0+2.71828i)))
3356   (pass-if (eqv-loosely? 1.0-1.57079i (log 0-2.71828i)))
3357
3358   (pass-if (eqv-loosely? 0.0+3.14159i (log -1.0)))
3359   (pass-if (eqv-loosely? 1.0+3.14159i (log -2.71828)))
3360   (pass-if (eqv-loosely? 2.0+3.14159i (log (* -2.71828 2.71828)))))
3361
3362 ;;;
3363 ;;; log10
3364 ;;;
3365
3366 (with-test-prefix "log10"
3367   (pass-if (documented? log10))
3368
3369   (pass-if-exception "no args" exception:wrong-num-args
3370     (log10))
3371   (pass-if-exception "two args" exception:wrong-num-args
3372     (log10 123 456))
3373
3374   (pass-if (negative-infinity? (log10 0)))
3375   (pass-if (negative-infinity? (log10 0.0)))
3376   (pass-if (eqv? 0.0 (log10 1)))
3377   (pass-if (eqv? 0.0 (log10 1.0)))
3378   (pass-if (eqv-loosely? 1.0  (log10 10.0)))
3379   (pass-if (eqv-loosely? 2.0  (log10 100.0)))
3380   (pass-if (eqv-loosely? -1.0 (log10 0.1)))
3381
3382   (pass-if (eqv-loosely? 1.0+0.68218i (log10 0+10.0i)))
3383   (pass-if (eqv-loosely? 1.0-0.68218i (log10 0-10.0i)))
3384
3385   (pass-if (eqv-loosely? 0.0+1.36437i (log10 -1)))
3386   (pass-if (eqv-loosely? 1.0+1.36437i (log10 -10)))
3387   (pass-if (eqv-loosely? 2.0+1.36437i (log10 -100))))
3388
3389 ;;;
3390 ;;; logbit?
3391 ;;;
3392
3393 (with-test-prefix "logbit?"
3394   (pass-if (documented? logbit?))
3395
3396   (pass-if (eq? #f (logbit?  0 0)))
3397   (pass-if (eq? #f (logbit?  1 0)))
3398   (pass-if (eq? #f (logbit? 31 0)))
3399   (pass-if (eq? #f (logbit? 32 0)))
3400   (pass-if (eq? #f (logbit? 33 0)))
3401   (pass-if (eq? #f (logbit? 63 0)))
3402   (pass-if (eq? #f (logbit? 64 0)))
3403   (pass-if (eq? #f (logbit? 65 0)))
3404
3405   ;; prior to guile 1.6.5, testing bit 32, 64 etc of value 1 would wrap
3406   ;; around and return #t where it ought to be #f
3407   (pass-if (eq? #t (logbit?  0 1)))
3408   (pass-if (eq? #f (logbit?  1 1)))
3409   (pass-if (eq? #f (logbit? 31 1)))
3410   (pass-if (eq? #f (logbit? 32 1)))
3411   (pass-if (eq? #f (logbit? 33 1)))
3412   (pass-if (eq? #f (logbit? 63 1)))
3413   (pass-if (eq? #f (logbit? 64 1)))
3414   (pass-if (eq? #f (logbit? 65 1)))
3415   (pass-if (eq? #f (logbit? 128 1)))
3416
3417   (pass-if (eq? #t (logbit?  0 -1)))
3418   (pass-if (eq? #t (logbit?  1 -1)))
3419   (pass-if (eq? #t (logbit? 31 -1)))
3420   (pass-if (eq? #t (logbit? 32 -1)))
3421   (pass-if (eq? #t (logbit? 33 -1)))
3422   (pass-if (eq? #t (logbit? 63 -1)))
3423   (pass-if (eq? #t (logbit? 64 -1)))
3424   (pass-if (eq? #t (logbit? 65 -1))))
3425
3426 ;;;
3427 ;;; logcount
3428 ;;;
3429
3430 (with-test-prefix "logcount"
3431   (pass-if (documented? logcount))
3432
3433   (with-test-prefix "-2^i, meaning ...11100..00"
3434     (do ((n -1 (ash n 1))
3435          (i 0  (1+ i)))
3436         ((> i 256))
3437       (pass-if n
3438         (= i (logcount n)))))
3439
3440   (with-test-prefix "2^i"
3441     (do ((n 1 (ash n 1))
3442          (i 0  (1+ i)))
3443         ((> i 256))
3444       (pass-if n
3445         (= 1 (logcount n)))))
3446
3447   (with-test-prefix "2^i-1"
3448     (do ((n 0 (1+ (ash n 1)))
3449          (i 0  (1+ i)))
3450         ((> i 256))
3451       (pass-if n
3452         (= i (logcount n))))))
3453
3454 ;;;
3455 ;;; logior
3456 ;;;
3457
3458 (with-test-prefix "logior"
3459   (pass-if (documented? logior))
3460
3461   (pass-if (eqv? -1 (logior (ash -1 1) 1)))
3462
3463   ;; check that bignum or bignum+inum args will reduce to an inum
3464   (let ()
3465     (define (test x y)
3466       (pass-if (list x y '=> -1)
3467         (eqv? -1 (logior x y)))
3468       (pass-if (list y x '=> -1)
3469         (eqv? -1 (logior y x))))
3470     (test (ash -1 8) #xFF)
3471     (test (ash -1 28) #x0FFFFFFF)
3472     (test (ash -1 29) #x1FFFFFFF)
3473     (test (ash -1 30) #x3FFFFFFF)
3474     (test (ash -1 31) #x7FFFFFFF)
3475     (test (ash -1 32) #xFFFFFFFF)
3476     (test (ash -1 33) #x1FFFFFFFF)
3477     (test (ash -1 60) #x0FFFFFFFFFFFFFFF)
3478     (test (ash -1 61) #x1FFFFFFFFFFFFFFF)
3479     (test (ash -1 62) #x3FFFFFFFFFFFFFFF)
3480     (test (ash -1 63) #x7FFFFFFFFFFFFFFF)
3481     (test (ash -1 64) #xFFFFFFFFFFFFFFFF)
3482     (test (ash -1 65) #x1FFFFFFFFFFFFFFFF)
3483     (test (ash -1 128) #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)))
3484
3485 ;;;
3486 ;;; lognot
3487 ;;;
3488
3489 (with-test-prefix "lognot"
3490   (pass-if (documented? lognot))
3491
3492   (pass-if (= -1 (lognot 0)))
3493   (pass-if (= 0  (lognot -1)))
3494   (pass-if (= -2 (lognot 1)))
3495   (pass-if (= 1  (lognot -2)))
3496
3497   (pass-if (= #x-100000000000000000000000000000000
3498               (lognot #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)))
3499   (pass-if (= #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
3500               (lognot #x-100000000000000000000000000000000))))
3501
3502 ;;;
3503 ;;; sqrt
3504 ;;;
3505
3506 (with-test-prefix "sqrt"
3507   (pass-if (documented? sqrt))
3508
3509   (pass-if-exception "no args" exception:wrong-num-args
3510     (sqrt))
3511   (pass-if-exception "two args" exception:wrong-num-args
3512     (sqrt 123 456))
3513
3514   (pass-if (eqv? 0.0 (sqrt 0)))
3515   (pass-if (eqv? 0.0 (sqrt 0.0)))
3516   (pass-if (eqv? 1.0 (sqrt 1.0)))
3517   (pass-if (eqv-loosely? 2.0   (sqrt 4.0)))
3518   (pass-if (eqv-loosely? 31.62 (sqrt 1000.0)))
3519
3520   (pass-if (eqv? +1.0i (sqrt -1.0)))
3521   (pass-if (eqv-loosely? +2.0i   (sqrt -4.0)))
3522   (pass-if (eqv-loosely? +31.62i (sqrt -1000.0)))
3523
3524   (pass-if "+i swings back to 45deg angle"
3525     (eqv-loosely? +0.7071+0.7071i (sqrt +1.0i)))
3526
3527   ;; Note: glibc 2.3 csqrt() had a bug affecting this test case, so if it
3528   ;; fails check whether that's the cause (there's a configure test to
3529   ;; reject it, but when cross-compiling we assume the C library is ok).
3530   (pass-if "-100i swings back to 45deg down"
3531     (eqv-loosely? +7.071-7.071i (sqrt -100.0i))))
3532
3533 ;;;
3534 ;;; euclidean/
3535 ;;; euclidean-quotient
3536 ;;; euclidean-remainder
3537 ;;; centered/
3538 ;;; centered-quotient
3539 ;;; centered-remainder
3540 ;;;
3541
3542 (with-test-prefix "Number-theoretic division"
3543
3544   ;; Tests that (lo <= x < hi),
3545   ;; but allowing for imprecision
3546   ;; if x is inexact.
3547   (define (test-within-range? lo hi x)
3548     (if (exact? x)
3549         (and (<= lo x) (< x hi))
3550         (let ((lo (- lo test-epsilon))
3551               (hi (+ hi test-epsilon)))
3552           (<= lo x hi))))
3553
3554   (define (safe-euclidean-quotient x y)
3555     (cond ((not (and (real? x) (real? y))) (throw 'wrong-type-arg))
3556           ((zero? y) (throw 'divide-by-zero))
3557           ((nan?  y) (nan))
3558           ((positive? y) (floor   (/ x y)))
3559           ((negative? y) (ceiling (/ x y)))
3560           (else (throw 'unknown-problem))))
3561
3562   (define (safe-euclidean-remainder x y)
3563     (- x (* y (safe-euclidean-quotient x y))))
3564
3565   (define (safe-euclidean/ x y)
3566     (let ((q (safe-euclidean-quotient x y))
3567           (r (safe-euclidean-remainder x y)))
3568       (if (not (and (eq? (exact? q) (exact? r))
3569                     (eq? (exact? q) (and (exact? x) (exact? y)))
3570                     (test-real-eqv? r (- x (* q y)))
3571                     (or (and (integer? q)
3572                              (test-within-range? 0 (abs y) r))
3573                         (not (finite? x))
3574                         (not (finite? y)))))
3575           (throw 'safe-euclidean/-is-broken (list x y q r))
3576           (values q r))))
3577
3578   (define (safe-centered-quotient x y)
3579     (cond ((not (and (real? x) (real? y))) (throw 'wrong-type-arg))
3580           ((zero? y) (throw 'divide-by-zero))
3581           ((nan?  y) (nan))
3582           ((positive? y) (floor   (+  1/2 (/ x y))))
3583           ((negative? y) (ceiling (+ -1/2 (/ x y))))
3584           (else (throw 'unknown-problem))))
3585
3586   (define (safe-centered-remainder x y)
3587     (- x (* y (safe-centered-quotient x y))))
3588
3589   (define (safe-centered/ x y)
3590     (let ((q (safe-centered-quotient x y))
3591           (r (safe-centered-remainder x y)))
3592       (if (not (and (eq? (exact? q) (exact? r))
3593                     (eq? (exact? q) (and (exact? x) (exact? y)))
3594                     (test-real-eqv? r (- x (* q y)))
3595                     (or (and (integer? q)
3596                              (test-within-range? (* -1/2 (abs y))
3597                                                  (* +1/2 (abs y))
3598                                                  r))
3599                         (not (finite? x))
3600                         (not (finite? y)))))
3601           (throw 'safe-centered/-is-broken (list x y q r))
3602           (values q r))))
3603
3604   (define test-numerators
3605     (append
3606      (list  123  125  127  130  3  5  10  123.2  125.0
3607             -123 -125 -127 -130 -3 -5 -10 -123.2 -125.0
3608             127.2  130.0  123/7  125/7  127/7  130/7
3609             -127.2 -130.0 -123/7 -125/7 -127/7 -130/7
3610             0 +0.0 -0.0 +inf.0 -inf.0 +nan.0
3611             most-negative-fixnum (1+ most-positive-fixnum)
3612             (1- most-negative-fixnum))
3613      (apply append
3614             (map (lambda (x) (list (* x (+ 1 most-positive-fixnum))
3615                                    (* x (+ 2 most-positive-fixnum))))
3616                  '( 123  125  127  130  3  5  10
3617                    -123 -125 -127 -130 -3 -5 -10)))))
3618
3619   (define test-denominators
3620     (list   10  5  10/7  127/2  10.0  63.5
3621             -10 -5 -10/7 -127/2 -10.0 -63.5
3622             +inf.0 -inf.0 +nan.0 most-negative-fixnum
3623             (+ 1 most-positive-fixnum) (+ -1 most-negative-fixnum)
3624             (+ 2 most-positive-fixnum) (+ -2 most-negative-fixnum)))
3625
3626   (define (do-tests-1 op-name real-op safe-op)
3627     (for-each (lambda (d)
3628                 (for-each (lambda (n)
3629                             (run-test (list op-name n d) #t
3630                                       (lambda ()
3631                                         (test-eqv? (real-op n d)
3632                                                    (safe-op n d)))))
3633                           test-numerators))
3634               test-denominators))
3635
3636   (define (do-tests-2 op-name real-op safe-op)
3637     (for-each (lambda (d)
3638                 (for-each (lambda (n)
3639                             (run-test (list op-name n d) #t
3640                                       (lambda ()
3641                                         (let-values
3642                                             (((q  r)  (safe-op n d))
3643                                              ((q1 r1) (real-op n d)))
3644                                           (and (test-eqv? q q1)
3645                                                (test-eqv? r r1))))))
3646                           test-numerators))
3647               test-denominators))
3648
3649   (pass-if (documented? euclidean/))
3650   (pass-if (documented? euclidean-quotient))
3651   (pass-if (documented? euclidean-remainder))
3652   (pass-if (documented? centered/))
3653   (pass-if (documented? centered-quotient))
3654   (pass-if (documented? centered-remainder))
3655
3656   (with-test-prefix "euclidean-quotient"
3657     (do-tests-1 'euclidean-quotient
3658                 euclidean-quotient
3659                 safe-euclidean-quotient))
3660   (with-test-prefix "euclidean-remainder"
3661     (do-tests-1 'euclidean-remainder
3662                 euclidean-remainder
3663                 safe-euclidean-remainder))
3664   (with-test-prefix "euclidean/"
3665     (do-tests-2 'euclidean/
3666                 euclidean/
3667                 safe-euclidean/))
3668
3669   (with-test-prefix "centered-quotient"
3670     (do-tests-1 'centered-quotient
3671                 centered-quotient
3672                 safe-centered-quotient))
3673   (with-test-prefix "centered-remainder"
3674     (do-tests-1 'centered-remainder
3675                 centered-remainder
3676                 safe-centered-remainder))
3677   (with-test-prefix "centered/"
3678     (do-tests-2 'centered/
3679                 centered/
3680                 safe-centered/)))