test-suite/tests/numbers.test

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