test-suite/tests/numbers.test

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