test-suite/tests/numbers.test

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