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