test-suite/tests/numbers.test

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