mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-08 22:50:27 +02:00
Code Activity
guile/test-suite/tests/numbers.test
Mark H Weaver 8b56bcec44 Optimize truncate, round, floor, and ceiling 
* libguile/numbers.c (scm_c_truncate): Use ceil (x) instead of
  -floor (-x).

  (scm_truncate_number): Implement directly instead of by checking the
  sign and using scm_floor or scm_ceiling.  Use scm_truncate_quotient
  for fractions.  Make extensible, so that new number types implemented
  in GOOPS will be able to do the job more efficiently, since it is
  often easier to implement truncate than floor or ceiling.

  (scm_round_number): Optimize fractions case by using
  scm_round_quotient.  Make extensible, so that new number types
  implemented in GOOPS will be able to do the job efficiently.

  (scm_floor, scm_ceiling): Optimize fractions case by using
  scm_floor_quotient and scm_ceiling_quotient, respectively.

* test-suite/tests/numbers.test: Add test cases.
2011-02-14 20:31:14 +01:00

4758 lines
135 KiB
Scheme
Raw Blame History

;;;; numbers.test --- tests guile's numbers -*- scheme -*-
;;;; Copyright (C) 2000, 2001, 2003, 2004, 2005, 2006, 2009, 2010, 2011 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;;
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;;; Lesser General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(define-module (test-suite test-numbers)
#:use-module (test-suite lib)
#:use-module (ice-9 documentation)
#:use-module (srfi srfi-1) ; list library
#:use-module (srfi srfi-11)) ; let-values
;;;
;;; miscellaneous
;;;
(define exception:numerical-overflow
(cons 'numerical-overflow "^Numerical overflow"))
(define (documented? object)
(not (not (object-documentation object))))
(define fixnum-bit
(inexact->exact (+ (/ (log (+ most-positive-fixnum 1)) (log 2)) 1)))
(define fixnum-min most-negative-fixnum)
(define fixnum-max most-positive-fixnum)
;; Divine the number of bits in the mantissa of a flonum.
;; We look for when 2.0^i+1.0 gets rounded, ie. the difference between that
;; value and 2.0^k is not 1.0.
;; Of course this assumes flonums have a fixed precision mantissa, but
;; that's the case now and probably into the forseeable future.
;; On an IEEE system, which means pretty much everywhere, the value here is
;; the usual 53.
;;
(define dbl-mant-dig
(let more ((i 1)
(d 2.0))
(if (> i 1024)
(error "Oops, cannot determine number of bits in mantissa of inexact"))
(let* ((sum (+ 1.0 d))
(diff (- sum d)))
(if (= diff 1.0)
(more (1+ i) (* 2.0 d))
i))))
;; like ash, but working on a flonum
(define (ash-flo x n)
(while (> n 0)
(set! x (* 2.0 x))
(set! n (1- n)))
(while (< n 0)
(set! x (* 0.5 x))
(set! n (1+ n)))
x)
;; `quotient' but rounded towards -infinity, like `modulo' or `ash' do
;; note only positive D supported (that's all that's currently required)
(define-public (quotient-floor n d)
(if (negative? n)
(quotient (- n d -1) d) ;; neg/pos
(quotient n d))) ;; pos/pos
;; return true of X is in the range LO to HI, inclusive
(define (within-range? lo hi x)
(and (>= x (min lo hi))
(<= x (max lo hi))))
;; return true if GOT is within +/- 0.01 of GOT
;; for a complex number both real and imaginary parts must be in that range
(define (eqv-loosely? want got)
(and (within-range? (- (real-part want) 0.01)
(+ (real-part want) 0.01)
(real-part got))
(within-range? (- (imag-part want) 0.01)
(+ (imag-part want) 0.01)
(imag-part got))))
;; return true if OBJ is negative infinity
(define (negative-infinity? obj)
(and (real? obj)
(negative? obj)
(inf? obj)))
;;
;; Tolerance used by test-eqv? for inexact numbers.
;;
(define test-epsilon 1e-10)
;;
;; Like eqv?, except that inexact finite numbers need only be within
;; test-epsilon (1e-10) to be considered equal. For non-real complex
;; numbers, each component is tested according to these rules. The
;; intent is that the known-correct value will be the first parameter.
;;
(define (test-eqv? x y)
(cond ((real? x)
(and (real? y) (test-real-eqv? x y)))
((complex? x)
(and (not (real? y))
(test-real-eqv? (real-part x) (real-part y))
(test-real-eqv? (imag-part x) (imag-part y))))
(else (eqv? x y))))
;; Auxiliary predicate used by test-eqv?
(define (test-real-eqv? x y)
(cond ((or (exact? x) (nan? x) (inf? x))
(eqv? x y))
(else (and (inexact? y) (> test-epsilon (abs (- x y)))))))
;; return true if OBJ is a real NaN
(define (real-nan? obj)
(and (real? obj)
(nan? obj)))
;; return true if OBJ is a non-real complex number
;; whose real part is a nan, and whose imaginary
;; part is an inexact zero.
(define (almost-real-nan? obj)
(and (not (real? obj))
(nan? (real-part obj))
(zero? (imag-part obj))))
;; return true if both the real and imaginary
;; parts of OBJ are NaNs
(define (complex-nan? obj)
(and (nan? (real-part obj))
(nan? (imag-part obj))))
;; return true if the real part of OBJ is zero
;; and the imaginary part is a NaN.
(define (imaginary-nan? obj)
(and (zero? (real-part obj))
(nan? (imag-part obj))))
;; return true if OBJ is a non-real complex zero
(define (complex-zero? obj)
(and (zero? obj)
(complex? obj)
(not (real? obj))))
(define const-e 2.7182818284590452354)
(define const-e^2 7.3890560989306502274)
(define const-1/e 0.3678794411714423215)
;;;
;;; 1+
;;;
(with-test-prefix/c&e "1+"
(pass-if "documented?"
(documented? 1+))
(pass-if "0" (eqv? 1 (1+ 0)))
(pass-if "-1" (eqv? 0 (1+ -1)))
(pass-if "100" (eqv? 101 (1+ 100)))
(pass-if "-100" (eqv? -99 (1+ -100)))
;; The maximum fixnum on a 32-bit architecture: 2^29 - 1.
(pass-if "1+ fixnum = bignum (32-bit)"
(eqv? 536870912 (1+ 536870911)))
;; The maximum fixnum on a 64-bit architecture: 2^61 - 1.
(pass-if "1+ fixnum = bignum (64-bit)"
(eqv? 2305843009213693952 (1+ 2305843009213693951))))
;;;
;;; 1-
;;;
(with-test-prefix/c&e "1-"
(pass-if "documented?"
(documented? 1-))
(pass-if "0" (eqv? -1 (1- 0)))
(pass-if "1" (eqv? 0 (1- 1)))
(pass-if "100" (eqv? 99 (1- 100)))
(pass-if "-100" (eqv? -101 (1- -100)))
;; The minimum fixnum on a 32-bit architecture: -2^29.
(pass-if "1- fixnum = bignum (32-bit)"
(eqv? -536870913 (1- -536870912)))
;; The minimum fixnum on a 64-bit architecture: -2^61.
(pass-if "1- fixnum = bignum (64-bit)"
(eqv? -2305843009213693953 (1- -2305843009213693952))))
;;;
;;; ash
;;;
(with-test-prefix "ash"
(pass-if "documented?"
(documented? ash))
(pass-if (eqv? 0 (ash 0 0)))
(pass-if (eqv? 0 (ash 0 1)))
(pass-if (eqv? 0 (ash 0 1000)))
(pass-if (eqv? 0 (ash 0 -1)))
(pass-if (eqv? 0 (ash 0 -1000)))
(pass-if (eqv? 1 (ash 1 0)))
(pass-if (eqv? 2 (ash 1 1)))
(pass-if (eqv? 340282366920938463463374607431768211456 (ash 1 128)))
(pass-if (eqv? 0 (ash 1 -1)))
(pass-if (eqv? 0 (ash 1 -1000)))
(pass-if (eqv? -1 (ash -1 0)))
(pass-if (eqv? -2 (ash -1 1)))
(pass-if (eqv? -340282366920938463463374607431768211456 (ash -1 128)))
(pass-if (eqv? -1 (ash -1 -1)))
(pass-if (eqv? -1 (ash -1 -1000)))
(pass-if (eqv? -3 (ash -3 0)))
(pass-if (eqv? -6 (ash -3 1)))
(pass-if (eqv? -1020847100762815390390123822295304634368 (ash -3 128)))
(pass-if (eqv? -2 (ash -3 -1)))
(pass-if (eqv? -1 (ash -3 -1000)))
(pass-if (eqv? -6 (ash -23 -2)))
(pass-if (eqv? most-positive-fixnum (ash most-positive-fixnum 0)))
(pass-if (eqv? (* 2 most-positive-fixnum) (ash most-positive-fixnum 1)))
(pass-if (eqv? (* 4 most-positive-fixnum) (ash most-positive-fixnum 2)))
(pass-if
(eqv? (* most-positive-fixnum 340282366920938463463374607431768211456)
(ash most-positive-fixnum 128)))
(pass-if (eqv? (quotient most-positive-fixnum 2)
(ash most-positive-fixnum -1)))
(pass-if (eqv? 0 (ash most-positive-fixnum -1000)))
(let ((mpf4 (quotient most-positive-fixnum 4)))
(pass-if (eqv? (* 2 mpf4) (ash mpf4 1)))
(pass-if (eqv? (* 4 mpf4) (ash mpf4 2)))
(pass-if (eqv? (* 8 mpf4) (ash mpf4 3))))
(pass-if (eqv? most-negative-fixnum (ash most-negative-fixnum 0)))
(pass-if (eqv? (* 2 most-negative-fixnum) (ash most-negative-fixnum 1)))
(pass-if (eqv? (* 4 most-negative-fixnum) (ash most-negative-fixnum 2)))
(pass-if
(eqv? (* most-negative-fixnum 340282366920938463463374607431768211456)
(ash most-negative-fixnum 128)))
(pass-if (eqv? (quotient-floor most-negative-fixnum 2)
(ash most-negative-fixnum -1)))
(pass-if (eqv? -1 (ash most-negative-fixnum -1000)))
(let ((mnf4 (quotient-floor most-negative-fixnum 4)))
(pass-if (eqv? (* 2 mnf4) (ash mnf4 1)))
(pass-if (eqv? (* 4 mnf4) (ash mnf4 2)))
(pass-if (eqv? (* 8 mnf4) (ash mnf4 3)))))
;;;
;;; exact?
;;;
(with-test-prefix "exact?"
(pass-if "documented?"
(documented? exact?))
(with-test-prefix "integers"
(pass-if "0"
(exact? 0))
(pass-if "fixnum-max"
(exact? fixnum-max))
(pass-if "fixnum-max + 1"
(exact? (+ fixnum-max 1)))
(pass-if "fixnum-min"
(exact? fixnum-min))
(pass-if "fixnum-min - 1"
(exact? (- fixnum-min 1))))
(with-test-prefix "reals"
;; (FIXME: need better examples.)
(pass-if "sqrt (fixnum-max^2 - 1)"
(eq? #f (exact? (sqrt (- (expt fixnum-max 2) 1)))))
(pass-if "sqrt ((fixnum-max+1)^2 - 1)"
(eq? #f (exact? (sqrt (- (expt (+ fixnum-max 1) 2) 1)))))
(pass-if (not (exact? +inf.0)))
(pass-if (not (exact? -inf.0)))
(pass-if (not (exact? +nan.0)))))
;;;
;;; exp
;;;
(with-test-prefix "exp"
(pass-if (documented? exp))
(pass-if-exception "no args" exception:wrong-num-args
(exp))
(pass-if-exception "two args" exception:wrong-num-args
(exp 123 456))
(pass-if (eqv? 0.0 (exp -inf.0)))
(pass-if (eqv-loosely? 1.0 (exp 0)))
(pass-if (eqv-loosely? 1.0 (exp 0.0)))
(pass-if (eqv-loosely? const-e (exp 1.0)))
(pass-if (eqv-loosely? const-e^2 (exp 2.0)))
(pass-if (eqv-loosely? const-1/e (exp -1)))
(pass-if "exp(pi*i) = -1"
(eqv-loosely? -1.0 (exp 0+3.14159i)))
(pass-if "exp(-pi*i) = -1"
(eqv-loosely? -1.0 (exp 0-3.14159i)))
(pass-if "exp(2*pi*i) = +1"
(eqv-loosely? 1.0 (exp 0+6.28318i)))
(pass-if "exp(2-pi*i) = -e^2"
(eqv-loosely? (- const-e^2) (exp 2.0-3.14159i))))
;;;
;;; odd?
;;;
(with-test-prefix "odd?"
(pass-if (documented? odd?))
(pass-if (odd? 1))
(pass-if (odd? -1))
(pass-if (not (odd? 0)))
(pass-if (not (odd? 2)))
(pass-if (not (odd? -2)))
(pass-if (odd? (+ (* 2 fixnum-max) 1)))
(pass-if (not (odd? (* 2 fixnum-max))))
(pass-if (odd? (- (* 2 fixnum-min) 1)))
(pass-if (not (odd? (* 2 fixnum-min)))))
;;;
;;; even?
;;;
(with-test-prefix "even?"
(pass-if (documented? even?))
(pass-if (even? 2))
(pass-if (even? -2))
(pass-if (even? 0))
(pass-if (not (even? 1)))
(pass-if (not (even? -1)))
(pass-if (not (even? (+ (* 2 fixnum-max) 1))))
(pass-if (even? (* 2 fixnum-max)))
(pass-if (not (even? (- (* 2 fixnum-min) 1))))
(pass-if (even? (* 2 fixnum-min))))
;;;
;;; finite?
;;;
(with-test-prefix "finite?"
(pass-if (documented? finite?))
(pass-if (not (finite? (inf))))
(pass-if (not (finite? +inf.0)))
(pass-if (not (finite? -inf.0)))
(pass-if-exception
"complex numbers not in domain of finite?"
exception:wrong-type-arg
(finite? +inf.0+1i))
(pass-if-exception
"complex numbers not in domain of finite? (2)"
exception:wrong-type-arg
(finite? +1+inf.0i))
(pass-if-exception
"complex numbers not in domain of finite? (3)"
exception:wrong-type-arg
(finite? +1+1i))
(pass-if (finite? 3+0i))
(pass-if (not (finite? (nan))))
(pass-if (not (finite? +nan.0)))
(pass-if (finite? 0))
(pass-if (finite? 0.0))
(pass-if (finite? -0.0))
(pass-if (finite? 42.0))
(pass-if (finite? 1/2))
(pass-if (finite? (+ fixnum-max 1)))
(pass-if (finite? (- fixnum-min 1))))
;;;
;;; inf? and inf
;;;
(with-test-prefix "inf?"
(pass-if (documented? inf?))
(pass-if (inf? (inf)))
;; FIXME: what are the expected behaviors?
;; (pass-if (inf? (/ 1.0 0.0))
;; (pass-if (inf? (/ 1 0.0))
(pass-if-exception
"complex numbers not in domain of inf?"
exception:wrong-type-arg
(inf? +1+inf.0i))
(pass-if (inf? +inf.0+0i))
(pass-if (not (inf? 0)))
(pass-if (not (inf? 42.0)))
(pass-if (not (inf? (+ fixnum-max 1))))
(pass-if (not (inf? (- fixnum-min 1)))))
;;;
;;; nan? and nan
;;;
(with-test-prefix "nan?"
(pass-if (documented? nan?))
(pass-if (nan? (nan)))
;; FIXME: other ways we should be able to generate NaN?
(pass-if (not (nan? 0)))
(pass-if (not (nan? 42.0)))
(pass-if (not (nan? (+ fixnum-max 1))))
(pass-if (not (nan? (- fixnum-min 1)))))
;;;
;;; abs
;;;
(with-test-prefix "abs"
(pass-if (documented? abs))
(pass-if (eqv? 0 (abs 0)))
(pass-if (eqv? 1 (abs 1)))
(pass-if (eqv? 1 (abs -1)))
(with-test-prefix "double-negation of fixnum-min"
(pass-if (eqv? fixnum-min (- (abs fixnum-min)))))
(pass-if (eqv? (+ fixnum-max 1) (abs (+ fixnum-max 1))))
(pass-if (eqv? (+ (- fixnum-min) 1) (abs (- fixnum-min 1))))
(pass-if (eqv? 0.0 (abs 0.0)))
(pass-if (eqv? 0.0 (abs -0.0)))
(pass-if (eqv? 1.0 (abs 1.0)))
(pass-if (eqv? 1.0 (abs -1.0)))
(pass-if (real-nan? (abs +nan.0)))
(pass-if (eqv? +inf.0 (abs +inf.0)))
(pass-if (eqv? +inf.0 (abs -inf.0))))
;;;
;;; quotient
;;;
(with-test-prefix "quotient"
(pass-if (documented? quotient))
(with-test-prefix "0 / n"
(pass-if "n = 1"
(eqv? 0 (quotient 0 1)))
(pass-if "n = -1"
(eqv? 0 (quotient 0 -1)))
(pass-if "n = 2"
(eqv? 0 (quotient 0 2)))
(pass-if "n = fixnum-max"
(eqv? 0 (quotient 0 fixnum-max)))
(pass-if "n = fixnum-max + 1"
(eqv? 0 (quotient 0 (+ fixnum-max 1))))
(pass-if "n = fixnum-min"
(eqv? 0 (quotient 0 fixnum-min)))
(pass-if "n = fixnum-min - 1"
(eqv? 0 (quotient 0 (- fixnum-min 1)))))
(with-test-prefix "1 / n"
(pass-if "n = 1"
(eqv? 1 (quotient 1 1)))
(pass-if "n = -1"
(eqv? -1 (quotient 1 -1)))
(pass-if "n = 2"
(eqv? 0 (quotient 1 2)))
(pass-if "n = fixnum-max"
(eqv? 0 (quotient 1 fixnum-max)))
(pass-if "n = fixnum-max + 1"
(eqv? 0 (quotient 1 (+ fixnum-max 1))))
(pass-if "n = fixnum-min"
(eqv? 0 (quotient 1 fixnum-min)))
(pass-if "n = fixnum-min - 1"
(eqv? 0 (quotient 1 (- fixnum-min 1)))))
(with-test-prefix "-1 / n"
(pass-if "n = 1"
(eqv? -1 (quotient -1 1)))
(pass-if "n = -1"
(eqv? 1 (quotient -1 -1)))
(pass-if "n = 2"
(eqv? 0 (quotient -1 2)))
(pass-if "n = fixnum-max"
(eqv? 0 (quotient -1 fixnum-max)))
(pass-if "n = fixnum-max + 1"
(eqv? 0 (quotient -1 (+ fixnum-max 1))))
(pass-if "n = fixnum-min"
(eqv? 0 (quotient -1 fixnum-min)))
(pass-if "n = fixnum-min - 1"
(eqv? 0 (quotient -1 (- fixnum-min 1)))))
(with-test-prefix "fixnum-max / n"
(pass-if "n = 1"
(eqv? fixnum-max (quotient fixnum-max 1)))
(pass-if "n = -1"
(eqv? (- fixnum-max) (quotient fixnum-max -1)))
(pass-if "n = 2"
(eqv? fixnum-max (+ (* (quotient fixnum-max 2) 2) 1)))
(pass-if "n = fixnum-max"
(eqv? 1 (quotient fixnum-max fixnum-max)))
(pass-if "n = fixnum-max + 1"
(eqv? 0 (quotient fixnum-max (+ fixnum-max 1))))
(pass-if "n = fixnum-min"
(eqv? 0 (quotient fixnum-max fixnum-min)))
(pass-if "n = fixnum-min - 1"
(eqv? 0 (quotient fixnum-max (- fixnum-min 1)))))
(with-test-prefix "(fixnum-max + 1) / n"
(pass-if "n = 1"
(eqv? (+ fixnum-max 1) (quotient (+ fixnum-max 1) 1)))
(pass-if "n = -1"
(eqv? (- (+ fixnum-max 1)) (quotient (+ fixnum-max 1) -1)))
(pass-if "n = 2"
(eqv? (+ fixnum-max 1) (* (quotient (+ fixnum-max 1) 2) 2)))
(pass-if "n = fixnum-max"
(eqv? 1 (quotient (+ fixnum-max 1) fixnum-max)))
(pass-if "n = fixnum-max + 1"
(eqv? 1 (quotient (+ fixnum-max 1) (+ fixnum-max 1))))
(pass-if "n = fixnum-min"
(eqv? -1 (quotient (+ fixnum-max 1) fixnum-min)))
(pass-if "n = fixnum-min - 1"
(eqv? 0 (quotient (+ fixnum-max 1) (- fixnum-min 1)))))
(with-test-prefix "fixnum-min / n"
(pass-if "n = 1"
(eqv? fixnum-min (quotient fixnum-min 1)))
(pass-if "n = -1"
(eqv? (- fixnum-min) (quotient fixnum-min -1)))
(pass-if "n = 2"
(eqv? fixnum-min (* (quotient fixnum-min 2) 2)))
(pass-if "n = fixnum-max"
(eqv? -1 (quotient fixnum-min fixnum-max)))
(pass-if "n = fixnum-max + 1"
(eqv? -1 (quotient fixnum-min (+ fixnum-max 1))))
(pass-if "n = fixnum-min"
(eqv? 1 (quotient fixnum-min fixnum-min)))
(pass-if "n = fixnum-min - 1"
(eqv? 0 (quotient fixnum-min (- fixnum-min 1))))
(pass-if "n = - fixnum-min - 1"
(eqv? -1 (quotient fixnum-min (1- (- fixnum-min)))))
;; special case, normally inum/big is zero
(pass-if "n = - fixnum-min"
(eqv? -1 (quotient fixnum-min (- fixnum-min))))
(pass-if "n = - fixnum-min + 1"
(eqv? 0 (quotient fixnum-min (1+ (- fixnum-min))))))
(with-test-prefix "(fixnum-min - 1) / n"
(pass-if "n = 1"
(eqv? (- fixnum-min 1) (quotient (- fixnum-min 1) 1)))
(pass-if "n = -1"
(eqv? (- (- fixnum-min 1)) (quotient (- fixnum-min 1) -1)))
(pass-if "n = 2"
(eqv? fixnum-min (* (quotient (- fixnum-min 1) 2) 2)))
(pass-if "n = fixnum-max"
(eqv? -1 (quotient (- fixnum-min 1) fixnum-max)))
(pass-if "n = fixnum-max + 1"
(eqv? -1 (quotient (- fixnum-min 1) (+ fixnum-max 1))))
(pass-if "n = fixnum-min"
(eqv? 1 (quotient (- fixnum-min 1) fixnum-min)))
(pass-if "n = fixnum-min - 1"
(eqv? 1 (quotient (- fixnum-min 1) (- fixnum-min 1)))))
;; Positive dividend and divisor
(pass-if "35 / 7"
(eqv? 5 (quotient 35 7)))
;; Negative dividend, positive divisor
(pass-if "-35 / 7"
(eqv? -5 (quotient -35 7)))
;; Positive dividend, negative divisor
(pass-if "35 / -7"
(eqv? -5 (quotient 35 -7)))
;; Negative dividend and divisor
(pass-if "-35 / -7"
(eqv? 5 (quotient -35 -7)))
;; Are numerical overflows detected correctly?
(with-test-prefix "division by zero"
(pass-if-exception "(quotient 1 0)"
exception:numerical-overflow
(quotient 1 0))
(pass-if-exception "(quotient bignum 0)"
exception:numerical-overflow
(quotient (+ fixnum-max 1) 0)))
;; Are wrong type arguments detected correctly?
)
;;;
;;; remainder
;;;
(with-test-prefix "remainder"
(pass-if (documented? remainder))
(with-test-prefix "0 / n"
(pass-if "n = 1"
(eqv? 0 (remainder 0 1)))
(pass-if "n = -1"
(eqv? 0 (remainder 0 -1)))
(pass-if "n = fixnum-max"
(eqv? 0 (remainder 0 fixnum-max)))
(pass-if "n = fixnum-max + 1"
(eqv? 0 (remainder 0 (+ fixnum-max 1))))
(pass-if "n = fixnum-min"
(eqv? 0 (remainder 0 fixnum-min)))
(pass-if "n = fixnum-min - 1"
(eqv? 0 (remainder 0 (- fixnum-min 1)))))
(with-test-prefix "1 / n"
(pass-if "n = 1"
(eqv? 0 (remainder 1 1)))
(pass-if "n = -1"
(eqv? 0 (remainder 1 -1)))
(pass-if "n = fixnum-max"
(eqv? 1 (remainder 1 fixnum-max)))
(pass-if "n = fixnum-max + 1"
(eqv? 1 (remainder 1 (+ fixnum-max 1))))
(pass-if "n = fixnum-min"
(eqv? 1 (remainder 1 fixnum-min)))
(pass-if "n = fixnum-min - 1"
(eqv? 1 (remainder 1 (- fixnum-min 1)))))
(with-test-prefix "-1 / n"
(pass-if "n = 1"
(eqv? 0 (remainder -1 1)))
(pass-if "n = -1"
(eqv? 0 (remainder -1 -1)))
(pass-if "n = fixnum-max"
(eqv? -1 (remainder -1 fixnum-max)))
(pass-if "n = fixnum-max + 1"
(eqv? -1 (remainder -1 (+ fixnum-max 1))))
(pass-if "n = fixnum-min"
(eqv? -1 (remainder -1 fixnum-min)))
(pass-if "n = fixnum-min - 1"
(eqv? -1 (remainder -1 (- fixnum-min 1)))))
(with-test-prefix "fixnum-max / n"
(pass-if "n = 1"
(eqv? 0 (remainder fixnum-max 1)))
(pass-if "n = -1"
(eqv? 0 (remainder fixnum-max -1)))
(pass-if "n = fixnum-max"
(eqv? 0 (remainder fixnum-max fixnum-max)))
(pass-if "n = fixnum-max + 1"
(eqv? fixnum-max (remainder fixnum-max (+ fixnum-max 1))))
(pass-if "n = fixnum-min"
(eqv? fixnum-max (remainder fixnum-max fixnum-min)))
(pass-if "n = fixnum-min - 1"
(eqv? fixnum-max (remainder fixnum-max (- fixnum-min 1)))))
(with-test-prefix "(fixnum-max + 1) / n"
(pass-if "n = 1"
(eqv? 0 (remainder (+ fixnum-max 1) 1)))
(pass-if "n = -1"
(eqv? 0 (remainder (+ fixnum-max 1) -1)))
(pass-if "n = fixnum-max"
(eqv? 1 (remainder (+ fixnum-max 1) fixnum-max)))
(pass-if "n = fixnum-max + 1"
(eqv? 0 (remainder (+ fixnum-max 1) (+ fixnum-max 1))))
(pass-if "n = fixnum-min"
(eqv? 0 (remainder (+ fixnum-max 1) fixnum-min)))
(pass-if "n = fixnum-min - 1"
(eqv? (+ fixnum-max 1) (remainder (+ fixnum-max 1) (- fixnum-min 1)))))
(with-test-prefix "fixnum-min / n"
(pass-if "n = 1"
(eqv? 0 (remainder fixnum-min 1)))
(pass-if "n = -1"
(eqv? 0 (remainder fixnum-min -1)))
(pass-if "n = fixnum-max"
(eqv? -1 (remainder fixnum-min fixnum-max)))
(pass-if "n = fixnum-max + 1"
(eqv? 0 (remainder fixnum-min (+ fixnum-max 1))))
(pass-if "n = fixnum-min"
(eqv? 0 (remainder fixnum-min fixnum-min)))
(pass-if "n = fixnum-min - 1"
(eqv? fixnum-min (remainder fixnum-min (- fixnum-min 1))))
(pass-if "n = - fixnum-min - 1"
(eqv? -1 (remainder fixnum-min (1- (- fixnum-min)))))
;; special case, normally inum%big is the inum
(pass-if "n = - fixnum-min"
(eqv? 0 (remainder fixnum-min (- fixnum-min))))
(pass-if "n = - fixnum-min + 1"
(eqv? fixnum-min (remainder fixnum-min (1+ (- fixnum-min))))))
(with-test-prefix "(fixnum-min - 1) / n"
(pass-if "n = 1"
(eqv? 0 (remainder (- fixnum-min 1) 1)))
(pass-if "n = -1"
(eqv? 0 (remainder (- fixnum-min 1) -1)))
(pass-if "n = fixnum-max"
(eqv? -2 (remainder (- fixnum-min 1) fixnum-max)))
(pass-if "n = fixnum-max + 1"
(eqv? -1 (remainder (- fixnum-min 1) (+ fixnum-max 1))))
(pass-if "n = fixnum-min"
(eqv? -1 (remainder (- fixnum-min 1) fixnum-min)))
(pass-if "n = fixnum-min - 1"
(eqv? 0 (remainder (- fixnum-min 1) (- fixnum-min 1)))))
;; Positive dividend and divisor
(pass-if "35 / 7"
(eqv? 0 (remainder 35 7)))
;; Negative dividend, positive divisor
(pass-if "-35 / 7"
(eqv? 0 (remainder -35 7)))
;; Positive dividend, negative divisor
(pass-if "35 / -7"
(eqv? 0 (remainder 35 -7)))
;; Negative dividend and divisor
(pass-if "-35 / -7"
(eqv? 0 (remainder -35 -7)))
;; Are numerical overflows detected correctly?
(with-test-prefix "division by zero"
(pass-if-exception "(remainder 1 0)"
exception:numerical-overflow
(remainder 1 0))
(pass-if-exception "(remainder bignum 0)"
exception:numerical-overflow
(remainder (+ fixnum-max 1) 0)))
;; Are wrong type arguments detected correctly?
)
;;;
;;; modulo
;;;
(with-test-prefix "modulo"
(pass-if (documented? modulo))
(with-test-prefix "0 % n"
(pass-if "n = 1"
(eqv? 0 (modulo 0 1)))
(pass-if "n = -1"
(eqv? 0 (modulo 0 -1)))
(pass-if "n = fixnum-max"
(eqv? 0 (modulo 0 fixnum-max)))
(pass-if "n = fixnum-max + 1"
(eqv? 0 (modulo 0 (+ fixnum-max 1))))
(pass-if "n = fixnum-min"
(eqv? 0 (modulo 0 fixnum-min)))
(pass-if "n = fixnum-min - 1"
(eqv? 0 (modulo 0 (- fixnum-min 1)))))
(with-test-prefix "1 % n"
(pass-if "n = 1"
(eqv? 0 (modulo 1 1)))
(pass-if "n = -1"
(eqv? 0 (modulo 1 -1)))
(pass-if "n = fixnum-max"
(eqv? 1 (modulo 1 fixnum-max)))
(pass-if "n = fixnum-max + 1"
(eqv? 1 (modulo 1 (+ fixnum-max 1))))
(pass-if "n = fixnum-min"
(eqv? (+ fixnum-min 1) (modulo 1 fixnum-min)))
(pass-if "n = fixnum-min - 1"
(eqv? fixnum-min (modulo 1 (- fixnum-min 1)))))
(with-test-prefix "-1 % n"
(pass-if "n = 1"
(eqv? 0 (modulo -1 1)))
(pass-if "n = -1"
(eqv? 0 (modulo -1 -1)))
(pass-if "n = fixnum-max"
(eqv? (- fixnum-max 1) (modulo -1 fixnum-max)))
(pass-if "n = fixnum-max + 1"
(eqv? fixnum-max (modulo -1 (+ fixnum-max 1))))
(pass-if "n = fixnum-min"
(eqv? -1 (modulo -1 fixnum-min)))
(pass-if "n = fixnum-min - 1"
(eqv? -1 (modulo -1 (- fixnum-min 1)))))
(with-test-prefix "fixnum-max % n"
(pass-if "n = 1"
(eqv? 0 (modulo fixnum-max 1)))
(pass-if "n = -1"
(eqv? 0 (modulo fixnum-max -1)))
(pass-if "n = fixnum-max"
(eqv? 0 (modulo fixnum-max fixnum-max)))
(pass-if "n = fixnum-max + 1"
(eqv? fixnum-max (modulo fixnum-max (+ fixnum-max 1))))
(pass-if "n = fixnum-min"
(eqv? -1 (modulo fixnum-max fixnum-min)))
(pass-if "n = fixnum-min - 1"
(eqv? -2 (modulo fixnum-max (- fixnum-min 1)))))
(with-test-prefix "(fixnum-max + 1) % n"
(pass-if "n = 1"
(eqv? 0 (modulo (+ fixnum-max 1) 1)))
(pass-if "n = -1"
(eqv? 0 (modulo (+ fixnum-max 1) -1)))
(pass-if "n = fixnum-max"
(eqv? 1 (modulo (+ fixnum-max 1) fixnum-max)))
(pass-if "n = fixnum-max + 1"
(eqv? 0 (modulo (+ fixnum-max 1) (+ fixnum-max 1))))
(pass-if "n = fixnum-min"
(eqv? 0 (modulo (+ fixnum-max 1) fixnum-min)))
(pass-if "n = fixnum-min - 1"
(eqv? -1 (modulo (+ fixnum-max 1) (- fixnum-min 1)))))
(with-test-prefix "fixnum-min % n"
(pass-if "n = 1"
(eqv? 0 (modulo fixnum-min 1)))
(pass-if "n = -1"
(eqv? 0 (modulo fixnum-min -1)))
(pass-if "n = fixnum-max"
(eqv? (- fixnum-max 1) (modulo fixnum-min fixnum-max)))
(pass-if "n = fixnum-max + 1"
(eqv? 0 (modulo fixnum-min (+ fixnum-max 1))))
(pass-if "n = fixnum-min"
(eqv? 0 (modulo fixnum-min fixnum-min)))
(pass-if "n = fixnum-min - 1"
(eqv? fixnum-min (modulo fixnum-min (- fixnum-min 1)))))
(with-test-prefix "(fixnum-min - 1) % n"
(pass-if "n = 1"
(eqv? 0 (modulo (- fixnum-min 1) 1)))
(pass-if "n = -1"
(eqv? 0 (modulo (- fixnum-min 1) -1)))
(pass-if "n = fixnum-max"
(eqv? (- fixnum-max 2) (modulo (- fixnum-min 1) fixnum-max)))
(pass-if "n = fixnum-max + 1"
(eqv? fixnum-max (modulo (- fixnum-min 1) (+ fixnum-max 1))))
(pass-if "n = fixnum-min"
(eqv? -1 (modulo (- fixnum-min 1) fixnum-min)))
(pass-if "n = fixnum-min - 1"
(eqv? 0 (modulo (- fixnum-min 1) (- fixnum-min 1)))))
;; Positive dividend and divisor
(pass-if "13 % 4"
(eqv? 1 (modulo 13 4)))
(pass-if "2177452800 % 86400"
(eqv? 0 (modulo 2177452800 86400)))
;; Negative dividend, positive divisor
(pass-if "-13 % 4"
(eqv? 3 (modulo -13 4)))
(pass-if "-2177452800 % 86400"
(eqv? 0 (modulo -2177452800 86400)))
;; Positive dividend, negative divisor
(pass-if "13 % -4"
(eqv? -3 (modulo 13 -4)))
(pass-if "2177452800 % -86400"
(eqv? 0 (modulo 2177452800 -86400)))
;; Negative dividend and divisor
(pass-if "-13 % -4"
(eqv? -1 (modulo -13 -4)))
(pass-if "-2177452800 % -86400"
(eqv? 0 (modulo -2177452800 -86400)))
;; Are numerical overflows detected correctly?
(with-test-prefix "division by zero"
(pass-if-exception "(modulo 1 0)"
exception:numerical-overflow
(modulo 1 0))
(pass-if-exception "(modulo bignum 0)"
exception:numerical-overflow
(modulo (+ fixnum-max 1) 0)))
;; Are wrong type arguments detected correctly?
)
;;;
;;; modulo-expt
;;;
(with-test-prefix "modulo-expt"
(pass-if (= 1 (modulo-expt 17 23 47)))
(pass-if (= 1 (modulo-expt 17 -23 47)))
(pass-if (= 17 (modulo-expt 17 -22 47)))
(pass-if (= 36 (modulo-expt 17 22 47)))
(pass-if (= 183658794479969134816674175082294846241553725240 (modulo-expt 111122223333444455556666 111122223333444455556666 1153478690012629968439432872520758982731022934717)))
(pass-if-exception
"Proper exception with 0 modulus"
exception:numerical-overflow
(modulo-expt 17 23 0))
(pass-if-exception
"Proper exception when result not invertible"
exception:numerical-overflow
(modulo-expt 10 -1 48))
(pass-if-exception
"Proper exception with wrong type argument"
exception:wrong-type-arg
(modulo-expt "Sam" 23 10))
(pass-if-exception
"Proper exception with wrong type argument"
exception:wrong-type-arg
(modulo-expt 17 9.9 10))
(pass-if-exception
"Proper exception with wrong type argument"
exception:wrong-type-arg
(modulo-expt 17 23 'Ethel)))
;;;
;;; numerator
;;;
(with-test-prefix "numerator"
(pass-if "0"
(eqv? 0 (numerator 0)))
(pass-if "1"
(eqv? 1 (numerator 1)))
(pass-if "2"
(eqv? 2 (numerator 2)))
(pass-if "-1"
(eqv? -1 (numerator -1)))
(pass-if "-2"
(eqv? -2 (numerator -2)))
(pass-if "0.0"
(eqv? 0.0 (numerator 0.0)))
(pass-if "1.0"
(eqv? 1.0 (numerator 1.0)))
(pass-if "2.0"
(eqv? 2.0 (numerator 2.0)))
(pass-if "-1.0"
(eqv? -1.0 (numerator -1.0)))
(pass-if "-2.0"
(eqv? -2.0 (numerator -2.0)))
(pass-if "0.5"
(eqv? 1.0 (numerator 0.5)))
(pass-if "0.25"
(eqv? 1.0 (numerator 0.25)))
(pass-if "0.75"
(eqv? 3.0 (numerator 0.75))))
;;;
;;; denominator
;;;
(with-test-prefix "denominator"
(pass-if "0"
(eqv? 1 (denominator 0)))
(pass-if "1"
(eqv? 1 (denominator 1)))
(pass-if "2"
(eqv? 1 (denominator 2)))
(pass-if "-1"
(eqv? 1 (denominator -1)))
(pass-if "-2"
(eqv? 1 (denominator -2)))
(pass-if "0.0"
(eqv? 1.0 (denominator 0.0)))
(pass-if "1.0"
(eqv? 1.0 (denominator 1.0)))
(pass-if "2.0"
(eqv? 1.0 (denominator 2.0)))
(pass-if "-1.0"
(eqv? 1.0 (denominator -1.0)))
(pass-if "-2.0"
(eqv? 1.0 (denominator -2.0)))
(pass-if "0.5"
(eqv? 2.0 (denominator 0.5)))
(pass-if "0.25"
(eqv? 4.0 (denominator 0.25)))
(pass-if "0.75"
(eqv? 4.0 (denominator 0.75))))
;;;
;;; gcd
;;;
(with-test-prefix "gcd"
(pass-if "documented?"
(documented? gcd))
(with-test-prefix "(n)"
(pass-if "n = -2"
(eqv? 2 (gcd -2))))
(with-test-prefix "(0 n)"
(pass-if "n = 0"
(eqv? 0 (gcd 0 0)))
(pass-if "n = 1"
(eqv? 1 (gcd 0 1)))
(pass-if "n = -1"
(eqv? 1 (gcd 0 -1)))
(pass-if "n = fixnum-max"
(eqv? fixnum-max (gcd 0 fixnum-max)))
(pass-if "n = fixnum-max + 1"
(eqv? (+ fixnum-max 1) (gcd 0 (+ fixnum-max 1))))
(pass-if "n = fixnum-min"
(eqv? (- fixnum-min) (gcd 0 fixnum-min)))
(pass-if "n = fixnum-min - 1"
(eqv? (- (- fixnum-min 1)) (gcd 0 (- fixnum-min 1)))))
(with-test-prefix "(n 0)"
(pass-if "n = 2^128 * fixnum-max"
(eqv? (ash fixnum-max 128) (gcd (ash fixnum-max 128) 0))))
(with-test-prefix "(1 n)"
(pass-if "n = 0"
(eqv? 1 (gcd 1 0)))
(pass-if "n = 1"
(eqv? 1 (gcd 1 1)))
(pass-if "n = -1"
(eqv? 1 (gcd 1 -1)))
(pass-if "n = fixnum-max"
(eqv? 1 (gcd 1 fixnum-max)))
(pass-if "n = fixnum-max + 1"
(eqv? 1 (gcd 1 (+ fixnum-max 1))))
(pass-if "n = fixnum-min"
(eqv? 1 (gcd 1 fixnum-min)))
(pass-if "n = fixnum-min - 1"
(eqv? 1 (gcd 1 (- fixnum-min 1)))))
(with-test-prefix "(-1 n)"
(pass-if "n = 0"
(eqv? 1 (gcd -1 0)))
(pass-if "n = 1"
(eqv? 1 (gcd -1 1)))
(pass-if "n = -1"
(eqv? 1 (gcd -1 -1)))
(pass-if "n = fixnum-max"
(eqv? 1 (gcd -1 fixnum-max)))
(pass-if "n = fixnum-max + 1"
(eqv? 1 (gcd -1 (+ fixnum-max 1))))
(pass-if "n = fixnum-min"
(eqv? 1 (gcd -1 fixnum-min)))
(pass-if "n = fixnum-min - 1"
(eqv? 1 (gcd -1 (- fixnum-min 1)))))
(with-test-prefix "(fixnum-max n)"
(pass-if "n = 0"
(eqv? fixnum-max (gcd fixnum-max 0)))
(pass-if "n = 1"
(eqv? 1 (gcd fixnum-max 1)))
(pass-if "n = -1"
(eqv? 1 (gcd fixnum-max -1)))
(pass-if "n = fixnum-max"
(eqv? fixnum-max (gcd fixnum-max fixnum-max)))
(pass-if "n = fixnum-max + 1"
(eqv? 1 (gcd fixnum-max (+ fixnum-max 1))))
(pass-if "n = fixnum-min"
(eqv? 1 (gcd fixnum-max fixnum-min)))
(pass-if "n = fixnum-min - 1"
(eqv? 1 (gcd fixnum-max (- fixnum-min 1)))))
(with-test-prefix "((+ fixnum-max 1) n)"
(pass-if "n = 0"
(eqv? (+ fixnum-max 1) (gcd (+ fixnum-max 1) 0)))
(pass-if "n = 1"
(eqv? 1 (gcd (+ fixnum-max 1) 1)))
(pass-if "n = -1"
(eqv? 1 (gcd (+ fixnum-max 1) -1)))
(pass-if "n = fixnum-max"
(eqv? 1 (gcd (+ fixnum-max 1) fixnum-max)))
(pass-if "n = fixnum-max + 1"
(eqv? (+ fixnum-max 1) (gcd (+ fixnum-max 1) (+ fixnum-max 1))))
(pass-if "n = fixnum-min"
(eqv? (+ fixnum-max 1) (gcd (+ fixnum-max 1) fixnum-min)))
(pass-if "n = fixnum-min - 1"
(eqv? 1 (gcd (+ fixnum-max 1) (- fixnum-min 1)))))
(with-test-prefix "(fixnum-min n)"
(pass-if "n = 0"
(eqv? (- fixnum-min) (gcd fixnum-min 0)))
(pass-if "n = 1"
(eqv? 1 (gcd fixnum-min 1)))
(pass-if "n = -1"
(eqv? 1 (gcd fixnum-min -1)))
(pass-if "n = fixnum-max"
(eqv? 1 (gcd fixnum-min fixnum-max)))
(pass-if "n = fixnum-max + 1"
(eqv? (+ fixnum-max 1) (gcd fixnum-min (+ fixnum-max 1))))
(pass-if "n = fixnum-min"
(eqv? (- fixnum-min) (gcd fixnum-min fixnum-min)))
(pass-if "n = fixnum-min - 1"
(eqv? 1 (gcd fixnum-min (- fixnum-min 1)))))
(with-test-prefix "((- fixnum-min 1) n)"
(pass-if "n = 0"
(eqv? (- (- fixnum-min 1)) (gcd (- fixnum-min 1) 0)))
(pass-if "n = 1"
(eqv? 1 (gcd (- fixnum-min 1) 1)))
(pass-if "n = -1"
(eqv? 1 (gcd (- fixnum-min 1) -1)))
(pass-if "n = fixnum-max"
(eqv? 1 (gcd (- fixnum-min 1) fixnum-max)))
(pass-if "n = fixnum-max + 1"
(eqv? 1 (gcd (- fixnum-min 1) (+ fixnum-max 1))))
(pass-if "n = fixnum-min"
(eqv? 1 (gcd (- fixnum-min 1) fixnum-min)))
(pass-if "n = fixnum-min - 1"
(eqv? (- (- fixnum-min 1)) (gcd (- fixnum-min 1) (- fixnum-min 1)))))
;; Are wrong type arguments detected correctly?
)
;;;
;;; lcm
;;;
(with-test-prefix "lcm"
;; FIXME: more tests?
;; (some of these are already in r4rs.test)
(pass-if (documented? lcm))
(pass-if (= (lcm) 1))
(pass-if (= (lcm 32 -36) 288))
(let ((big-n 115792089237316195423570985008687907853269984665640564039457584007913129639936) ; 2 ^ 256
(lcm-of-big-n-and-11 1273712981610478149659280835095566986385969831322046204434033424087044426039296))
(pass-if (= lcm-of-big-n-and-11 (lcm big-n 11)))
(pass-if (= lcm-of-big-n-and-11 (lcm 11 big-n 11)))))
;;;
;;; rationalize
;;;
(with-test-prefix "rationalize"
(pass-if (documented? rationalize))
(pass-if (eqv? 2 (rationalize 4 2 )))
(pass-if (eqv? -2 (rationalize -4 2 )))
(pass-if (eqv? 2.0 (rationalize 4 2.0)))
(pass-if (eqv? -2.0 (rationalize -4.0 2 )))
(pass-if (eqv? 0 (rationalize 4 8 )))
(pass-if (eqv? 0 (rationalize -4 8 )))
(pass-if (eqv? 0.0 (rationalize 4 8.0)))
(pass-if (eqv? 0.0 (rationalize -4.0 8 )))
(pass-if (eqv? 0.0 (rationalize 3 +inf.0)))
(pass-if (eqv? 0.0 (rationalize -3 +inf.0)))
(pass-if (real-nan? (rationalize +inf.0 +inf.0)))
(pass-if (real-nan? (rationalize +nan.0 +inf.0)))
(pass-if (real-nan? (rationalize +nan.0 4)))
(pass-if (eqv? +inf.0 (rationalize +inf.0 3)))
(pass-if (eqv? 3/10 (rationalize 3/10 0)))
(pass-if (eqv? -3/10 (rationalize -3/10 0)))
(pass-if (eqv? 1/3 (rationalize 3/10 1/10)))
(pass-if (eqv? -1/3 (rationalize -3/10 1/10)))
(pass-if (eqv? 1/3 (rationalize 3/10 -1/10)))
(pass-if (eqv? -1/3 (rationalize -3/10 -1/10)))
(pass-if (test-eqv? (/ 1.0 3) (rationalize 0.3 1/10)))
(pass-if (test-eqv? (/ -1.0 3) (rationalize -0.3 1/10)))
(pass-if (test-eqv? (/ 1.0 3) (rationalize 0.3 -1/10)))
(pass-if (test-eqv? (/ -1.0 3) (rationalize -0.3 -1/10))))
;;;
;;; number->string
;;;
(with-test-prefix "number->string"
(let ((num->str->num
(lambda (n radix)
(string->number (number->string n radix) radix))))
(pass-if (documented? number->string))
(pass-if (string=? (number->string 0) "0"))
(pass-if (string=? (number->string 171) "171"))
(pass-if (= (+ fixnum-max 1) (num->str->num (+ fixnum-max 1) 10)))
(pass-if (= (- fixnum-min 1) (num->str->num (- fixnum-min 1) 10)))
(pass-if (= (inf) (num->str->num (inf) 10)))
(pass-if (= 1.3 (num->str->num 1.3 10)))
;; XXX - some results depend on whether Guile is compiled optimzed
;; or not. It is clearly undesirable to have number->string to be
;; influenced by this.
(pass-if (string=? (number->string 35.25 36) "z.9"))
(pass-if (or (string=? (number->string 0.25 2) "0.01")
(string=? (number->string 0.25 2) "0.010")))
(pass-if (string=? (number->string 255.0625 16) "ff.1"))
(pass-if (string=? (number->string (/ 1 3) 3) "1/10"))
(pass-if (string=? (number->string 10) "10"))
(pass-if (string=? (number->string 10 11) "a"))
(pass-if (string=? (number->string 36 36) "10"))
(pass-if (= (num->str->num 36 36) 36))
(pass-if (= (string->number "z" 36) 35))
(pass-if (= (string->number "Z" 36) 35))
(pass-if (not (string->number "Z" 35)))
(pass-if (string=? (number->string 35 36) "z"))
(pass-if (= (num->str->num 35 36) 35))
;; Numeric conversion from decimal is not precise, in its current
;; implementation, so 11.333... and 1.324... can't be expected to
;; reliably come out to precise values. These tests did actually work
;; for a while, but something in gcc changed, affecting the conversion
;; code.
;;
;; (pass-if (or (string=? (number->string 11.33333333333333333 12)
;; "B.4")
;; (string=? (number->string 11.33333333333333333 12)
;; "B.400000000000009")))
;; (pass-if (or (string=? (number->string 1.324e44 16)
;; "5.EFE0A14FAFEe24")
;; (string=? (number->string 1.324e44 16)
;; "5.EFE0A14FAFDF8e24")))
))
;;;
;;; string->number
;;;
(with-test-prefix "string->number"
(pass-if "documented?"
(documented? string->number))
(pass-if "non number strings"
(for-each (lambda (x) (if (string->number x) (throw 'fail)))
'("" "q" "1q" "6+7iq" "8+9q" "10+11" "13+" "18@19q" "20@q" "23@"
"+25iq" "26i" "-q" "-iq" "i" "5#.0" "8/" "10#11" ".#" "."
"#o.2" "3.4q" "15.16e17q" "18.19e+q" ".q" ".17#18" "10q" "#b2"
"#b3" "#b4" "#b5" "#b6" "#b7" "#b8" "#b9" "#ba" "#bb" "#bc"
"#bd" "#be" "#bf" "#q" "#b#b1" "#o#o1" "#d#d1" "#x#x1" "#e#e1"
"#i#i1" "12@12+0i"))
#t)
(pass-if "valid number strings"
(for-each (lambda (couple)
(apply
(lambda (x y)
(let ((xx (string->number x)))
(if (or (eq? xx #f) (not (eqv? xx y)))
(begin
(pk x y)
(throw 'fail)))))
couple))
`(;; Radix:
("#b0" 0) ("#B0" 0) ("#b1" 1) ("#B1" 1) ("#o0" 0) ("#O0" 0)
("#o1" 1) ("#O1" 1) ("#o2" 2) ("#O2" 2) ("#o3" 3) ("#O3" 3)
("#o4" 4) ("#O4" 4) ("#o5" 5) ("#O5" 5) ("#o6" 6) ("#O6" 6)
("#o7" 7) ("#O7" 7) ("#d0" 0) ("#D0" 0) ("#d1" 1) ("#D1" 1)
("#d2" 2) ("#D2" 2) ("#d3" 3) ("#D3" 3) ("#d4" 4) ("#D4" 4)
("#d5" 5) ("#D5" 5) ("#d6" 6) ("#D6" 6) ("#d7" 7) ("#D7" 7)
("#d8" 8) ("#D8" 8) ("#d9" 9) ("#D9" 9)
("#xa" 10) ("#Xa" 10) ("#xb" 11) ("#Xb" 11)
("#xc" 12) ("#Xc" 12) ("#xd" 13) ("#Xd" 13)
("#xe" 14) ("#Xe" 14) ("#xf" 15) ("#Xf" 15)
("#b1010" 10)
("#o12345670" 2739128)
("#d1234567890" 1234567890)
("#x1234567890abcdef" 1311768467294899695)
;; Exactness:
("#e1" 1) ("#e1.2" 12/10)
("#i1.1" 1.1) ("#i1" 1.0)
;; Integers:
("1" ,(1+ 0)) ("23" ,(+ 9 9 5)) ("-1" ,(- 0 1))
("-45" ,(- 0 45)) ("2#" 20.0) ("2##" 200.0) ("12##" 1200.0)
("#b#i100" 4.0)
;; Fractions:
("1/1" 1) ("1/2" 1/2) ("-1/2" -1/2) ("1#/1" 10.0)
("10/1#" 1.0) ("1#/1#" 1.0) ("#e9/10" 9/10) ("#e10/1#" 1)
("#i6/8" 0.75) ("#i1/1" 1.0)
;; Decimal numbers:
;; * <uinteger 10> <suffix>
("1e2" 100.0) ("1E2" 100.0) ("1s2" 100.0) ("1S2" 100.0)
("1f2" 100.0) ("1F2" 100.0) ("1d2" 100.0) ("1D2" 100.0)
("1l2" 100.0) ("1L2" 100.0) ("1e+2" 100.0) ("1e-2" 0.01)
;; * . <digit 10>+ #* <suffix>
(".1" .1) (".0123456789" 123456789e-10) (".16#" 0.16)
(".0123456789e10" 123456789.0) (".16#e3" 160.0) ("#d.3" 0.3)
;; * <digit 10>+ . <digit 10>* #* <suffix>
("3." ,(exact->inexact 3)) ("3.e0" ,(exact->inexact 3))
("3.1" ,(exact->inexact 31/10)) ("3.1e0" 3.1) ("3.1#" 3.1)
("3.1#e0" 3.1)
;; * <digit 10>+ #+ . #* <suffix>
("3#." 30.0) ("3#.e0" 30.0) ("3#.#" 30.0) ("3#.#e0" 30.0)
))
#t)
(pass-if "valid complex number strings"
(for-each (lambda (triple)
(apply
(lambda (str re im)
(let ((z (string->number str)))
(if (or (eq? z #f)
(not (and (eqv? (real-part z) re)
(eqv? (imag-part z) im))))
(begin
(pk str re im)
(throw 'fail)))))
triple))
`(("1@0" 1 0) ("1@+0" 1 0) ("1@-0" 1 0) ("1/2@0" 1/2 0)
("1.0@0" 1.0 0) ("1.0@-0" 1.0 0)
("#e1@0" 1 0) ("#e1@+0" 1 0) ("#e1@-0" 1 0) ("#e0.5@0.0" 1/2 0)
("#e1.0@0" 1 0) ("#e1.0@-0" 1 0)
("#i1@0" 1.0 0.0) ("#i1@+0" 1.0 0.0) ("#i1@-0" 1.0 -0.0) ("#i1/2@0" 0.5 0.0)
("#i1.0@0" 1.0 0.0) ("#i1.0@-0" 1.0 -0.0)
("1@+0.0" 1.0 0.0) ("1.0@-0.0" 1.0 -0.0)
("2+3i" 2.0 3.0) ("4-5i" 4.0 -5.0)
("1+i" 1.0 1.0) ("1-i" 1.0 -1.0) ("+1i" 0.0 1.0) ("-1i" 0.0 -1.0)
("+i" 0.0 1.0) ("-i" 0.0 -1.0)
("1.0+.1i" 1.0 0.1) ("1.0-.1i" 1.0 -0.1)
(".1+.0i" 0.1 0.0) ("1.+.0i" 1.0 0.0) (".1+.1i" 0.1 0.1)
("1e1+.1i" 10.0 0.1)
("0@+nan.0" 0 0) ("0@+inf.0" 0 0) ("0@-inf.0" 0 0)
("0.0@+nan.0" 0.0 0.0) ("0.0@+inf.0" 0.0 0.0) ("0.0@-inf.0" 0.0 0.0)
("#i0@+nan.0" 0.0 0.0) ("#i0@+inf.0" 0.0 0.0) ("#i0@-inf.0" 0.0 0.0)
("0.0@1" 0.0 0.0) ("0.0@2" -0.0 0.0) ("0.0@4" -0.0 -0.0) ("0.0@5" 0.0 -0.0)
))
#t)
(pass-if-exception "exponent too big"
exception:out-of-range
(string->number "12.13e141414"))
;; in guile 1.6.7 and earlier, bad polar forms (where the conversion of
;; the angle gave #f) caused a segv
(pass-if "1@a"
(eq? #f (string->number "1@a"))))
;;;
;;; number?
;;;
(with-test-prefix "number?"
(pass-if (documented? number?))
(pass-if (number? 0))
(pass-if (number? 7))
(pass-if (number? -7))
(pass-if (number? 1.3))
(pass-if (number? (+ 1 fixnum-max)))
(pass-if (number? (- 1 fixnum-min)))
(pass-if (number? 3+4i))
(pass-if (not (number? #\a)))
(pass-if (not (number? "a")))
(pass-if (not (number? (make-vector 0))))
(pass-if (not (number? (cons 1 2))))
(pass-if (not (number? #t)))
(pass-if (not (number? (lambda () #t))))
(pass-if (not (number? (current-input-port)))))
;;;
;;; complex?
;;;
(with-test-prefix "complex?"
(pass-if (documented? complex?))
(pass-if (complex? 0))
(pass-if (complex? 7))
(pass-if (complex? -7))
(pass-if (complex? (+ 1 fixnum-max)))
(pass-if (complex? (- 1 fixnum-min)))
(pass-if (complex? 1.3))
(pass-if (complex? 3+4i))
(pass-if (not (complex? #\a)))
(pass-if (not (complex? "a")))
(pass-if (not (complex? (make-vector 0))))
(pass-if (not (complex? (cons 1 2))))
(pass-if (not (complex? #t)))
(pass-if (not (complex? (lambda () #t))))
(pass-if (not (complex? (current-input-port)))))
;;;
;;; real?
;;;
(with-test-prefix "real?"
(pass-if (documented? real?))
(pass-if (real? 0))
(pass-if (real? 7))
(pass-if (real? -7))
(pass-if (real? (+ 1 fixnum-max)))
(pass-if (real? (- 1 fixnum-min)))
(pass-if (real? 1.3))
(pass-if (real? +inf.0))
(pass-if (real? -inf.0))
(pass-if (real? +nan.0))
(pass-if (not (real? +inf.0-inf.0i)))
(pass-if (not (real? +nan.0+nan.0i)))
(pass-if (not (real? 3+4i)))
(pass-if (not (real? #\a)))
(pass-if (not (real? "a")))
(pass-if (not (real? (make-vector 0))))
(pass-if (not (real? (cons 1 2))))
(pass-if (not (real? #t)))
(pass-if (not (real? (lambda () #t))))
(pass-if (not (real? (current-input-port)))))
;;;
;;; rational?
;;;
(with-test-prefix "rational?"
(pass-if (documented? rational?))
(pass-if (rational? 0))
(pass-if (rational? 7))
(pass-if (rational? -7))
(pass-if (rational? (+ 1 fixnum-max)))
(pass-if (rational? (- 1 fixnum-min)))
(pass-if (rational? 1.3))
(pass-if (not (rational? +inf.0)))
(pass-if (not (rational? -inf.0)))
(pass-if (not (rational? +nan.0)))
(pass-if (not (rational? +inf.0-inf.0i)))
(pass-if (not (rational? +nan.0+nan.0i)))
(pass-if (not (rational? 3+4i)))
(pass-if (not (rational? #\a)))
(pass-if (not (rational? "a")))
(pass-if (not (rational? (make-vector 0))))
(pass-if (not (rational? (cons 1 2))))
(pass-if (not (rational? #t)))
(pass-if (not (rational? (lambda () #t))))
(pass-if (not (rational? (current-input-port)))))
;;;
;;; integer?
;;;
(with-test-prefix "integer?"
(pass-if (documented? integer?))
(pass-if (integer? 0))
(pass-if (integer? 7))
(pass-if (integer? -7))
(pass-if (integer? (+ 1 fixnum-max)))
(pass-if (integer? (- 1 fixnum-min)))
(pass-if (and (= 3+0i (round 3+0i)) (integer? 3+0i)))
(pass-if (and (= 1.0 (round 1.0)) (integer? 1.0)))
(pass-if (not (integer? 1.3)))
(pass-if (not (integer? +inf.0)))
(pass-if (not (integer? -inf.0)))
(pass-if (not (integer? +nan.0)))
(pass-if (not (integer? +inf.0-inf.0i)))
(pass-if (not (integer? +nan.0+nan.0i)))
(pass-if (not (integer? 3+4i)))
(pass-if (not (integer? #\a)))
(pass-if (not (integer? "a")))
(pass-if (not (integer? (make-vector 0))))
(pass-if (not (integer? (cons 1 2))))
(pass-if (not (integer? #t)))
(pass-if (not (integer? (lambda () #t))))
(pass-if (not (integer? (current-input-port)))))
;;;
;;; inexact?
;;;
(with-test-prefix "inexact?"
(pass-if (documented? inexact?))
(pass-if (not (inexact? 0)))
(pass-if (not (inexact? 7)))
(pass-if (not (inexact? -7)))
(pass-if (not (inexact? (+ 1 fixnum-max))))
(pass-if (not (inexact? (- 1 fixnum-min))))
(pass-if (inexact? 1.3))
(pass-if (inexact? 3.1+4.2i))
(pass-if (inexact? +inf.0))
(pass-if (inexact? -inf.0))
(pass-if (inexact? +nan.0))
(pass-if-exception "char"
exception:wrong-type-arg
(not (inexact? #\a)))
(pass-if-exception "string"
exception:wrong-type-arg
(not (inexact? "a")))
(pass-if-exception "vector"
exception:wrong-type-arg
(not (inexact? (make-vector 0))))
(pass-if-exception "cons"
exception:wrong-type-arg
(not (inexact? (cons 1 2))))
(pass-if-exception "bool"
exception:wrong-type-arg
(not (inexact? #t)))
(pass-if-exception "procedure"
exception:wrong-type-arg
(not (inexact? (lambda () #t))))
(pass-if-exception "port"
exception:wrong-type-arg
(not (inexact? (current-input-port)))))
;;;
;;; equal?
;;;
(with-test-prefix "equal?"
(pass-if (documented? equal?))
;; The following test will fail on platforms
;; without distinct signed zeroes 0.0 and -0.0.
(pass-if (not (equal? 0.0 -0.0)))
(pass-if (equal? 0 0))
(pass-if (equal? 7 7))
(pass-if (equal? -7 -7))
(pass-if (equal? (+ 1 fixnum-max) (+ 1 fixnum-max)))
(pass-if (equal? (- fixnum-min 1) (- fixnum-min 1)))
(pass-if (equal? 0.0 0.0))
(pass-if (equal? -0.0 -0.0))
(pass-if (equal? 0.0+0.0i 0.0+0.0i))
(pass-if (equal? 0.0-0.0i 0.0-0.0i))
(pass-if (equal? -0.0+0.0i -0.0+0.0i))
(pass-if (not (equal? 0 1)))
(pass-if (not (equal? 0 0.0)))
(pass-if (not (equal? 1 1.0)))
(pass-if (not (equal? 0.0 0)))
(pass-if (not (equal? 1.0 1)))
(pass-if (not (equal? -1.0 -1)))
(pass-if (not (equal? 1.0 1.0+0.0i)))
(pass-if (not (equal? 0.0 0.0+0.0i)))
(pass-if (not (equal? 0.0+0.0i 0.0-0.0i)))
(pass-if (not (equal? 0.0+0.0i -0.0+0.0i)))
(pass-if (not (equal? fixnum-max (+ 1 fixnum-max))))
(pass-if (not (equal? (+ 1 fixnum-max) fixnum-max)))
(pass-if (not (equal? (+ 1 fixnum-max) (+ 2 fixnum-max))))
(pass-if (not (equal? fixnum-min (- fixnum-min 1))))
(pass-if (not (equal? (- fixnum-min 1) fixnum-min)))
(pass-if (not (equal? (- fixnum-min 1) (- fixnum-min 2))))
(pass-if (not (equal? (+ fixnum-max 1) (- fixnum-min 1))))
(pass-if (not (equal? (ash 1 256) +inf.0)))
(pass-if (not (equal? +inf.0 (ash 1 256))))
(pass-if (not (equal? (ash 1 256) -inf.0)))
(pass-if (not (equal? -inf.0 (ash 1 256))))
;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
;; sure we've avoided that
(pass-if (not (equal? (ash 1 1024) +inf.0)))
(pass-if (not (equal? +inf.0 (ash 1 1024))))
(pass-if (not (equal? (- (ash 1 1024)) -inf.0)))
(pass-if (not (equal? -inf.0 (- (ash 1 1024)))))
(pass-if (equal? +nan.0 +nan.0))
(pass-if (equal? +nan.0 +nan.0))
(pass-if (not (equal? +nan.0 0.0+nan.0i)))
(pass-if (not (equal? 0 +nan.0)))
(pass-if (not (equal? +nan.0 0)))
(pass-if (not (equal? 1 +nan.0)))
(pass-if (not (equal? +nan.0 1)))
(pass-if (not (equal? -1 +nan.0)))
(pass-if (not (equal? +nan.0 -1)))
(pass-if (not (equal? (ash 1 256) +nan.0)))
(pass-if (not (equal? +nan.0 (ash 1 256))))
(pass-if (not (equal? (- (ash 1 256)) +nan.0)))
(pass-if (not (equal? +nan.0 (- (ash 1 256)))))
(pass-if (not (equal? (ash 1 8192) +nan.0)))
(pass-if (not (equal? +nan.0 (ash 1 8192))))
(pass-if (not (equal? (- (ash 1 8192)) +nan.0)))
(pass-if (not (equal? +nan.0 (- (ash 1 8192)))))
;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
;; sure we've avoided that
(pass-if (not (equal? (ash 3 1023) +nan.0)))
(pass-if (not (equal? +nan.0 (ash 3 1023)))))
;;;
;;; eqv?
;;;
(with-test-prefix "eqv?"
(pass-if (documented? eqv?))
;; The following test will fail on platforms
;; without distinct signed zeroes 0.0 and -0.0.
(pass-if (not (eqv? 0.0 -0.0)))
(pass-if (eqv? 0 0))
(pass-if (eqv? 7 7))
(pass-if (eqv? -7 -7))
(pass-if (eqv? (+ 1 fixnum-max) (+ 1 fixnum-max)))
(pass-if (eqv? (- fixnum-min 1) (- fixnum-min 1)))
(pass-if (eqv? 0.0 0.0))
(pass-if (eqv? -0.0 -0.0))
(pass-if (eqv? 0.0+0.0i 0.0+0.0i))
(pass-if (eqv? 0.0-0.0i 0.0-0.0i))
(pass-if (eqv? -0.0+0.0i -0.0+0.0i))
(pass-if (not (eqv? 0.0 -0.0)))
(pass-if (not (eqv? 0.0 0.0+0.0i)))
(pass-if (not (eqv? 0.0+0.0i 0.0-0.0i)))
(pass-if (not (eqv? 0.0+0.0i -0.0+0.0i)))
(pass-if (not (eqv? 0 1)))
(pass-if (not (eqv? 0 0.0)))
(pass-if (not (eqv? 1 1.0)))
(pass-if (not (eqv? 0.0 0)))
(pass-if (not (eqv? 1.0 1)))
(pass-if (not (eqv? -1.0 -1)))
(pass-if (not (eqv? 1.0 1.0+0.0i)))
(pass-if (not (eqv? 0.0 0.0+0.0i)))
(pass-if (not (eqv? fixnum-max (+ 1 fixnum-max))))
(pass-if (not (eqv? (+ 1 fixnum-max) fixnum-max)))
(pass-if (not (eqv? (+ 1 fixnum-max) (+ 2 fixnum-max))))
(pass-if (not (eqv? fixnum-min (- fixnum-min 1))))
(pass-if (not (eqv? (- fixnum-min 1) fixnum-min)))
(pass-if (not (eqv? (- fixnum-min 1) (- fixnum-min 2))))
(pass-if (not (eqv? (+ fixnum-max 1) (- fixnum-min 1))))
(pass-if (not (eqv? (ash 1 256) +inf.0)))
(pass-if (not (eqv? +inf.0 (ash 1 256))))
(pass-if (not (eqv? (ash 1 256) -inf.0)))
(pass-if (not (eqv? -inf.0 (ash 1 256))))
;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
;; sure we've avoided that
(pass-if (not (eqv? (ash 1 1024) +inf.0)))
(pass-if (not (eqv? +inf.0 (ash 1 1024))))
(pass-if (not (eqv? (- (ash 1 1024)) -inf.0)))
(pass-if (not (eqv? -inf.0 (- (ash 1 1024)))))
(pass-if (eqv? +nan.0 +nan.0))
(pass-if (not (eqv? +nan.0 0.0+nan.0i)))
(pass-if (not (eqv? 0 +nan.0)))
(pass-if (not (eqv? +nan.0 0)))
(pass-if (not (eqv? 1 +nan.0)))
(pass-if (not (eqv? +nan.0 1)))
(pass-if (not (eqv? -1 +nan.0)))
(pass-if (not (eqv? +nan.0 -1)))
(pass-if (not (eqv? (ash 1 256) +nan.0)))
(pass-if (not (eqv? +nan.0 (ash 1 256))))
(pass-if (not (eqv? (- (ash 1 256)) +nan.0)))
(pass-if (not (eqv? +nan.0 (- (ash 1 256)))))
(pass-if (not (eqv? (ash 1 8192) +nan.0)))
(pass-if (not (eqv? +nan.0 (ash 1 8192))))
(pass-if (not (eqv? (- (ash 1 8192)) +nan.0)))
(pass-if (not (eqv? +nan.0 (- (ash 1 8192)))))
;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
;; sure we've avoided that
(pass-if (not (eqv? (ash 3 1023) +nan.0)))
(pass-if (not (eqv? +nan.0 (ash 3 1023)))))
;;;
;;; =
;;;
(with-test-prefix "="
(pass-if (documented? =))
(pass-if (= 7 7))
(pass-if (= -7 -7))
(pass-if (= 1.0 1))
(pass-if (= 1 1.0))
(pass-if (= -1 -1.0))
(pass-if (= 0.0 0.0))
(pass-if (= 0.0 -0.0))
(pass-if (= 1 1.0+0.0i))
(pass-if (= 0 0))
(pass-if (= 0 0.0))
(pass-if (= 0 -0.0))
(pass-if (= 0 0.0+0.0i))
(pass-if (= 0 0.0-0.0i))
(pass-if (= 0 0.0+0.0i))
(pass-if (= 0 -0.0-0.0i))
(pass-if (= 0 0))
(pass-if (= 0.0 0))
(pass-if (= -0.0 0))
(pass-if (= 0.0+0.0i 0))
(pass-if (= 0.0-0.0i 0))
(pass-if (= 0.0+0.0i 0))
(pass-if (= -0.0-0.0i 0))
(pass-if (= 0.0+0.0i 0.0-0.0i))
(pass-if (= 0.0+0.0i -0.0+0.0i))
(pass-if (= (+ 1 fixnum-max) (+ 1 fixnum-max)))
(pass-if (= (- fixnum-min 1) (- fixnum-min 1)))
(pass-if (not (= 0 1)))
(pass-if (not (= fixnum-max (+ 1 fixnum-max))))
(pass-if (not (= (+ 1 fixnum-max) fixnum-max)))
(pass-if (not (= (+ 1 fixnum-max) (+ 2 fixnum-max))))
(pass-if (not (= fixnum-min (- fixnum-min 1))))
(pass-if (not (= (- fixnum-min 1) fixnum-min)))
(pass-if (not (= (- fixnum-min 1) (- fixnum-min 2))))
(pass-if (not (= (+ fixnum-max 1) (- fixnum-min 1))))
(pass-if (not (= (ash 1 256) +inf.0)))
(pass-if (not (= +inf.0 (ash 1 256))))
(pass-if (not (= (ash 1 256) -inf.0)))
(pass-if (not (= -inf.0 (ash 1 256))))
;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
;; sure we've avoided that
(pass-if (not (= (ash 1 1024) +inf.0)))
(pass-if (not (= +inf.0 (ash 1 1024))))
(pass-if (not (= (- (ash 1 1024)) -inf.0)))
(pass-if (not (= -inf.0 (- (ash 1 1024)))))
(pass-if (not (= +nan.0 +nan.0)))
(pass-if (not (= 0 +nan.0)))
(pass-if (not (= +nan.0 0)))
(pass-if (not (= 1 +nan.0)))
(pass-if (not (= +nan.0 1)))
(pass-if (not (= -1 +nan.0)))
(pass-if (not (= +nan.0 -1)))
(pass-if (not (= (ash 1 256) +nan.0)))
(pass-if (not (= +nan.0 (ash 1 256))))
(pass-if (not (= (- (ash 1 256)) +nan.0)))
(pass-if (not (= +nan.0 (- (ash 1 256)))))
(pass-if (not (= (ash 1 8192) +nan.0)))
(pass-if (not (= +nan.0 (ash 1 8192))))
(pass-if (not (= (- (ash 1 8192)) +nan.0)))
(pass-if (not (= +nan.0 (- (ash 1 8192)))))
;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
;; sure we've avoided that
(pass-if (not (= (ash 3 1023) +nan.0)))
(pass-if (not (= +nan.0 (ash 3 1023))))
(pass-if (= 1/2 0.5))
(pass-if (not (= 1/3 0.333333333333333333333333333333333)))
(pass-if (not (= 2/3 0.5)))
(pass-if (not (= 0.5 (+ 1/2 (/ 1 (ash 1 1000))))))
(pass-if (= 1/2 0.5+0i))
(pass-if (not (= 0.333333333333333333333333333333333 1/3)))
(pass-if (not (= 2/3 0.5+0i)))
(pass-if (not (= 1/2 0+0.5i)))
(pass-if (= 0.5 1/2))
(pass-if (not (= 0.5 2/3)))
(pass-if (not (= (+ 1/2 (/ 1 (ash 1 1000))) 0.5)))
(pass-if (= 0.5+0i 1/2))
(pass-if (not (= 0.5+0i 2/3)))
(pass-if (not (= 0+0.5i 1/2)))
;; prior to guile 1.8, inum/flonum comparisons were done just by
;; converting the inum to a double, which on a 64-bit would round making
;; say inexact 2^58 appear equal to exact 2^58+1
(pass-if (= (ash-flo 1.0 58) (ash 1 58)))
(pass-if (not (= (ash-flo 1.0 58) (1+ (ash 1 58)))))
(pass-if (not (= (ash-flo 1.0 58) (1- (ash 1 58)))))
(pass-if (= (ash 1 58) (ash-flo 1.0 58)))
(pass-if (not (= (1+ (ash 1 58)) (ash-flo 1.0 58))))
(pass-if (not (= (1- (ash 1 58)) (ash-flo 1.0 58)))))
;;;
;;; <
;;;
(with-test-prefix "<"
(pass-if "documented?"
(documented? <))
(with-test-prefix "(< 0 n)"
(pass-if "n = 0"
(not (< 0 0)))
(pass-if "n = 0.0"
(not (< 0 0.0)))
(pass-if "n = 1"
(< 0 1))
(pass-if "n = 1.0"
(< 0 1.0))
(pass-if "n = -1"
(not (< 0 -1)))
(pass-if "n = -1.0"
(not (< 0 -1.0)))
(pass-if "n = fixnum-max"
(< 0 fixnum-max))
(pass-if "n = fixnum-max + 1"
(< 0 (+ fixnum-max 1)))
(pass-if "n = fixnum-min"
(not (< 0 fixnum-min)))
(pass-if "n = fixnum-min - 1"
(not (< 0 (- fixnum-min 1)))))
(with-test-prefix "(< 0.0 n)"
(pass-if "n = 0"
(not (< 0.0 0)))
(pass-if "n = 0.0"
(not (< 0.0 0.0)))
(pass-if "n = 1"
(< 0.0 1))
(pass-if "n = 1.0"
(< 0.0 1.0))
(pass-if "n = -1"
(not (< 0.0 -1)))
(pass-if "n = -1.0"
(not (< 0.0 -1.0)))
(pass-if "n = fixnum-max"
(< 0.0 fixnum-max))
(pass-if "n = fixnum-max + 1"
(< 0.0 (+ fixnum-max 1)))
(pass-if "n = fixnum-min"
(not (< 0.0 fixnum-min)))
(pass-if "n = fixnum-min - 1"
(not (< 0.0 (- fixnum-min 1)))))
(with-test-prefix "(< 1 n)"
(pass-if "n = 0"
(not (< 1 0)))
(pass-if "n = 0.0"
(not (< 1 0.0)))
(pass-if "n = 1"
(not (< 1 1)))
(pass-if "n = 1.0"
(not (< 1 1.0)))
(pass-if "n = -1"
(not (< 1 -1)))
(pass-if "n = -1.0"
(not (< 1 -1.0)))
(pass-if "n = fixnum-max"
(< 1 fixnum-max))
(pass-if "n = fixnum-max + 1"
(< 1 (+ fixnum-max 1)))
(pass-if "n = fixnum-min"
(not (< 1 fixnum-min)))
(pass-if "n = fixnum-min - 1"
(not (< 1 (- fixnum-min 1)))))
(with-test-prefix "(< 1.0 n)"
(pass-if "n = 0"
(not (< 1.0 0)))
(pass-if "n = 0.0"
(not (< 1.0 0.0)))
(pass-if "n = 1"
(not (< 1.0 1)))
(pass-if "n = 1.0"
(not (< 1.0 1.0)))
(pass-if "n = -1"
(not (< 1.0 -1)))
(pass-if "n = -1.0"
(not (< 1.0 -1.0)))
(pass-if "n = fixnum-max"
(< 1.0 fixnum-max))
(pass-if "n = fixnum-max + 1"
(< 1.0 (+ fixnum-max 1)))
(pass-if "n = fixnum-min"
(not (< 1.0 fixnum-min)))
(pass-if "n = fixnum-min - 1"
(not (< 1.0 (- fixnum-min 1)))))
(with-test-prefix "(< -1 n)"
(pass-if "n = 0"
(< -1 0))
(pass-if "n = 0.0"
(< -1 0.0))
(pass-if "n = 1"
(< -1 1))
(pass-if "n = 1.0"
(< -1 1.0))
(pass-if "n = -1"
(not (< -1 -1)))
(pass-if "n = -1.0"
(not (< -1 -1.0)))
(pass-if "n = fixnum-max"
(< -1 fixnum-max))
(pass-if "n = fixnum-max + 1"
(< -1 (+ fixnum-max 1)))
(pass-if "n = fixnum-min"
(not (< -1 fixnum-min)))
(pass-if "n = fixnum-min - 1"
(not (< -1 (- fixnum-min 1)))))
(with-test-prefix "(< -1.0 n)"
(pass-if "n = 0"
(< -1.0 0))
(pass-if "n = 0.0"
(< -1.0 0.0))
(pass-if "n = 1"
(< -1.0 1))
(pass-if "n = 1.0"
(< -1.0 1.0))
(pass-if "n = -1"
(not (< -1.0 -1)))
(pass-if "n = -1.0"
(not (< -1.0 -1.0)))
(pass-if "n = fixnum-max"
(< -1.0 fixnum-max))
(pass-if "n = fixnum-max + 1"
(< -1.0 (+ fixnum-max 1)))
(pass-if "n = fixnum-min"
(not (< -1.0 fixnum-min)))
(pass-if "n = fixnum-min - 1"
(not (< -1.0 (- fixnum-min 1)))))
(with-test-prefix "(< fixnum-max n)"
(pass-if "n = 0"
(not (< fixnum-max 0)))
(pass-if "n = 0.0"
(not (< fixnum-max 0.0)))
(pass-if "n = 1"
(not (< fixnum-max 1)))
(pass-if "n = 1.0"
(not (< fixnum-max 1.0)))
(pass-if "n = -1"
(not (< fixnum-max -1)))
(pass-if "n = -1.0"
(not (< fixnum-max -1.0)))
(pass-if "n = fixnum-max"
(not (< fixnum-max fixnum-max)))
(pass-if "n = fixnum-max + 1"
(< fixnum-max (+ fixnum-max 1)))
(pass-if "n = fixnum-min"
(not (< fixnum-max fixnum-min)))
(pass-if "n = fixnum-min - 1"
(not (< fixnum-max (- fixnum-min 1)))))
(with-test-prefix "(< (+ fixnum-max 1) n)"
(pass-if "n = 0"
(not (< (+ fixnum-max 1) 0)))
(pass-if "n = 0.0"
(not (< (+ fixnum-max 1) 0.0)))
(pass-if "n = 1"
(not (< (+ fixnum-max 1) 1)))
(pass-if "n = 1.0"
(not (< (+ fixnum-max 1) 1.0)))
(pass-if "n = -1"
(not (< (+ fixnum-max 1) -1)))
(pass-if "n = -1.0"
(not (< (+ fixnum-max 1) -1.0)))
(pass-if "n = fixnum-max"
(not (< (+ fixnum-max 1) fixnum-max)))
(pass-if "n = fixnum-max + 1"
(not (< (+ fixnum-max 1) (+ fixnum-max 1))))
(pass-if "n = fixnum-min"
(not (< (+ fixnum-max 1) fixnum-min)))
(pass-if "n = fixnum-min - 1"
(not (< (+ fixnum-max 1) (- fixnum-min 1)))))
(with-test-prefix "(< fixnum-min n)"
(pass-if "n = 0"
(< fixnum-min 0))
(pass-if "n = 0.0"
(< fixnum-min 0.0))
(pass-if "n = 1"
(< fixnum-min 1))
(pass-if "n = 1.0"
(< fixnum-min 1.0))
(pass-if "n = -1"
(< fixnum-min -1))
(pass-if "n = -1.0"
(< fixnum-min -1.0))
(pass-if "n = fixnum-max"
(< fixnum-min fixnum-max))
(pass-if "n = fixnum-max + 1"
(< fixnum-min (+ fixnum-max 1)))
(pass-if "n = fixnum-min"
(not (< fixnum-min fixnum-min)))
(pass-if "n = fixnum-min - 1"
(not (< fixnum-min (- fixnum-min 1)))))
(with-test-prefix "(< (- fixnum-min 1) n)"
(pass-if "n = 0"
(< (- fixnum-min 1) 0))
(pass-if "n = 0.0"
(< (- fixnum-min 1) 0.0))
(pass-if "n = 1"
(< (- fixnum-min 1) 1))
(pass-if "n = 1.0"
(< (- fixnum-min 1) 1.0))
(pass-if "n = -1"
(< (- fixnum-min 1) -1))
(pass-if "n = -1.0"
(< (- fixnum-min 1) -1.0))
(pass-if "n = fixnum-max"
(< (- fixnum-min 1) fixnum-max))
(pass-if "n = fixnum-max + 1"
(< (- fixnum-min 1) (+ fixnum-max 1)))
(pass-if "n = fixnum-min"
(< (- fixnum-min 1) fixnum-min))
(pass-if "n = fixnum-min - 1"
(not (< (- fixnum-min 1) (- fixnum-min 1)))))
(pass-if (< (ash 1 256) +inf.0))
(pass-if (not (< +inf.0 (ash 1 256))))
(pass-if (not (< (ash 1 256) -inf.0)))
(pass-if (< -inf.0 (ash 1 256)))
;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
;; sure we've avoided that
(pass-if (< (1- (ash 1 1024)) +inf.0))
(pass-if (< (ash 1 1024) +inf.0))
(pass-if (< (1+ (ash 1 1024)) +inf.0))
(pass-if (not (< +inf.0 (1- (ash 1 1024)))))
(pass-if (not (< +inf.0 (ash 1 1024))))
(pass-if (not (< +inf.0 (1+ (ash 1 1024)))))
(pass-if (< -inf.0 (- (1- (ash 1 1024)))))
(pass-if (< -inf.0 (- (ash 1 1024))))
(pass-if (< -inf.0 (- (1+ (ash 1 1024)))))
(pass-if (not (< (- (1- (ash 1 1024))) -inf.0)))
(pass-if (not (< (- (ash 1 1024)) -inf.0)))
(pass-if (not (< (- (1+ (ash 1 1024))) -inf.0)))
(pass-if (not (< +nan.0 +nan.0)))
(pass-if (not (< 0 +nan.0)))
(pass-if (not (< +nan.0 0)))
(pass-if (not (< 1 +nan.0)))
(pass-if (not (< +nan.0 1)))
(pass-if (not (< -1 +nan.0)))
(pass-if (not (< +nan.0 -1)))
(pass-if (not (< (ash 1 256) +nan.0)))
(pass-if (not (< +nan.0 (ash 1 256))))
(pass-if (not (< (- (ash 1 256)) +nan.0)))
(pass-if (not (< +nan.0 (- (ash 1 256)))))
(pass-if (not (< (ash 1 8192) +nan.0)))
(pass-if (not (< +nan.0 (ash 1 8192))))
(pass-if (not (< (- (ash 1 8192)) +nan.0)))
(pass-if (not (< +nan.0 (- (ash 1 8192)))))
;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
;; sure we've avoided that
(pass-if (not (< (ash 3 1023) +nan.0)))
(pass-if (not (< (1+ (ash 3 1023)) +nan.0)))
(pass-if (not (< (1- (ash 3 1023)) +nan.0)))
(pass-if (not (< +nan.0 (ash 3 1023))))
(pass-if (not (< +nan.0 (1+ (ash 3 1023)))))
(pass-if (not (< +nan.0 (1- (ash 3 1023)))))
(with-test-prefix "inum/frac"
(pass-if (< 2 9/4))
(pass-if (< -2 9/4))
(pass-if (< -2 7/4))
(pass-if (< -2 -7/4))
(pass-if (eq? #f (< 2 7/4)))
(pass-if (eq? #f (< 2 -7/4)))
(pass-if (eq? #f (< 2 -9/4)))
(pass-if (eq? #f (< -2 -9/4))))
(with-test-prefix "bignum/frac"
(let ((x (ash 1 2048)))
(pass-if (< x (* 4/3 x)))
(pass-if (< (- x) (* 4/3 x)))
(pass-if (< (- x) (* 2/3 x)))
(pass-if (< (- x) (* -2/3 x)))
(pass-if (eq? #f (< x (* 2/3 x))))
(pass-if (eq? #f (< x (* -2/3 x))))
(pass-if (eq? #f (< x (* -4/3 x))))
(pass-if (eq? #f (< (- x) (* -4/3 x))))))
(with-test-prefix "flonum/frac"
(pass-if (< 0.75 4/3))
(pass-if (< -0.75 4/3))
(pass-if (< -0.75 2/3))
(pass-if (< -0.75 -2/3))
(pass-if (eq? #f (< 0.75 2/3)))
(pass-if (eq? #f (< 0.75 -2/3)))
(pass-if (eq? #f (< 0.75 -4/3)))
(pass-if (eq? #f (< -0.75 -4/3)))
(pass-if (< -inf.0 4/3))
(pass-if (< -inf.0 -4/3))
(pass-if (eq? #f (< +inf.0 4/3)))
(pass-if (eq? #f (< +inf.0 -4/3)))
(pass-if (eq? #f (< +nan.0 4/3)))
(pass-if (eq? #f (< +nan.0 -4/3))))
(with-test-prefix "frac/inum"
(pass-if (< 7/4 2))
(pass-if (< -7/4 2))
(pass-if (< -9/4 2))
(pass-if (< -9/4 -2))
(pass-if (eq? #f (< 9/4 2)))
(pass-if (eq? #f (< 9/4 -2)))
(pass-if (eq? #f (< 7/4 -2)))
(pass-if (eq? #f (< -7/4 -2))))
(with-test-prefix "frac/bignum"
(let ((x (ash 1 2048)))
(pass-if (< (* 2/3 x) x))
(pass-if (< (* -2/3 x) x))
(pass-if (< (* -4/3 x) x))
(pass-if (< (* -4/3 x) (- x)))
(pass-if (eq? #f (< (* 4/3 x) x)))
(pass-if (eq? #f (< (* 4/3 x) (- x))))
(pass-if (eq? #f (< (* 2/3 x) (- x))))
(pass-if (eq? #f (< (* -2/3 x) (- x))))))
(with-test-prefix "frac/flonum"
(pass-if (< 2/3 0.75))
(pass-if (< -2/3 0.75))
(pass-if (< -4/3 0.75))
(pass-if (< -4/3 -0.75))
(pass-if (eq? #f (< 4/3 0.75)))
(pass-if (eq? #f (< 4/3 -0.75)))
(pass-if (eq? #f (< 2/3 -0.75)))
(pass-if (eq? #f (< -2/3 -0.75)))
(pass-if (< 4/3 +inf.0))
(pass-if (< -4/3 +inf.0))
(pass-if (eq? #f (< 4/3 -inf.0)))
(pass-if (eq? #f (< -4/3 -inf.0)))
(pass-if (eq? #f (< 4/3 +nan.0)))
(pass-if (eq? #f (< -4/3 +nan.0))))
(with-test-prefix "frac/frac"
(pass-if (< 2/3 6/7))
(pass-if (< -2/3 6/7))
(pass-if (< -4/3 6/7))
(pass-if (< -4/3 -6/7))
(pass-if (eq? #f (< 4/3 6/7)))
(pass-if (eq? #f (< 4/3 -6/7)))
(pass-if (eq? #f (< 2/3 -6/7)))
(pass-if (eq? #f (< -2/3 -6/7)))))
;;;
;;; >
;;;
;; currently not tested -- implementation is trivial
;; (> x y) is implemented as (< y x)
;; FIXME: tests should probably be added in case we change implementation.
;;;
;;; <=
;;;
;; currently not tested -- implementation is trivial
;; (<= x y) is implemented as (not (< y x))
;; FIXME: tests should probably be added in case we change implementation.
;;;
;;; >=
;;;
;; currently not tested -- implementation is trivial
;; (>= x y) is implemented as (not (< x y))
;; FIXME: tests should probably be added in case we change implementation.
;;;
;;; zero?
;;;
(with-test-prefix "zero?"
(pass-if (documented? zero?))
(pass-if (zero? 0))
(pass-if (zero? 0.0))
(pass-if (zero? -0.0))
(pass-if (zero? 0.0+0.0i))
(pass-if (zero? 0.0-0.0i))
(pass-if (zero? 0.0+0.0i))
(pass-if (zero? -0.0-0.0i))
(pass-if (not (zero? 7)))
(pass-if (not (zero? -7)))
(pass-if (not (zero? 1/7)))
(pass-if (not (zero? -inf.0)))
(pass-if (not (zero? +inf.0)))
(pass-if (not (zero? +nan.0)))
(pass-if (not (zero? (+ 1 fixnum-max))))
(pass-if (not (zero? (- 1 fixnum-min))))
(pass-if (not (zero? 1.3)))
(pass-if (not (zero? 3.1+4.2i)))
(pass-if (not (zero? 1.0+0.0i)))
(pass-if (not (zero? 0.0-1.0i))))
;;;
;;; positive?
;;;
(with-test-prefix "positive?"
(pass-if (documented? positive?))
(pass-if (positive? 1))
(pass-if (positive? (+ fixnum-max 1)))
(pass-if (positive? 1.3))
(pass-if (not (positive? 0)))
(pass-if (not (positive? -1)))
(pass-if (not (positive? (- fixnum-min 1))))
(pass-if (not (positive? -1.3))))
;;;
;;; negative?
;;;
(with-test-prefix "negative?"
(pass-if (documented? negative?))
(pass-if (not (negative? 1)))
(pass-if (not (negative? (+ fixnum-max 1))))
(pass-if (not (negative? 1.3)))
(pass-if (not (negative? 0)))
(pass-if (negative? -1))
(pass-if (negative? (- fixnum-min 1)))
(pass-if (negative? -1.3)))
;;;
;;; max
;;;
(with-test-prefix "max"
(pass-if-exception "no args" exception:wrong-num-args
(max))
(pass-if-exception "one complex" exception:wrong-type-arg
(max 1+i))
(pass-if-exception "inum/complex" exception:wrong-type-arg
(max 123 1+i))
(pass-if-exception "big/complex" exception:wrong-type-arg
(max 9999999999999999999999999999999999999999 1+i))
(pass-if-exception "real/complex" exception:wrong-type-arg
(max 123.0 1+i))
(pass-if-exception "frac/complex" exception:wrong-type-arg
(max 123/456 1+i))
(pass-if-exception "complex/inum" exception:wrong-type-arg
(max 1+i 123))
(pass-if-exception "complex/big" exception:wrong-type-arg
(max 1+i 9999999999999999999999999999999999999999))
(pass-if-exception "complex/real" exception:wrong-type-arg
(max 1+i 123.0))
(pass-if-exception "complex/frac" exception:wrong-type-arg
(max 1+i 123/456))
(let ((big*2 (* fixnum-max 2))
(big*3 (* fixnum-max 3))
(big*4 (* fixnum-max 4))
(big*5 (* fixnum-max 5)))
(with-test-prefix "inum / frac"
(pass-if (eqv? 3 (max 3 5/2)))
(pass-if (eqv? 5/2 (max 2 5/2))))
(with-test-prefix "frac / inum"
(pass-if (eqv? 3 (max 5/2 3)))
(pass-if (eqv? 5/2 (max 5/2 2))))
(with-test-prefix "infinities and NaNs"
;; +inf.0 beats everything else, including NaNs
(pass-if (eqv? +inf.0 (max +inf.0 123 )))
(pass-if (eqv? +inf.0 (max 123 +inf.0 )))
(pass-if (eqv? +inf.0 (max +inf.0 -123.3 )))
(pass-if (eqv? +inf.0 (max -123.3 +inf.0 )))
(pass-if (eqv? +inf.0 (max +inf.0 -7/2 )))
(pass-if (eqv? +inf.0 (max -7/2 +inf.0 )))
(pass-if (eqv? +inf.0 (max +inf.0 -1e20 )))
(pass-if (eqv? +inf.0 (max -1e20 +inf.0 )))
(pass-if (eqv? +inf.0 (max +inf.0 (- big*2))))
(pass-if (eqv? +inf.0 (max (- big*2) +inf.0 )))
(pass-if (eqv? +inf.0 (max +inf.0 +inf.0 )))
(pass-if (eqv? +inf.0 (max +inf.0 +inf.0 )))
(pass-if (eqv? +inf.0 (max +inf.0 +nan.0 )))
(pass-if (eqv? +inf.0 (max +nan.0 +inf.0 )))
(pass-if (eqv? +inf.0 (max +inf.0 +inf.0 )))
;; NaNs beat everything except +inf.0
(pass-if (real-nan? (max +nan.0 123 )))
(pass-if (real-nan? (max 123 +nan.0 )))
(pass-if (real-nan? (max +nan.0 123.3 )))
(pass-if (real-nan? (max 123.3 +nan.0 )))
(pass-if (real-nan? (max +nan.0 -7/2 )))
(pass-if (real-nan? (max -7/2 +nan.0 )))
(pass-if (real-nan? (max +nan.0 -1e20 )))
(pass-if (real-nan? (max -1e20 +nan.0 )))
(pass-if (real-nan? (max +nan.0 (- big*2))))
(pass-if (real-nan? (max (- big*2) +nan.0 )))
(pass-if (real-nan? (max +nan.0 -inf.0 )))
(pass-if (real-nan? (max -inf.0 +nan.0 )))
(pass-if (real-nan? (max +nan.0 +nan.0 )))
;; -inf.0 always loses, except against itself
(pass-if (eqv? -inf.0 (max -inf.0 -inf.0 )))
(pass-if (eqv? -123.0 (max -inf.0 -123 )))
(pass-if (eqv? -123.0 (max -123 -inf.0 )))
(pass-if (eqv? -123.3 (max -inf.0 -123.3 )))
(pass-if (eqv? -123.3 (max -123.3 -inf.0 )))
(pass-if (eqv? -3.5 (max -inf.0 -7/2 )))
(pass-if (eqv? -3.5 (max -7/2 -inf.0 )))
(pass-if (eqv? -1.0e20 (max -inf.0 -1e20 )))
(pass-if (eqv? -1.0e20 (max -1e20 -inf.0 )))
(pass-if (eqv? (exact->inexact (- big*2))
(max -inf.0 (- big*2))))
(pass-if (eqv? (exact->inexact (- big*2))
(max (- big*2) -inf.0 ))))
(with-test-prefix "signed zeroes"
(pass-if (eqv? 0.0 (max 0.0 0.0)))
(pass-if (eqv? 0.0 (max 0.0 -0.0)))
(pass-if (eqv? 0.0 (max -0.0 0.0)))
(pass-if (eqv? -0.0 (max -0.0 -0.0)))
(pass-if (eqv? 0.0 (max -0.0 0 )))
(pass-if (eqv? 0.0 (max 0.0 0 )))
(pass-if (eqv? 0.0 (max 0 -0.0)))
(pass-if (eqv? 0.0 (max 0 0.0)))
(pass-if (eqv? 0 (min 0 0 ))))
(with-test-prefix "big / frac"
(pass-if (eqv? big*2 (max big*2 5/2)))
(pass-if (eqv? 5/2 (max (- big*2) 5/2))))
(with-test-prefix "frac / big"
(pass-if (eqv? big*2 (max 5/2 big*2)))
(pass-if (eqv? 5/2 (max 5/2 (- big*2)))))
(with-test-prefix "big / real"
(pass-if (real-nan? (max big*5 +nan.0)))
(pass-if (eqv? (exact->inexact big*5) (max big*5 -inf.0)))
(pass-if (eqv? (exact->inexact big*5) (max big*5 1.0)))
(pass-if (eqv? +inf.0 (max big*5 +inf.0)))
(pass-if (eqv? 1.0 (max (- big*5) 1.0))))
(with-test-prefix "real / big"
(pass-if (real-nan? (max +nan.0 big*5)))
(pass-if (eqv? (exact->inexact big*5) (max -inf.0 big*5)))
(pass-if (eqv? (exact->inexact big*5) (max 1.0 big*5)))
(pass-if (eqv? +inf.0 (max +inf.0 big*5)))
(pass-if (eqv? 1.0 (max 1.0 (- big*5)))))
(with-test-prefix "frac / frac"
(pass-if (eqv? 2/3 (max 1/2 2/3)))
(pass-if (eqv? 2/3 (max 2/3 1/2)))
(pass-if (eqv? -1/2 (max -1/2 -2/3)))
(pass-if (eqv? -1/2 (max -2/3 -1/2))))
(with-test-prefix "real / real"
(pass-if (real-nan? (max 123.0 +nan.0)))
(pass-if (real-nan? (max +nan.0 123.0)))
(pass-if (real-nan? (max +nan.0 +nan.0)))
(pass-if (eqv? 456.0 (max 123.0 456.0)))
(pass-if (eqv? 456.0 (max 456.0 123.0)))))
;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
;; sure we've avoided that
(for-each (lambda (b)
(pass-if (list b +inf.0)
(eqv? +inf.0 (max b +inf.0)))
(pass-if (list +inf.0 b)
(eqv? +inf.0 (max b +inf.0)))
(pass-if (list b -inf.0)
(eqv? (exact->inexact b) (max b -inf.0)))
(pass-if (list -inf.0 b)
(eqv? (exact->inexact b) (max b -inf.0))))
(list (1- (ash 1 1024))
(ash 1 1024)
(1+ (ash 1 1024))
(- (1- (ash 1 1024)))
(- (ash 1 1024))
(- (1+ (ash 1 1024)))))
;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
;; sure we've avoided that
(pass-if (real-nan? (max (ash 1 2048) +nan.0)))
(pass-if (real-nan? (max +nan.0 (ash 1 2048)))))
;;;
;;; min
;;;
;; FIXME: unfinished...
(with-test-prefix "min"
(pass-if-exception "no args" exception:wrong-num-args
(min))
(pass-if-exception "one complex" exception:wrong-type-arg
(min 1+i))
(pass-if-exception "inum/complex" exception:wrong-type-arg
(min 123 1+i))
(pass-if-exception "big/complex" exception:wrong-type-arg
(min 9999999999999999999999999999999999999999 1+i))
(pass-if-exception "real/complex" exception:wrong-type-arg
(min 123.0 1+i))
(pass-if-exception "frac/complex" exception:wrong-type-arg
(min 123/456 1+i))
(pass-if-exception "complex/inum" exception:wrong-type-arg
(min 1+i 123))
(pass-if-exception "complex/big" exception:wrong-type-arg
(min 1+i 9999999999999999999999999999999999999999))
(pass-if-exception "complex/real" exception:wrong-type-arg
(min 1+i 123.0))
(pass-if-exception "complex/frac" exception:wrong-type-arg
(min 1+i 123/456))
(let ((big*2 (* fixnum-max 2))
(big*3 (* fixnum-max 3))
(big*4 (* fixnum-max 4))
(big*5 (* fixnum-max 5)))
(pass-if (documented? min))
(pass-if (eqv? 1 (min 7 3 1 5)))
(pass-if (eqv? 1 (min 1 7 3 5)))
(pass-if (eqv? 1 (min 7 3 5 1)))
(pass-if (eqv? -7 (min 2 3 4 -2 5 -7 1 -1 4 2)))
(pass-if (eqv? -7 (min -7 2 3 4 -2 5 1 -1 4 2)))
(pass-if (eqv? -7 (min 2 3 4 -2 5 1 -1 4 2 -7)))
(pass-if (eqv? big*2 (min big*3 big*5 big*2 big*4)))
(pass-if (eqv? big*2 (min big*2 big*3 big*5 big*4)))
(pass-if (eqv? big*2 (min big*3 big*5 big*4 big*2)))
(pass-if
(eqv? (- fixnum-min 1) (min 2 4 (- fixnum-min 1) 3 (* 2 fixnum-max))))
(pass-if
(eqv? (- fixnum-min 1) (min (- fixnum-min 1) 2 4 3 (* 2 fixnum-max))))
(pass-if
(eqv? (- fixnum-min 1) (min 2 4 3 (* 2 fixnum-max) (- fixnum-min 1))))
(with-test-prefix "inum / frac"
(pass-if (eqv? 5/2 (min 3 5/2)))
(pass-if (eqv? 2 (min 2 5/2))))
(with-test-prefix "frac / inum"
(pass-if (eqv? 5/2 (min 5/2 3)))
(pass-if (eqv? 2 (min 5/2 2))))
(with-test-prefix "infinities and NaNs"
;; -inf.0 beats everything else, including NaNs
(pass-if (eqv? -inf.0 (min -inf.0 123 )))
(pass-if (eqv? -inf.0 (min 123 -inf.0 )))
(pass-if (eqv? -inf.0 (min -inf.0 -123.3 )))
(pass-if (eqv? -inf.0 (min -123.3 -inf.0 )))
(pass-if (eqv? -inf.0 (min -inf.0 -7/2 )))
(pass-if (eqv? -inf.0 (min -7/2 -inf.0 )))
(pass-if (eqv? -inf.0 (min -inf.0 -1e20 )))
(pass-if (eqv? -inf.0 (min -1e20 -inf.0 )))
(pass-if (eqv? -inf.0 (min -inf.0 (- big*2))))
(pass-if (eqv? -inf.0 (min (- big*2) -inf.0 )))
(pass-if (eqv? -inf.0 (min -inf.0 +inf.0 )))
(pass-if (eqv? -inf.0 (min +inf.0 -inf.0 )))
(pass-if (eqv? -inf.0 (min -inf.0 +nan.0 )))
(pass-if (eqv? -inf.0 (min +nan.0 -inf.0 )))
(pass-if (eqv? -inf.0 (min -inf.0 -inf.0 )))
;; NaNs beat everything except -inf.0
(pass-if (real-nan? (min +nan.0 123 )))
(pass-if (real-nan? (min 123 +nan.0 )))
(pass-if (real-nan? (min +nan.0 123.3 )))
(pass-if (real-nan? (min 123.3 +nan.0 )))
(pass-if (real-nan? (min +nan.0 -7/2 )))
(pass-if (real-nan? (min -7/2 +nan.0 )))
(pass-if (real-nan? (min +nan.0 -1e20 )))
(pass-if (real-nan? (min -1e20 +nan.0 )))
(pass-if (real-nan? (min +nan.0 (- big*2))))
(pass-if (real-nan? (min (- big*2) +nan.0 )))
(pass-if (real-nan? (min +nan.0 +inf.0 )))
(pass-if (real-nan? (min +inf.0 +nan.0 )))
(pass-if (real-nan? (min +nan.0 +nan.0 )))
;; +inf.0 always loses, except against itself
(pass-if (eqv? +inf.0 (min +inf.0 +inf.0 )))
(pass-if (eqv? -123.0 (min +inf.0 -123 )))
(pass-if (eqv? -123.0 (min -123 +inf.0 )))
(pass-if (eqv? -123.3 (min +inf.0 -123.3 )))
(pass-if (eqv? -123.3 (min -123.3 +inf.0 )))
(pass-if (eqv? -3.5 (min +inf.0 -7/2 )))
(pass-if (eqv? -3.5 (min -7/2 +inf.0 )))
(pass-if (eqv? -1.0e20 (min +inf.0 -1e20 )))
(pass-if (eqv? -1.0e20 (min -1e20 +inf.0 )))
(pass-if (eqv? (exact->inexact (- big*2))
(min +inf.0 (- big*2))))
(pass-if (eqv? (exact->inexact (- big*2))
(min (- big*2) +inf.0 ))))
(with-test-prefix "signed zeroes"
(pass-if (eqv? 0.0 (min 0.0 0.0)))
(pass-if (eqv? -0.0 (min 0.0 -0.0)))
(pass-if (eqv? -0.0 (min -0.0 0.0)))
(pass-if (eqv? -0.0 (min -0.0 -0.0)))
(pass-if (eqv? -0.0 (min -0.0 0 )))
(pass-if (eqv? 0.0 (min 0.0 0 )))
(pass-if (eqv? -0.0 (min 0 -0.0)))
(pass-if (eqv? 0.0 (min 0 0.0)))
(pass-if (eqv? 0 (min 0 0 ))))
(with-test-prefix "big / frac"
(pass-if (eqv? 5/2 (min big*2 5/2)))
(pass-if (eqv? (- big*2) (min (- big*2) 5/2))))
(with-test-prefix "frac / big"
(pass-if (eqv? 5/2 (min 5/2 big*2)))
(pass-if (eqv? (- big*2) (min 5/2 (- big*2)))))
(with-test-prefix "big / real"
(pass-if (real-nan? (min big*5 +nan.0)))
(pass-if (eqv? (exact->inexact big*5) (min big*5 +inf.0)))
(pass-if (eqv? -inf.0 (min big*5 -inf.0)))
(pass-if (eqv? 1.0 (min big*5 1.0)))
(pass-if (eqv? (exact->inexact (- big*5)) (min (- big*5) 1.0))))
(with-test-prefix "real / big"
(pass-if (real-nan? (min +nan.0 big*5)))
(pass-if (eqv? (exact->inexact big*5) (min +inf.0 big*5)))
(pass-if (eqv? -inf.0 (min -inf.0 big*5)))
(pass-if (eqv? 1.0 (min 1.0 big*5)))
(pass-if (eqv? (exact->inexact (- big*5)) (min 1.0 (- big*5)))))
(with-test-prefix "frac / frac"
(pass-if (eqv? 1/2 (min 1/2 2/3)))
(pass-if (eqv? 1/2 (min 2/3 1/2)))
(pass-if (eqv? -2/3 (min -1/2 -2/3)))
(pass-if (eqv? -2/3 (min -2/3 -1/2))))
(with-test-prefix "real / real"
(pass-if (real-nan? (min 123.0 +nan.0)))
(pass-if (real-nan? (min +nan.0 123.0)))
(pass-if (real-nan? (min +nan.0 +nan.0)))
(pass-if (eqv? 123.0 (min 123.0 456.0)))
(pass-if (eqv? 123.0 (min 456.0 123.0)))))
;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
;; sure we've avoided that
(for-each (lambda (b)
(pass-if (list b +inf.0)
(eqv? (exact->inexact b) (min b +inf.0)))
(pass-if (list +inf.0 b)
(eqv? (exact->inexact b) (min b +inf.0)))
(pass-if (list b -inf.0)
(eqv? -inf.0 (min b -inf.0)))
(pass-if (list -inf.0 b)
(eqv? -inf.0 (min b -inf.0))))
(list (1- (ash 1 1024))
(ash 1 1024)
(1+ (ash 1 1024))
(- (1- (ash 1 1024)))
(- (ash 1 1024))
(- (1+ (ash 1 1024)))))
;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
;; sure we've avoided that
(pass-if (real-nan? (min (- (ash 1 2048)) (- +nan.0))))
(pass-if (real-nan? (min (- +nan.0) (- (ash 1 2048))))))
;;;
;;; +
;;;
(with-test-prefix/c&e "+"
(pass-if "documented?"
(documented? +))
(pass-if "simple"
(and (eqv? 7 (+ 3 4))
(eqv? 3 (+ 3))
(eqv? 0 (+))))
(pass-if "exactness propagation"
(and (eqv? 8 (+ 3 5))
(eqv? 8.0 (+ 3 5.0))
(eqv? 8.0 (+ 3.0 5))
(eqv? 8.0 (+ 3.0 5.0))
(eqv? 5/6 (+ 1/2 1/3))
(eqv? 5.5 (+ 1/2 5.0))
(eqv? 3.25 (+ 3.0 1/4))))
(pass-if "signed zeroes"
(and (eqv? 0.0 (+ 0.0))
(eqv? -0.0 (+ -0.0))
(eqv? 0.0 (+ 0.0 0.0))
(eqv? 0.0 (+ 0.0 -0.0))
(eqv? 0.0 (+ -0.0 0.0))
(eqv? -0.0 (+ -0.0 -0.0))))
(pass-if "NaNs"
(and (real-nan? (+ +nan.0 +nan.0))
(real-nan? (+ 0 +nan.0))
(real-nan? (+ +nan.0 0))
(real-nan? (+ 1 +nan.0))
(real-nan? (+ +nan.0 1))
(real-nan? (+ -1 +nan.0))
(real-nan? (+ +nan.0 -1))
(real-nan? (+ -7/2 +nan.0))
(real-nan? (+ +nan.0 -7/2))
(real-nan? (+ 1e20 +nan.0))
(real-nan? (+ +nan.0 1e20))
(real-nan? (+ +inf.0 +nan.0))
(real-nan? (+ +nan.0 +inf.0))
(real-nan? (+ -inf.0 +nan.0))
(real-nan? (+ +nan.0 -inf.0))
(real-nan? (+ (* fixnum-max 2) +nan.0))
(real-nan? (+ +nan.0 (* fixnum-max 2)))))
(pass-if "infinities"
(and (eqv? +inf.0 (+ +inf.0 +inf.0))
(eqv? -inf.0 (+ -inf.0 -inf.0))
(real-nan? (+ +inf.0 -inf.0))
(real-nan? (+ -inf.0 +inf.0))))
;; The maximum fixnum on a 32-bit architecture: 2^29 - 1.
(pass-if "fixnum + fixnum = bignum (32-bit)"
(eqv? 536870912 (+ 536870910 2)))
;; The maximum fixnum on a 64-bit architecture: 2^61 - 1.
(pass-if "fixnum + fixnum = bignum (64-bit)"
(eqv? 2305843009213693952 (+ 2305843009213693950 2)))
(pass-if "bignum + fixnum = fixnum"
(eqv? 0 (+ (1+ most-positive-fixnum) most-negative-fixnum))))
;;;
;;; -
;;;
(with-test-prefix/c&e "-"
(pass-if "double-negation of fixnum-min: ="
(= fixnum-min (- (- fixnum-min))))
(pass-if "double-negation of fixnum-min: eqv?"
(eqv? fixnum-min (- (- fixnum-min))))
(pass-if "double-negation of fixnum-min: equal?"
(equal? fixnum-min (- (- fixnum-min))))
(pass-if "binary double-negation of fixnum-min: ="
(= fixnum-min (- 0 (- 0 fixnum-min))))
(pass-if "binary double-negation of fixnum-min: eqv?"
(eqv? fixnum-min (- 0 (- 0 fixnum-min))))
(pass-if "binary double-negation of fixnum-min: equal?"
(equal? fixnum-min (- 0 (- 0 fixnum-min))))
(pass-if "signed zeroes"
(and (eqv? +0.0 (- -0.0))
(eqv? -0.0 (- +0.0))
(eqv? 0.0 (- 0.0 0.0))
(eqv? 0.0 (- 0.0 -0.0))
(eqv? 0.0 (- -0.0 -0.0))
(eqv? -0.0 (- -0.0 0.0))))
(pass-if "exactness propagation"
(and (eqv? 3 (- 8 5))
(eqv? 3.0 (- 8 5.0))
(eqv? 3.0 (- 8.0 5))
(eqv? 3.0 (- 8.0 5.0))
(eqv? -1/6 (- 1/3 1/2))
(eqv? -4.5 (- 1/2 5.0))
(eqv? 2.75 (- 3.0 1/4))))
(pass-if "infinities"
(and (eqv? +inf.0 (- +inf.0 -inf.0))
(eqv? -inf.0 (- -inf.0 +inf.0))
(real-nan? (- +inf.0 +inf.0))
(real-nan? (- -inf.0 -inf.0))))
(pass-if "NaNs"
(and (real-nan? (- +nan.0 +nan.0))
(real-nan? (- 0 +nan.0))
(real-nan? (- +nan.0 0))
(real-nan? (- 1 +nan.0))
(real-nan? (- +nan.0 1))
(real-nan? (- -1 +nan.0))
(real-nan? (- +nan.0 -1))
(real-nan? (- -7/2 +nan.0))
(real-nan? (- +nan.0 -7/2))
(real-nan? (- 1e20 +nan.0))
(real-nan? (- +nan.0 1e20))
(real-nan? (- +inf.0 +nan.0))
(real-nan? (- +nan.0 +inf.0))
(real-nan? (- -inf.0 +nan.0))
(real-nan? (- +nan.0 -inf.0))
(real-nan? (- (* fixnum-max 2) +nan.0))
(real-nan? (- +nan.0 (* fixnum-max 2)))))
(pass-if "(eqv? fixnum-min (- (- fixnum-min)))"
(eqv? fixnum-min (- (- fixnum-min))))
(pass-if "(eqv? fixnum-min (- 0 (- 0 fixnum-min)))"
(eqv? fixnum-min (- 0 (- 0 fixnum-min))))
(pass-if "(eqv? fixnum-num (apply - (list (apply - (list fixnum-min)))))"
(eqv? fixnum-min (apply - (list (apply - (list fixnum-min))))))
(pass-if "-inum - +bignum"
(= #x-100000000000000000000000000000001
(- -1 #x100000000000000000000000000000000)))
(pass-if "big - inum"
(= #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
(- #x100000000000000000000000000000000 1)))
(pass-if "big - -inum"
(= #x100000000000000000000000000000001
(- #x100000000000000000000000000000000 -1)))
;; The mininum fixnum on a 32-bit architecture: -2^29.
(pass-if "fixnum - fixnum = bignum (32-bit)"
(eqv? -536870912 (- -536870910 2)))
;; The minimum fixnum on a 64-bit architecture: -2^61.
(pass-if "fixnum - fixnum = bignum (64-bit)"
(eqv? -2305843009213693952 (- -2305843009213693950 2)))
(pass-if "bignum - fixnum = fixnum"
(eqv? most-positive-fixnum (- (1+ most-positive-fixnum) 1))))
;;;
;;; *
;;;
(with-test-prefix "*"
(with-test-prefix "double-negation of fixnum-min"
(pass-if (= fixnum-min (* -1 (* -1 fixnum-min))))
(pass-if (eqv? fixnum-min (* -1 (* -1 fixnum-min))))
(pass-if (equal? fixnum-min (* -1 (* -1 fixnum-min))))
(pass-if (= fixnum-min (* (* fixnum-min -1) -1)))
(pass-if (eqv? fixnum-min (* (* fixnum-min -1) -1)))
(pass-if (equal? fixnum-min (* (* fixnum-min -1) -1))))
(with-test-prefix "signed zeroes"
(pass-if (eqv? +0.0 (* +0.0 +0.0)))
(pass-if (eqv? -0.0 (* -0.0 +0.0)))
(pass-if (eqv? +0.0 (* -0.0 -0.0)))
(pass-if (eqv? -0.0 (* +0.0 -0.0)))
(pass-if (eqv? +0.0+0.0i (* +i +0.0)))
(pass-if (eqv? +0.0-0.0i (* -i +0.0)))
(pass-if (eqv? -0.0-0.0i (* +i -0.0)))
(pass-if (eqv? -0.0+0.0i (* -i -0.0))))
(with-test-prefix "exactness propagation"
(pass-if (eqv? -0.0 (* 0 -1.0 )))
(pass-if (eqv? 0.0 (* 0 1.0 )))
(pass-if (eqv? -0.0 (* -1.0 0 )))
(pass-if (eqv? 0.0 (* 1.0 0 )))
(pass-if (eqv? 0 (* 0 1/2 )))
(pass-if (eqv? 0 (* 1/2 0 )))
(pass-if (eqv? 0.0+0.0i (* 0 1+i )))
(pass-if (eqv? 0.0+0.0i (* 1+i 0 )))
(pass-if (eqv? -1.0 (* 1 -1.0 )))
(pass-if (eqv? 1.0 (* 1 1.0 )))
(pass-if (eqv? -1.0 (* -1.0 1 )))
(pass-if (eqv? 1.0 (* 1.0 1 )))
(pass-if (eqv? 1/2 (* 1 1/2 )))
(pass-if (eqv? 1/2 (* 1/2 1 )))
(pass-if (eqv? 1+i (* 1 1+i )))
(pass-if (eqv? 1+i (* 1+i 1 ))))
(with-test-prefix "propagation of NaNs"
(pass-if (real-nan? (* +nan.0 +nan.0)))
(pass-if (real-nan? (* +nan.0 1 )))
(pass-if (real-nan? (* +nan.0 -1 )))
(pass-if (real-nan? (* +nan.0 -7/2 )))
(pass-if (real-nan? (* +nan.0 1e20 )))
(pass-if (real-nan? (* 1 +nan.0)))
(pass-if (real-nan? (* -1 +nan.0)))
(pass-if (real-nan? (* -7/2 +nan.0)))
(pass-if (real-nan? (* 1e20 +nan.0)))
(pass-if (real-nan? (* +inf.0 +nan.0)))
(pass-if (real-nan? (* +nan.0 +inf.0)))
(pass-if (real-nan? (* -inf.0 +nan.0)))
(pass-if (real-nan? (* +nan.0 -inf.0)))
(pass-if (real-nan? (* (* fixnum-max 2) +nan.0)))
(pass-if (real-nan? (* +nan.0 (* fixnum-max 2))))
(pass-if (real-nan? (* 0 +nan.0 )))
(pass-if (real-nan? (* +nan.0 0 )))
(pass-if (almost-real-nan? (* 0 +nan.0+i)))
(pass-if (almost-real-nan? (* +nan.0+i 0 )))
(pass-if (imaginary-nan? (* 0 +nan.0i )))
(pass-if (imaginary-nan? (* +nan.0i 0 )))
(pass-if (imaginary-nan? (* 0 1+nan.0i )))
(pass-if (imaginary-nan? (* 1+nan.0i 0 )))
(pass-if (complex-nan? (* 0 +nan.0+nan.0i )))
(pass-if (complex-nan? (* +nan.0+nan.0i 0 ))))
(with-test-prefix "infinities"
(pass-if (eqv? +inf.0 (* +inf.0 5 )))
(pass-if (eqv? -inf.0 (* +inf.0 -5 )))
(pass-if (eqv? +inf.0 (* +inf.0 73.1)))
(pass-if (eqv? -inf.0 (* +inf.0 -9.2)))
(pass-if (eqv? +inf.0 (* +inf.0 5/2)))
(pass-if (eqv? -inf.0 (* +inf.0 -5/2)))
(pass-if (eqv? -inf.0 (* -5 +inf.0)))
(pass-if (eqv? +inf.0 (* 73.1 +inf.0)))
(pass-if (eqv? -inf.0 (* -9.2 +inf.0)))
(pass-if (eqv? +inf.0 (* 5/2 +inf.0)))
(pass-if (eqv? -inf.0 (* -5/2 +inf.0)))
(pass-if (eqv? -inf.0 (* -inf.0 5 )))
(pass-if (eqv? +inf.0 (* -inf.0 -5 )))
(pass-if (eqv? -inf.0 (* -inf.0 73.1)))
(pass-if (eqv? +inf.0 (* -inf.0 -9.2)))
(pass-if (eqv? -inf.0 (* -inf.0 5/2)))
(pass-if (eqv? +inf.0 (* -inf.0 -5/2)))
(pass-if (eqv? +inf.0 (* -5 -inf.0)))
(pass-if (eqv? -inf.0 (* 73.1 -inf.0)))
(pass-if (eqv? +inf.0 (* -9.2 -inf.0)))
(pass-if (eqv? -inf.0 (* 5/2 -inf.0)))
(pass-if (eqv? +inf.0 (* -5/2 -inf.0)))
(pass-if (real-nan? (* 0.0 +inf.0)))
(pass-if (real-nan? (* -0.0 +inf.0)))
(pass-if (real-nan? (* +inf.0 0.0)))
(pass-if (real-nan? (* +inf.0 -0.0)))
(pass-if (real-nan? (* 0.0 -inf.0)))
(pass-if (real-nan? (* -0.0 -inf.0)))
(pass-if (real-nan? (* -inf.0 0.0)))
(pass-if (real-nan? (* -inf.0 -0.0)))
(pass-if (real-nan? (* 0 +inf.0 )))
(pass-if (real-nan? (* +inf.0 0 )))
(pass-if (real-nan? (* 0 -inf.0 )))
(pass-if (real-nan? (* -inf.0 0 )))
(pass-if (almost-real-nan? (* 0 +inf.0+i)))
(pass-if (almost-real-nan? (* +inf.0+i 0 )))
(pass-if (almost-real-nan? (* 0 -inf.0+i)))
(pass-if (almost-real-nan? (* -inf.0+i 0 )))
(pass-if (imaginary-nan? (* 0 +inf.0i )))
(pass-if (imaginary-nan? (* +inf.0i 0 )))
(pass-if (imaginary-nan? (* 0 1+inf.0i )))
(pass-if (imaginary-nan? (* 1+inf.0i 0 )))
(pass-if (imaginary-nan? (* 0 -inf.0i )))
(pass-if (imaginary-nan? (* -inf.0i 0 )))
(pass-if (imaginary-nan? (* 0 1-inf.0i )))
(pass-if (imaginary-nan? (* 1-inf.0i 0 )))
(pass-if (complex-nan? (* 0 +inf.0+inf.0i )))
(pass-if (complex-nan? (* +inf.0+inf.0i 0 )))
(pass-if (complex-nan? (* 0 +inf.0-inf.0i )))
(pass-if (complex-nan? (* -inf.0+inf.0i 0 ))))
(with-test-prefix "inum * bignum"
(pass-if "0 * 2^256 = 0"
(eqv? 0 (* 0 (ash 1 256)))))
(with-test-prefix "inum * flonum"
(pass-if "0 * 1.0 = 0.0"
(eqv? 0.0 (* 0 1.0))))
(with-test-prefix "inum * complex"
(pass-if "0 * 1+1i = 0.0+0.0i"
(eqv? 0.0+0.0i (* 0 1+1i))))
(with-test-prefix "inum * frac"
(pass-if "0 * 2/3 = 0"
(eqv? 0 (* 0 2/3))))
(with-test-prefix "bignum * inum"
(pass-if "2^256 * 0 = 0"
(eqv? 0 (* (ash 1 256) 0))))
(with-test-prefix "flonum * inum"
(pass-if "1.0 * 0 = 0.0"
(eqv? 0.0 (* 1.0 0))))
(with-test-prefix "complex * inum"
(pass-if "1+1i * 0 = 0.0+0.0i"
(eqv? 0.0+0.0i (* 1+1i 0))))
(pass-if "complex * bignum"
(let ((big (ash 1 90)))
(= (make-rectangular big big)
(* 1+1i big))))
(with-test-prefix "frac * inum"
(pass-if "2/3 * 0 = 0"
(eqv? 0 (* 2/3 0)))))
;;;
;;; /
;;;
(with-test-prefix "/"
(with-test-prefix "double-negation of fixnum-min"
(pass-if (= fixnum-min (/ (/ fixnum-min -1) -1)))
(pass-if (eqv? fixnum-min (/ (/ fixnum-min -1) -1)))
(pass-if (equal? fixnum-min (/ (/ fixnum-min -1) -1))))
(pass-if "documented?"
(documented? /))
(with-test-prefix "division by zero"
(pass-if-exception "(/ 0)"
exception:numerical-overflow
(/ 0))
(pass-if "(/ 0.0)"
(= +inf.0 (/ 0.0)))
(pass-if-exception "(/ 1 0)"
exception:numerical-overflow
(/ 1 0))
(pass-if "(/ 1 0.0)"
(= +inf.0 (/ 1 0.0)))
(pass-if-exception "(/ bignum 0)"
exception:numerical-overflow
(/ (+ fixnum-max 1) 0))
(pass-if "(/ bignum 0.0)"
(= +inf.0 (/ (+ fixnum-max 1) 0.0)))
(pass-if-exception "(/ 1.0 0)"
exception:numerical-overflow
(/ 1.0 0))
(pass-if "(/ 1.0 0.0)"
(= +inf.0 (/ 1.0 0.0)))
(pass-if-exception "(/ +i 0)"
exception:numerical-overflow
(/ +i 0))
(pass-if "(/ +i 0.0)"
(= +inf.0 (imag-part (/ +i 0.0)))))
(with-test-prefix "1/complex"
(pass-if "0+1i"
(eqv? 0-1i (/ 0+1i)))
;; in guile 1.6 through 1.6.7 this incorrectly resulted in nans
(pass-if "0-1i"
(eqv? 0+1i (/ 0-1i)))
(pass-if "1+1i"
(eqv? 0.5-0.5i (/ 1+1i)))
(pass-if "1-1i"
(eqv? 0.5+0.5i (/ 1-1i)))
(pass-if "-1+1i"
(eqv? -0.5-0.5i (/ -1+1i)))
(pass-if "-1-1i"
(eqv? -0.5+0.5i (/ -1-1i)))
(pass-if "(/ 3+4i)"
(= (/ 3+4i) 0.12-0.16i))
(pass-if "(/ 4+3i)"
(= (/ 4+3i) 0.16-0.12i))
(pass-if "(/ 1e200+1e200i)"
(= (/ 1e200+1e200i) 5.0e-201-5.0e-201i)))
(with-test-prefix "inum/complex"
(pass-if "(/ 25 3+4i)"
(= (/ 25 3+4i) 3.0-4.0i))
(pass-if "(/ 25 4+3i)"
(= (/ 25 4+3i) 4.0-3.0i)))
(with-test-prefix "complex/complex"
(pass-if "(/ 25+125i 3+4i)"
(= (/ 25+125i 3+4i) 23.0+11.0i))
(pass-if "(/ 25+125i 4+3i)"
(= (/ 25+125i 4+3i) 19.0+17.0i))))
;;;
;;; floor
;;;
(with-test-prefix "floor"
(pass-if (= 1 (floor 1.75)))
(pass-if (= 1 (floor 1.5)))
(pass-if (= 1 (floor 1.25)))
(pass-if (= 0 (floor 0.75)))
(pass-if (= 0 (floor 0.5)))
(pass-if (= 0 (floor 0.0)))
(pass-if (= -1 (floor -0.5)))
(pass-if (= -2 (floor -1.25)))
(pass-if (= -2 (floor -1.5)))
(with-test-prefix "inum"
(pass-if "0"
(and (= 0 (floor 0))
(exact? (floor 0))))
(pass-if "1"
(and (= 1 (floor 1))
(exact? (floor 1))))
(pass-if "-1"
(and (= -1 (floor -1))
(exact? (floor -1)))))
(with-test-prefix "bignum"
(let ((x (1+ most-positive-fixnum)))
(pass-if "(1+ most-positive-fixnum)"
(and (= x (floor x))
(exact? (floor x)))))
(let ((x (1- most-negative-fixnum)))
(pass-if "(1- most-negative-fixnum)"
(and (= x (floor x))
(exact? (floor x))))))
(with-test-prefix "frac"
(define (=exact x y)
(and (= x y)
(exact? y)))
(pass-if (=exact -3 (floor -7/3)))
(pass-if (=exact -2 (floor -5/3)))
(pass-if (=exact -2 (floor -4/3)))
(pass-if (=exact -1 (floor -2/3)))
(pass-if (=exact -1 (floor -1/3)))
(pass-if (=exact 0 (floor 1/3)))
(pass-if (=exact 0 (floor 2/3)))
(pass-if (=exact 1 (floor 4/3)))
(pass-if (=exact 1 (floor 5/3)))
(pass-if (=exact 2 (floor 7/3)))
(pass-if (=exact -3 (floor -17/6)))
(pass-if (=exact -3 (floor -16/6)))
(pass-if (=exact -3 (floor -15/6)))
(pass-if (=exact -3 (floor -14/6)))
(pass-if (=exact -3 (floor -13/6)))
(pass-if (=exact -2 (floor -11/6)))
(pass-if (=exact -2 (floor -10/6)))
(pass-if (=exact -2 (floor -9/6)))
(pass-if (=exact -2 (floor -8/6)))
(pass-if (=exact -2 (floor -7/6)))
(pass-if (=exact -1 (floor -5/6)))
(pass-if (=exact -1 (floor -4/6)))
(pass-if (=exact -1 (floor -3/6)))
(pass-if (=exact -1 (floor -2/6)))
(pass-if (=exact -1 (floor -1/6)))
(pass-if (=exact 0 (floor 1/6)))
(pass-if (=exact 0 (floor 2/6)))
(pass-if (=exact 0 (floor 3/6)))
(pass-if (=exact 0 (floor 4/6)))
(pass-if (=exact 0 (floor 5/6)))
(pass-if (=exact 1 (floor 7/6)))
(pass-if (=exact 1 (floor 8/6)))
(pass-if (=exact 1 (floor 9/6)))
(pass-if (=exact 1 (floor 10/6)))
(pass-if (=exact 1 (floor 11/6)))
(pass-if (=exact 2 (floor 13/6)))
(pass-if (=exact 2 (floor 14/6)))
(pass-if (=exact 2 (floor 15/6)))
(pass-if (=exact 2 (floor 16/6)))
(pass-if (=exact 2 (floor 17/6))))
(with-test-prefix "real"
(pass-if "0.0"
(and (= 0.0 (floor 0.0))
(inexact? (floor 0.0))))
(pass-if "1.0"
(and (= 1.0 (floor 1.0))
(inexact? (floor 1.0))))
(pass-if "-1.0"
(and (= -1.0 (floor -1.0))
(inexact? (floor -1.0))))
(pass-if "-3.1"
(and (= -4.0 (floor -3.1))
(inexact? (floor -3.1))))
(pass-if "3.1"
(and (= 3.0 (floor 3.1))
(inexact? (floor 3.1))))
(pass-if "3.9"
(and (= 3.0 (floor 3.9))
(inexact? (floor 3.9))))
(pass-if "-3.9"
(and (= -4.0 (floor -3.9))
(inexact? (floor -3.9))))
(pass-if "1.5"
(and (= 1.0 (floor 1.5))
(inexact? (floor 1.5))))
(pass-if "2.5"
(and (= 2.0 (floor 2.5))
(inexact? (floor 2.5))))
(pass-if "3.5"
(and (= 3.0 (floor 3.5))
(inexact? (floor 3.5))))
(pass-if "-1.5"
(and (= -2.0 (floor -1.5))
(inexact? (floor -1.5))))
(pass-if "-2.5"
(and (= -3.0 (floor -2.5))
(inexact? (floor -2.5))))
(pass-if "-3.5"
(and (= -4.0 (floor -3.5))
(inexact? (floor -3.5))))))
;;;
;;; ceiling
;;;
(with-test-prefix "ceiling"
(pass-if (= 2 (ceiling 1.75)))
(pass-if (= 2 (ceiling 1.5)))
(pass-if (= 2 (ceiling 1.25)))
(pass-if (= 1 (ceiling 0.75)))
(pass-if (= 1 (ceiling 0.5)))
(pass-if (= 0 (ceiling 0.0)))
(pass-if (= 0 (ceiling -0.5)))
(pass-if (= -1 (ceiling -1.25)))
(pass-if (= -1 (ceiling -1.5)))
(with-test-prefix "inum"
(pass-if "0"
(and (= 0 (ceiling 0))
(exact? (ceiling 0))))
(pass-if "1"
(and (= 1 (ceiling 1))
(exact? (ceiling 1))))
(pass-if "-1"
(and (= -1 (ceiling -1))
(exact? (ceiling -1)))))
(with-test-prefix "bignum"
(let ((x (1+ most-positive-fixnum)))
(pass-if "(1+ most-positive-fixnum)"
(and (= x (ceiling x))
(exact? (ceiling x)))))
(let ((x (1- most-negative-fixnum)))
(pass-if "(1- most-negative-fixnum)"
(and (= x (ceiling x))
(exact? (ceiling x))))))
(with-test-prefix "frac"
(define (=exact x y)
(and (= x y)
(exact? y)))
(pass-if (=exact -2 (ceiling -7/3)))
(pass-if (=exact -1 (ceiling -5/3)))
(pass-if (=exact -1 (ceiling -4/3)))
(pass-if (=exact 0 (ceiling -2/3)))
(pass-if (=exact 0 (ceiling -1/3)))
(pass-if (=exact 1 (ceiling 1/3)))
(pass-if (=exact 1 (ceiling 2/3)))
(pass-if (=exact 2 (ceiling 4/3)))
(pass-if (=exact 2 (ceiling 5/3)))
(pass-if (=exact 3 (ceiling 7/3)))
(pass-if (=exact -2 (ceiling -17/6)))
(pass-if (=exact -2 (ceiling -16/6)))
(pass-if (=exact -2 (ceiling -15/6)))
(pass-if (=exact -2 (ceiling -14/6)))
(pass-if (=exact -2 (ceiling -13/6)))
(pass-if (=exact -1 (ceiling -11/6)))
(pass-if (=exact -1 (ceiling -10/6)))
(pass-if (=exact -1 (ceiling -9/6)))
(pass-if (=exact -1 (ceiling -8/6)))
(pass-if (=exact -1 (ceiling -7/6)))
(pass-if (=exact 0 (ceiling -5/6)))
(pass-if (=exact 0 (ceiling -4/6)))
(pass-if (=exact 0 (ceiling -3/6)))
(pass-if (=exact 0 (ceiling -2/6)))
(pass-if (=exact 0 (ceiling -1/6)))
(pass-if (=exact 1 (ceiling 1/6)))
(pass-if (=exact 1 (ceiling 2/6)))
(pass-if (=exact 1 (ceiling 3/6)))
(pass-if (=exact 1 (ceiling 4/6)))
(pass-if (=exact 1 (ceiling 5/6)))
(pass-if (=exact 2 (ceiling 7/6)))
(pass-if (=exact 2 (ceiling 8/6)))
(pass-if (=exact 2 (ceiling 9/6)))
(pass-if (=exact 2 (ceiling 10/6)))
(pass-if (=exact 2 (ceiling 11/6)))
(pass-if (=exact 3 (ceiling 13/6)))
(pass-if (=exact 3 (ceiling 14/6)))
(pass-if (=exact 3 (ceiling 15/6)))
(pass-if (=exact 3 (ceiling 16/6)))
(pass-if (=exact 3 (ceiling 17/6))))
(with-test-prefix "real"
(pass-if "0.0"
(and (= 0.0 (ceiling 0.0))
(inexact? (ceiling 0.0))))
(pass-if "1.0"
(and (= 1.0 (ceiling 1.0))
(inexact? (ceiling 1.0))))
(pass-if "-1.0"
(and (= -1.0 (ceiling -1.0))
(inexact? (ceiling -1.0))))
(pass-if "-3.1"
(and (= -3.0 (ceiling -3.1))
(inexact? (ceiling -3.1))))
(pass-if "3.1"
(and (= 4.0 (ceiling 3.1))
(inexact? (ceiling 3.1))))
(pass-if "3.9"
(and (= 4.0 (ceiling 3.9))
(inexact? (ceiling 3.9))))
(pass-if "-3.9"
(and (= -3.0 (ceiling -3.9))
(inexact? (ceiling -3.9))))
(pass-if "1.5"
(and (= 2.0 (ceiling 1.5))
(inexact? (ceiling 1.5))))
(pass-if "2.5"
(and (= 3.0 (ceiling 2.5))
(inexact? (ceiling 2.5))))
(pass-if "3.5"
(and (= 4.0 (ceiling 3.5))
(inexact? (ceiling 3.5))))
(pass-if "-1.5"
(and (= -1.0 (ceiling -1.5))
(inexact? (ceiling -1.5))))
(pass-if "-2.5"
(and (= -2.0 (ceiling -2.5))
(inexact? (ceiling -2.5))))
(pass-if "-3.5"
(and (= -3.0 (ceiling -3.5))
(inexact? (ceiling -3.5))))))
;;;
;;; truncate
;;;
(with-test-prefix "truncate"
(pass-if (= 1 (truncate 1.75)))
(pass-if (= 1 (truncate 1.5)))
(pass-if (= 1 (truncate 1.25)))
(pass-if (= 0 (truncate 0.75)))
(pass-if (= 0 (truncate 0.5)))
(pass-if (= 0 (truncate 0.0)))
(pass-if (= 0 (truncate -0.5)))
(pass-if (= -1 (truncate -1.25)))
(pass-if (= -1 (truncate -1.5)))
(with-test-prefix "inum"
(pass-if "0"
(and (= 0 (truncate 0))
(exact? (truncate 0))))
(pass-if "1"
(and (= 1 (truncate 1))
(exact? (truncate 1))))
(pass-if "-1"
(and (= -1 (truncate -1))
(exact? (truncate -1)))))
(with-test-prefix "bignum"
(let ((x (1+ most-positive-fixnum)))
(pass-if "(1+ most-positive-fixnum)"
(and (= x (truncate x))
(exact? (truncate x)))))
(let ((x (1- most-negative-fixnum)))
(pass-if "(1- most-negative-fixnum)"
(and (= x (truncate x))
(exact? (truncate x))))))
(with-test-prefix "frac"
(define (=exact x y)
(and (= x y)
(exact? y)))
(pass-if (=exact -2 (truncate -7/3)))
(pass-if (=exact -1 (truncate -5/3)))
(pass-if (=exact -1 (truncate -4/3)))
(pass-if (=exact 0 (truncate -2/3)))
(pass-if (=exact 0 (truncate -1/3)))
(pass-if (=exact 0 (truncate 1/3)))
(pass-if (=exact 0 (truncate 2/3)))
(pass-if (=exact 1 (truncate 4/3)))
(pass-if (=exact 1 (truncate 5/3)))
(pass-if (=exact 2 (truncate 7/3)))
(pass-if (=exact -2 (truncate -17/6)))
(pass-if (=exact -2 (truncate -16/6)))
(pass-if (=exact -2 (truncate -15/6)))
(pass-if (=exact -2 (truncate -14/6)))
(pass-if (=exact -2 (truncate -13/6)))
(pass-if (=exact -1 (truncate -11/6)))
(pass-if (=exact -1 (truncate -10/6)))
(pass-if (=exact -1 (truncate -9/6)))
(pass-if (=exact -1 (truncate -8/6)))
(pass-if (=exact -1 (truncate -7/6)))
(pass-if (=exact 0 (truncate -5/6)))
(pass-if (=exact 0 (truncate -4/6)))
(pass-if (=exact 0 (truncate -3/6)))
(pass-if (=exact 0 (truncate -2/6)))
(pass-if (=exact 0 (truncate -1/6)))
(pass-if (=exact 0 (truncate 1/6)))
(pass-if (=exact 0 (truncate 2/6)))
(pass-if (=exact 0 (truncate 3/6)))
(pass-if (=exact 0 (truncate 4/6)))
(pass-if (=exact 0 (truncate 5/6)))
(pass-if (=exact 1 (truncate 7/6)))
(pass-if (=exact 1 (truncate 8/6)))
(pass-if (=exact 1 (truncate 9/6)))
(pass-if (=exact 1 (truncate 10/6)))
(pass-if (=exact 1 (truncate 11/6)))
(pass-if (=exact 2 (truncate 13/6)))
(pass-if (=exact 2 (truncate 14/6)))
(pass-if (=exact 2 (truncate 15/6)))
(pass-if (=exact 2 (truncate 16/6)))
(pass-if (=exact 2 (truncate 17/6))))
(with-test-prefix "real"
(pass-if "0.0"
(and (= 0.0 (truncate 0.0))
(inexact? (truncate 0.0))))
(pass-if "1.0"
(and (= 1.0 (truncate 1.0))
(inexact? (truncate 1.0))))
(pass-if "-1.0"
(and (= -1.0 (truncate -1.0))
(inexact? (truncate -1.0))))
(pass-if "-3.1"
(and (= -3.0 (truncate -3.1))
(inexact? (truncate -3.1))))
(pass-if "3.1"
(and (= 3.0 (truncate 3.1))
(inexact? (truncate 3.1))))
(pass-if "3.9"
(and (= 3.0 (truncate 3.9))
(inexact? (truncate 3.9))))
(pass-if "-3.9"
(and (= -3.0 (truncate -3.9))
(inexact? (truncate -3.9))))
(pass-if "1.5"
(and (= 1.0 (truncate 1.5))
(inexact? (truncate 1.5))))
(pass-if "2.5"
(and (= 2.0 (truncate 2.5))
(inexact? (truncate 2.5))))
(pass-if "3.5"
(and (= 3.0 (truncate 3.5))
(inexact? (truncate 3.5))))
(pass-if "-1.5"
(and (= -1.0 (truncate -1.5))
(inexact? (truncate -1.5))))
(pass-if "-2.5"
(and (= -2.0 (truncate -2.5))
(inexact? (truncate -2.5))))
(pass-if "-3.5"
(and (= -3.0 (truncate -3.5))
(inexact? (truncate -3.5))))))
;;;
;;; round
;;;
(with-test-prefix "round"
(pass-if (= 2 (round 1.75)))
(pass-if (= 2 (round 1.5)))
(pass-if (= 1 (round 1.25)))
(pass-if (= 1 (round 0.75)))
(pass-if (= 0 (round 0.5)))
(pass-if (= 0 (round 0.0)))
(pass-if (= 0 (round -0.5)))
(pass-if (= -1 (round -1.25)))
(pass-if (= -2 (round -1.5)))
(with-test-prefix "inum"
(pass-if "0"
(and (= 0 (round 0))
(exact? (round 0))))
(pass-if "1"
(and (= 1 (round 1))
(exact? (round 1))))
(pass-if "-1"
(and (= -1 (round -1))
(exact? (round -1)))))
(with-test-prefix "bignum"
(let ((x (1+ most-positive-fixnum)))
(pass-if "(1+ most-positive-fixnum)"
(and (= x (round x))
(exact? (round x)))))
(let ((x (1- most-negative-fixnum)))
(pass-if "(1- most-negative-fixnum)"
(and (= x (round x))
(exact? (round x))))))
(with-test-prefix "frac"
(define (=exact x y)
(and (= x y)
(exact? y)))
(pass-if (=exact -2 (round -7/3)))
(pass-if (=exact -2 (round -5/3)))
(pass-if (=exact -1 (round -4/3)))
(pass-if (=exact -1 (round -2/3)))
(pass-if (=exact 0 (round -1/3)))
(pass-if (=exact 0 (round 1/3)))
(pass-if (=exact 1 (round 2/3)))
(pass-if (=exact 1 (round 4/3)))
(pass-if (=exact 2 (round 5/3)))
(pass-if (=exact 2 (round 7/3)))
(pass-if (=exact -3 (round -17/6)))
(pass-if (=exact -3 (round -16/6)))
(pass-if (=exact -2 (round -15/6)))
(pass-if (=exact -2 (round -14/6)))
(pass-if (=exact -2 (round -13/6)))
(pass-if (=exact -2 (round -11/6)))
(pass-if (=exact -2 (round -10/6)))
(pass-if (=exact -2 (round -9/6)))
(pass-if (=exact -1 (round -8/6)))
(pass-if (=exact -1 (round -7/6)))
(pass-if (=exact -1 (round -5/6)))
(pass-if (=exact -1 (round -4/6)))
(pass-if (=exact 0 (round -3/6)))
(pass-if (=exact 0 (round -2/6)))
(pass-if (=exact 0 (round -1/6)))
(pass-if (=exact 0 (round 1/6)))
(pass-if (=exact 0 (round 2/6)))
(pass-if (=exact 0 (round 3/6)))
(pass-if (=exact 1 (round 4/6)))
(pass-if (=exact 1 (round 5/6)))
(pass-if (=exact 1 (round 7/6)))
(pass-if (=exact 1 (round 8/6)))
(pass-if (=exact 2 (round 9/6)))
(pass-if (=exact 2 (round 10/6)))
(pass-if (=exact 2 (round 11/6)))
(pass-if (=exact 2 (round 13/6)))
(pass-if (=exact 2 (round 14/6)))
(pass-if (=exact 2 (round 15/6)))
(pass-if (=exact 3 (round 16/6)))
(pass-if (=exact 3 (round 17/6))))
(with-test-prefix "real"
(pass-if "0.0"
(and (= 0.0 (round 0.0))
(inexact? (round 0.0))))
(pass-if "1.0"
(and (= 1.0 (round 1.0))
(inexact? (round 1.0))))
(pass-if "-1.0"
(and (= -1.0 (round -1.0))
(inexact? (round -1.0))))
(pass-if "-3.1"
(and (= -3.0 (round -3.1))
(inexact? (round -3.1))))
(pass-if "3.1"
(and (= 3.0 (round 3.1))
(inexact? (round 3.1))))
(pass-if "3.9"
(and (= 4.0 (round 3.9))
(inexact? (round 3.9))))
(pass-if "-3.9"
(and (= -4.0 (round -3.9))
(inexact? (round -3.9))))
(pass-if "1.5"
(and (= 2.0 (round 1.5))
(inexact? (round 1.5))))
(pass-if "2.5"
(and (= 2.0 (round 2.5))
(inexact? (round 2.5))))
(pass-if "3.5"
(and (= 4.0 (round 3.5))
(inexact? (round 3.5))))
(pass-if "-1.5"
(and (= -2.0 (round -1.5))
(inexact? (round -1.5))))
(pass-if "-2.5"
(and (= -2.0 (round -2.5))
(inexact? (round -2.5))))
(pass-if "-3.5"
(and (= -4.0 (round -3.5))
(inexact? (round -3.5))))
;; prior to guile 1.6.5, on an IEEE system an inexact 2^53-1 (ie. a
;; float with mantissa all ones) came out as 2^53 from `round' (except
;; on i386 and m68k systems using the coprocessor and optimizing, where
;; extra precision hid the problem)
(pass-if "2^53-1"
(let ((x (exact->inexact (1- (ash 1 53)))))
(and (= x (round x))
(inexact? (round x)))))
(pass-if "-(2^53-1)"
(let ((x (exact->inexact (- (1- (ash 1 53))))))
(and (= x (round x))
(inexact? (round x)))))))
;;;
;;; exact->inexact
;;;
(with-test-prefix "exact->inexact"
;; Test "(exact->inexact n)", expect "want".
;; "i" is a index, for diagnostic purposes.
(define (try-i i n want)
(with-test-prefix (list i n want)
(with-test-prefix "pos"
(let ((got (exact->inexact n)))
(pass-if "inexact?" (inexact? got))
(pass-if (list "=" got) (= want got))))
(set! n (- n))
(set! want (- want))
(with-test-prefix "neg"
(let ((got (exact->inexact n)))
(pass-if "inexact?" (inexact? got))
(pass-if (list "=" got) (= want got))))))
(with-test-prefix "2^i, no round"
(do ((i 0 (1+ i))
(n 1 (* 2 n))
(want 1.0 (* 2.0 want)))
((> i 100))
(try-i i n want)))
(with-test-prefix "2^i+1, no round"
(do ((i 1 (1+ i))
(n 3 (1- (* 2 n)))
(want 3.0 (- (* 2.0 want) 1.0)))
((>= i dbl-mant-dig))
(try-i i n want)))
(with-test-prefix "(2^i+1)*2^100, no round"
(do ((i 1 (1+ i))
(n 3 (1- (* 2 n)))
(want 3.0 (- (* 2.0 want) 1.0)))
((>= i dbl-mant-dig))
(try-i i (ash n 100) (ash-flo want 100))))
;; bit pattern: 1111....11100.00
;; <-mantdig-><-i->
;;
(with-test-prefix "mantdig ones then zeros, no rounding"
(do ((i 0 (1+ i))
(n (- (ash 1 dbl-mant-dig) 1) (* 2 n))
(want (- (ash-flo 1.0 dbl-mant-dig) 1.0) (* 2.0 want)))
((> i 100))
(try-i i n want)))
;; bit pattern: 1111....111011..1
;; <-mantdig-> <-i->
;; This sort of value was incorrectly rounded upwards in Guile 1.6.4 when
;; i >= 11 (that's when the total is 65 or more bits).
;;
(with-test-prefix "mantdig ones then 011..11, round down"
(do ((i 0 (1+ i))
(n (- (ash 1 (+ 1 dbl-mant-dig)) 2) (+ 1 (* 2 n)))
(want (- (ash-flo 1.0 (+ 1 dbl-mant-dig)) 2.0) (* 2.0 want)))
((> i 100))
(try-i i n want)))
;; bit pattern: 1111....111100..001
;; <-mantdig-> <--i->
;;
(with-test-prefix "mantdig ones then 100..001, round up"
(do ((i 0 (1+ i))
(n (- (ash 1 (+ 2 dbl-mant-dig)) 1) (1- (* 2 n)))
(want (ash-flo 1.0 (+ 2 dbl-mant-dig)) (* 2.0 want)))
((> i 100))
(try-i i n want)))
;; bit pattern: 1000....000100..001
;; <-mantdig-> <--i->
;;
(with-test-prefix "2^mantdig then 100..001, round up"
(do ((i 0 (1+ i))
(n (- (ash 1 (+ 2 dbl-mant-dig)) 1) (1- (* 2 n)))
(want (+ (ash-flo 1.0 (+ 2 dbl-mant-dig)) 4.0) (* 2.0 want)))
((> i 100))
(try-i i n want)))
(pass-if "frac big/big"
(let ((big (ash 1 256)))
(= 1.0 (exact->inexact (/ (1+ big) big)))))
;; In guile 1.8.0 this failed, giving back "nan" because it tried to
;; convert the num and den to doubles, resulting in infs.
(pass-if "frac big/big, exceeding double"
(let ((big (ash 1 4096)))
(= 1.0 (exact->inexact (/ (1+ big) big))))))
;;;
;;; expt
;;;
(with-test-prefix "expt"
(pass-if (documented? expt))
;;
;; expt no longer requires its first argument to be a scheme number,
;; for the sake of extensibility, and expt calls integer-expt for
;; integer powers. To raise to a positive power, all that is required
;; is that it can be multiplied using `*'. For negative powers we
;; must also be able to find the reciprocal. If we try to raise #t to
;; any power other than 0 or 1 it may throw an exception, depending on
;; whether * has been defined for #t. However, when raising to the 0
;; or 1 power, the first argument is not manipulated at all.
;;
;; (pass-if-exception "non-numeric base" exception:wrong-type-arg
;; (expt #t 0))
;;
(pass-if (eqv? 1 (expt 0 0)))
(pass-if (eqv? 1 (expt 0.0 0)))
(pass-if (eqv? 1.0 (expt 0 0.0)))
(pass-if (eqv? 1.0 (expt 0.0 0.0)))
(pass-if (real-nan? (expt 0 -1)))
(pass-if (real-nan? (expt 0 -1.0)))
(pass-if (real-nan? (expt 0.0 -1)))
(pass-if (real-nan? (expt 0.0 -1.0)))
(pass-if (eqv? 0 (expt 0 3)))
(pass-if (= 0 (expt 0 4.0)))
(pass-if (eqv? 0.0 (expt 0.0 5)))
(pass-if (eqv? 0.0 (expt 0.0 6.0)))
(pass-if (eqv? -2742638075.5 (expt -2742638075.5 1)))
(pass-if (eqv? (* -2742638075.5 -2742638075.5)
(expt -2742638075.5 2)))
(pass-if (eqv? 4.0 (expt -2.0 2.0)))
(pass-if (eqv? -1/8 (expt -2 -3)))
(pass-if (eqv? -0.125 (expt -2.0 -3)))
(pass-if (eqv? -0.125 (expt -2 -3.0)))
(pass-if (eqv? -0.125 (expt -2.0 -3.0)))
(pass-if (eqv? 0.25 (expt 2.0 -2.0)))
(pass-if (test-eqv? (* -1.0+0.0i 12398 12398) (expt +12398i 2.0)))
(pass-if (eqv-loosely? +i (expt -1 0.5)))
(pass-if (eqv-loosely? +i (expt -1 1/2)))
(pass-if (eqv-loosely? 1.0+1.7320508075688i (expt -8 1/3)))
(pass-if (eqv? +inf.0 (expt 2 +inf.0)))
(pass-if (eqv? +inf.0 (expt 2.0 +inf.0)))
(pass-if (eqv? 0.0 (expt 2 -inf.0)))
(pass-if (eqv? 0.0 (expt 2.0 -inf.0))))
;;;
;;; sin
;;;
(with-test-prefix "sin"
(pass-if (eqv? 0 (sin 0)))
(pass-if (eqv? 0.0 (sin 0.0)))
(pass-if (eqv-loosely? 1.0 (sin 1.57)))
(pass-if (eqv-loosely? +1.175i (sin +i)))
(pass-if (real-nan? (sin +nan.0)))
(pass-if (real-nan? (sin +inf.0)))
(pass-if (real-nan? (sin -inf.0))))
;;;
;;; cos
;;;
(with-test-prefix "cos"
(pass-if (eqv? 1 (cos 0)))
(pass-if (eqv? 1.0 (cos 0.0)))
(pass-if (eqv-loosely? 0.0 (cos 1.57)))
(pass-if (eqv-loosely? 1.543 (cos +i)))
(pass-if (real-nan? (cos +nan.0)))
(pass-if (real-nan? (cos +inf.0)))
(pass-if (real-nan? (cos -inf.0))))
;;;
;;; tan
;;;
(with-test-prefix "tan"
(pass-if (eqv? 0 (tan 0)))
(pass-if (eqv? 0.0 (tan 0.0)))
(pass-if (eqv-loosely? 1.0 (tan 0.785)))
(pass-if (eqv-loosely? +0.76i (tan +i)))
(pass-if (real-nan? (tan +nan.0)))
(pass-if (real-nan? (tan +inf.0)))
(pass-if (real-nan? (tan -inf.0))))
;;;
;;; asin
;;;
(with-test-prefix "asin"
(pass-if (complex-nan? (asin +nan.0)))
(pass-if (eqv? 0 (asin 0)))
(pass-if (eqv? 0.0 (asin 0.0))))
;;;
;;; acos
;;;
(with-test-prefix "acos"
(pass-if (complex-nan? (acos +nan.0)))
(pass-if (eqv? 0 (acos 1)))
(pass-if (eqv? 0.0 (acos 1.0))))
;;;
;;; atan
;;;
;;; FIXME: add tests for two-argument atan
;;;
(with-test-prefix "atan"
(pass-if (real-nan? (atan +nan.0)))
(pass-if (eqv? 0 (atan 0)))
(pass-if (eqv? 0.0 (atan 0.0)))
(pass-if (eqv-loosely? 1.57 (atan +inf.0)))
(pass-if (eqv-loosely? -1.57 (atan -inf.0))))
;;;
;;; sinh
;;;
(with-test-prefix "sinh"
(pass-if (= 0 (sinh 0)))
(pass-if (= 0.0 (sinh 0.0))))
;;;
;;; cosh
;;;
(with-test-prefix "cosh"
(pass-if (= 1 (cosh 0)))
(pass-if (= 1.0 (cosh 0.0))))
;;;
;;; tanh
;;;
(with-test-prefix "tanh"
(pass-if (= 0 (tanh 0)))
(pass-if (= 0.0 (tanh 0.0))))
;;;
;;; asinh
;;;
(with-test-prefix "asinh"
(pass-if (= 0 (asinh 0)))
(pass-if (= 0.0 (asinh 0.0))))
;;;
;;; acosh
;;;
(with-test-prefix "acosh"
(pass-if (= 0 (acosh 1)))
(pass-if (= 0.0 (acosh 1.0))))
;;;
;;; atanh
;;;
(with-test-prefix "atanh"
(pass-if (= 0 (atanh 0)))
(pass-if (= 0.0 (atanh 0.0))))
;;;
;;; make-rectangular
;;;
(with-test-prefix "make-rectangular"
(pass-if (real? (make-rectangular 5.0 0 )))
(pass-if (not (real? (make-rectangular 5.0 0.0))))
(pass-if (not (real? (make-rectangular 5.0 -0.0)))))
;;;
;;; make-polar
;;;
(with-test-prefix "make-polar"
(define pi 3.14159265358979323846)
(define (almost= x y)
(> 0.01 (magnitude (- x y))))
(pass-if (real? (make-polar 0 1.0)))
(pass-if (real? (make-polar 5.0 0 )))
(pass-if (not (real? (make-polar 5.0 0.0))))
(pass-if (not (real? (make-polar 5.0 -0.0))))
(pass-if (eqv? 0 (make-polar 0 0)))
(pass-if (eqv? 0 (make-polar 0 123.456)))
(pass-if (eqv? 1 (make-polar 1 0)))
(pass-if (eqv? -1 (make-polar -1 0)))
(pass-if (almost= 0+i (make-polar 1 (* 0.5 pi))))
(pass-if (almost= -1 (make-polar 1 (* 1.0 pi))))
(pass-if (almost= 0-i (make-polar 1 (* 1.5 pi))))
(pass-if (almost= 1 (make-polar 1 (* 2.0 pi)))))
;;;
;;; real-part
;;;
(with-test-prefix "real-part"
(pass-if (documented? real-part))
(pass-if (eqv? 5.0 (real-part 5.0)))
(pass-if (eqv? 0.0 (real-part +5.0i)))
(pass-if (eqv? 5 (real-part 5)))
(pass-if (eqv? 1/5 (real-part 1/5)))
(pass-if (eqv? (1+ fixnum-max) (real-part (1+ fixnum-max)))))
;;;
;;; imag-part
;;;
(with-test-prefix "imag-part"
(pass-if (documented? imag-part))
(pass-if (eqv? 0 (imag-part 5.0)))
(pass-if (eqv? 5.0 (imag-part +5.0i)))
(pass-if (eqv? 0 (imag-part 5)))
(pass-if (eqv? 0 (imag-part 1/5)))
(pass-if (eqv? 0 (imag-part (1+ fixnum-max)))))
;;;
;;; magnitude
;;;
(with-test-prefix "magnitude"
(pass-if (documented? magnitude))
(pass-if (= 0 (magnitude 0)))
(pass-if (= 1 (magnitude 1)))
(pass-if (= 1 (magnitude -1)))
(pass-if (= 1 (magnitude 0+i)))
(pass-if (= 1 (magnitude 0-i)))
(pass-if (= 5 (magnitude 3+4i)))
(pass-if (= 5 (magnitude 3-4i)))
(pass-if (= 5 (magnitude -3+4i)))
(pass-if (= 5 (magnitude -3-4i))))
;;;
;;; angle
;;;
(with-test-prefix "angle"
(define pi 3.14159265358979323846)
(define (almost= x y)
(> 0.01 (magnitude (- x y))))
(pass-if (documented? angle))
(pass-if "inum +ve" (= 0 (angle 1)))
(pass-if "inum -ve" (almost= pi (angle -1)))
(pass-if "bignum +ve" (= 0 (angle (1+ fixnum-max))))
(pass-if "bignum -ve" (almost= pi (angle (1- fixnum-min))))
(pass-if "flonum +ve" (= 0 (angle 1.5)))
(pass-if "flonum -ve" (almost= pi (angle -1.5))))
;;;
;;; inexact->exact
;;;
(with-test-prefix "inexact->exact"
(pass-if (documented? inexact->exact))
(pass-if-exception "+inf" exception:out-of-range
(inexact->exact +inf.0))
(pass-if-exception "-inf" exception:out-of-range
(inexact->exact -inf.0))
(pass-if-exception "nan" exception:out-of-range
(inexact->exact +nan.0))
(with-test-prefix "2.0**i to exact and back"
(do ((i 0 (1+ i))
(n 1.0 (* 2.0 n)))
((> i 100))
(pass-if (list i n)
(= n (inexact->exact (exact->inexact n)))))))
;;;
;;; integer-expt
;;;
(with-test-prefix "integer-expt"
(pass-if (documented? integer-expt))
(pass-if-exception "2^+inf" exception:wrong-type-arg
(integer-expt 2 +inf.0))
(pass-if-exception "2^-inf" exception:wrong-type-arg
(integer-expt 2 -inf.0))
(pass-if-exception "2^nan" exception:wrong-type-arg
(integer-expt 2 +nan.0))
(pass-if (eqv? 1 (integer-expt 0 0)))
(pass-if (eqv? 1 (integer-expt 0.0 0)))
(pass-if (real-nan? (integer-expt 0 -1)))
(pass-if (real-nan? (integer-expt 0.0 -1)))
(pass-if (eqv? 0 (integer-expt 0 3)))
(pass-if (eqv? 0.0 (integer-expt 0.0 5)))
(pass-if (eqv? -2742638075.5 (integer-expt -2742638075.5 1)))
(pass-if (eqv? (* -2742638075.5 -2742638075.5)
(integer-expt -2742638075.5 2)))
(pass-if (eqv? 4.0 (integer-expt -2.0 2)))
(pass-if (eqv? -1/8 (integer-expt -2 -3)))
(pass-if (eqv? -0.125 (integer-expt -2.0 -3)))
(pass-if (eqv? 0.25 (integer-expt 2.0 -2)))
(pass-if (test-eqv? (* -1.0+0.0i 12398 12398) (integer-expt +12398.0i 2))))
;;;
;;; integer-length
;;;
(with-test-prefix "integer-length"
(pass-if (documented? integer-length))
(with-test-prefix "-2^i, ...11100..00"
(do ((n -1 (ash n 1))
(i 0 (1+ i)))
((> i 256))
(pass-if (list n "expect" i)
(= i (integer-length n)))))
(with-test-prefix "-2^i+1 ...11100..01"
(do ((n -3 (logxor 3 (ash n 1)))
(i 2 (1+ i)))
((> i 256))
(pass-if n
(= i (integer-length n)))))
(with-test-prefix "-2^i-1 ...111011..11"
(do ((n -2 (1+ (ash n 1)))
(i 1 (1+ i)))
((> i 256))
(pass-if n
(= i (integer-length n))))))
;;;
;;; log
;;;
(with-test-prefix "log"
(pass-if (documented? log))
(pass-if-exception "no args" exception:wrong-num-args
(log))
(pass-if-exception "two args" exception:wrong-num-args
(log 123 456))
(pass-if (negative-infinity? (log 0)))
(pass-if (negative-infinity? (log 0.0)))
(pass-if (eqv? 0.0 (log 1)))
(pass-if (eqv? 0.0 (log 1.0)))
(pass-if (eqv-loosely? 1.0 (log const-e)))
(pass-if (eqv-loosely? 2.0 (log const-e^2)))
(pass-if (eqv-loosely? -1.0 (log const-1/e)))
(pass-if (eqv-loosely? 1.0+1.57079i (log 0+2.71828i)))
(pass-if (eqv-loosely? 1.0-1.57079i (log 0-2.71828i)))
(pass-if (eqv-loosely? 0.0+3.14159i (log -1.0)))
(pass-if (eqv-loosely? 1.0+3.14159i (log -2.71828)))
(pass-if (eqv-loosely? 2.0+3.14159i (log (* -2.71828 2.71828)))))
;;;
;;; log10
;;;
(with-test-prefix "log10"
(pass-if (documented? log10))
(pass-if-exception "no args" exception:wrong-num-args
(log10))
(pass-if-exception "two args" exception:wrong-num-args
(log10 123 456))
(pass-if (negative-infinity? (log10 0)))
(pass-if (negative-infinity? (log10 0.0)))
(pass-if (eqv? 0.0 (log10 1)))
(pass-if (eqv? 0.0 (log10 1.0)))
(pass-if (eqv-loosely? 1.0 (log10 10.0)))
(pass-if (eqv-loosely? 2.0 (log10 100.0)))
(pass-if (eqv-loosely? -1.0 (log10 0.1)))
(pass-if (eqv-loosely? 1.0+0.68218i (log10 0+10.0i)))
(pass-if (eqv-loosely? 1.0-0.68218i (log10 0-10.0i)))
(pass-if (eqv-loosely? 0.0+1.36437i (log10 -1)))
(pass-if (eqv-loosely? 1.0+1.36437i (log10 -10)))
(pass-if (eqv-loosely? 2.0+1.36437i (log10 -100))))
;;;
;;; logbit?
;;;
(with-test-prefix "logbit?"
(pass-if (documented? logbit?))
(pass-if (eq? #f (logbit? 0 0)))
(pass-if (eq? #f (logbit? 1 0)))
(pass-if (eq? #f (logbit? 31 0)))
(pass-if (eq? #f (logbit? 32 0)))
(pass-if (eq? #f (logbit? 33 0)))
(pass-if (eq? #f (logbit? 63 0)))
(pass-if (eq? #f (logbit? 64 0)))
(pass-if (eq? #f (logbit? 65 0)))
;; prior to guile 1.6.5, testing bit 32, 64 etc of value 1 would wrap
;; around and return #t where it ought to be #f
(pass-if (eq? #t (logbit? 0 1)))
(pass-if (eq? #f (logbit? 1 1)))
(pass-if (eq? #f (logbit? 31 1)))
(pass-if (eq? #f (logbit? 32 1)))
(pass-if (eq? #f (logbit? 33 1)))
(pass-if (eq? #f (logbit? 63 1)))
(pass-if (eq? #f (logbit? 64 1)))
(pass-if (eq? #f (logbit? 65 1)))
(pass-if (eq? #f (logbit? 128 1)))
(pass-if (eq? #t (logbit? 0 -1)))
(pass-if (eq? #t (logbit? 1 -1)))
(pass-if (eq? #t (logbit? 31 -1)))
(pass-if (eq? #t (logbit? 32 -1)))
(pass-if (eq? #t (logbit? 33 -1)))
(pass-if (eq? #t (logbit? 63 -1)))
(pass-if (eq? #t (logbit? 64 -1)))
(pass-if (eq? #t (logbit? 65 -1))))
;;;
;;; logcount
;;;
(with-test-prefix "logcount"
(pass-if (documented? logcount))
(with-test-prefix "-2^i, meaning ...11100..00"
(do ((n -1 (ash n 1))
(i 0 (1+ i)))
((> i 256))
(pass-if n
(= i (logcount n)))))
(with-test-prefix "2^i"
(do ((n 1 (ash n 1))
(i 0 (1+ i)))
((> i 256))
(pass-if n
(= 1 (logcount n)))))
(with-test-prefix "2^i-1"
(do ((n 0 (1+ (ash n 1)))
(i 0 (1+ i)))
((> i 256))
(pass-if n
(= i (logcount n))))))
;;;
;;; logior
;;;
(with-test-prefix "logior"
(pass-if (documented? logior))
(pass-if (eqv? -1 (logior (ash -1 1) 1)))
;; check that bignum or bignum+inum args will reduce to an inum
(let ()
(define (test x y)
(pass-if (list x y '=> -1)
(eqv? -1 (logior x y)))
(pass-if (list y x '=> -1)
(eqv? -1 (logior y x))))
(test (ash -1 8) #xFF)
(test (ash -1 28) #x0FFFFFFF)
(test (ash -1 29) #x1FFFFFFF)
(test (ash -1 30) #x3FFFFFFF)
(test (ash -1 31) #x7FFFFFFF)
(test (ash -1 32) #xFFFFFFFF)
(test (ash -1 33) #x1FFFFFFFF)
(test (ash -1 60) #x0FFFFFFFFFFFFFFF)
(test (ash -1 61) #x1FFFFFFFFFFFFFFF)
(test (ash -1 62) #x3FFFFFFFFFFFFFFF)
(test (ash -1 63) #x7FFFFFFFFFFFFFFF)
(test (ash -1 64) #xFFFFFFFFFFFFFFFF)
(test (ash -1 65) #x1FFFFFFFFFFFFFFFF)
(test (ash -1 128) #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)))
;;;
;;; lognot
;;;
(with-test-prefix "lognot"
(pass-if (documented? lognot))
(pass-if (= -1 (lognot 0)))
(pass-if (= 0 (lognot -1)))
(pass-if (= -2 (lognot 1)))
(pass-if (= 1 (lognot -2)))
(pass-if (= #x-100000000000000000000000000000000
(lognot #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)))
(pass-if (= #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
(lognot #x-100000000000000000000000000000000))))
;;;
;;; sqrt
;;;
(with-test-prefix "sqrt"
(pass-if (documented? sqrt))
(pass-if-exception "no args" exception:wrong-num-args
(sqrt))
(pass-if-exception "two args" exception:wrong-num-args
(sqrt 123 456))
(pass-if (eqv? 0.0 (sqrt 0)))
(pass-if (eqv? 0.0 (sqrt 0.0)))
(pass-if (eqv? 1.0 (sqrt 1.0)))
(pass-if (eqv-loosely? 2.0 (sqrt 4.0)))
(pass-if (eqv-loosely? 31.62 (sqrt 1000.0)))
(pass-if (eqv? +1.0i (sqrt -1.0)))
(pass-if (eqv-loosely? +2.0i (sqrt -4.0)))
(pass-if (eqv-loosely? +31.62i (sqrt -1000.0)))
(pass-if "+i swings back to 45deg angle"
(eqv-loosely? +0.7071+0.7071i (sqrt +1.0i)))
;; Note: glibc 2.3 csqrt() had a bug affecting this test case, so if it
;; fails check whether that's the cause (there's a configure test to
;; reject it, but when cross-compiling we assume the C library is ok).
(pass-if "-100i swings back to 45deg down"
(eqv-loosely? +7.071-7.071i (sqrt -100.0i))))
;;;
;;; euclidean/
;;; euclidean-quotient
;;; euclidean-remainder
;;; centered/
;;; centered-quotient
;;; centered-remainder
;;;
(with-test-prefix "Number-theoretic division"
;; Tests that (lo <1 x <2 hi),
;; but allowing for imprecision
;; if x is inexact.
(define (test-within-range? lo <1 x <2 hi)
(if (exact? x)
(and (<1 lo x) (<2 x hi))
(let ((lo (- lo test-epsilon))
(hi (+ hi test-epsilon)))
(<= lo x hi))))
(define (valid-euclidean-answer? x y q r)
(and (eq? (exact? q)
(exact? r)
(and (exact? x) (exact? y)))
(test-eqv? r (- x (* q y)))
(if (and (finite? x) (finite? y))
(and (integer? q)
(test-within-range? 0 <= r < (abs y)))
(test-eqv? q (/ x y)))))
(define (valid-floor-answer? x y q r)
(and (eq? (exact? q)
(exact? r)
(and (exact? x) (exact? y)))
(test-eqv? r (- x (* q y)))
(if (and (finite? x) (finite? y))
(and (integer? q)
(if (> y 0)
(test-within-range? 0 <= r < y)
(test-within-range? y < r <= 0)))
(test-eqv? q (/ x y)))))
(define (valid-ceiling-answer? x y q r)
(and (eq? (exact? q)
(exact? r)
(and (exact? x) (exact? y)))
(test-eqv? r (- x (* q y)))
(if (and (finite? x) (finite? y))
(and (integer? q)
(if (> y 0)
(test-within-range? (- y) < r <= 0)
(test-within-range? 0 <= r < (- y))))
(test-eqv? q (/ x y)))))
(define (valid-truncate-answer? x y q r)
(and (eq? (exact? q)
(exact? r)
(and (exact? x) (exact? y)))
(test-eqv? r (- x (* q y)))
(if (and (finite? x) (finite? y))
(and (integer? q)
(if (> x 0)
(test-within-range? 0 <= r < (abs y))
(test-within-range? (- (abs y)) < r <= 0)))
(test-eqv? q (/ x y)))))
(define (valid-centered-answer? x y q r)
(and (eq? (exact? q)
(exact? r)
(and (exact? x) (exact? y)))
(test-eqv? r (- x (* q y)))
(if (and (finite? x) (finite? y))
(and (integer? q)
(test-within-range?
(* -1/2 (abs y)) <= r < (* +1/2 (abs y))))
(test-eqv? q (/ x y)))))
(define (valid-round-answer? x y q r)
(and (eq? (exact? q)
(exact? r)
(and (exact? x) (exact? y)))
(test-eqv? r (- x (* q y)))
(if (and (finite? x) (finite? y))
(and (integer? q)
(let ((ay/2 (/ (abs y) 2)))
(if (even? q)
(test-within-range? (- ay/2) <= r <= ay/2)
(test-within-range? (- ay/2) < r < ay/2))))
(test-eqv? q (/ x y)))))
(define (for lsts f) (apply for-each f lsts))
(define big (expt 10 (1+ (inexact->exact (ceiling (log10 fixnum-max))))))
(define (run-division-tests quo+rem quo rem valid-answer?)
(define (test n d)
(run-test (list n d) #t
(lambda ()
(let-values (((q r) (quo+rem n d)))
(and (test-eqv? q (quo n d))
(test-eqv? r (rem n d))
(valid-answer? n d q r))))))
(define (test+/- n d)
(test n d )
(test n (- d))
(cond ((not (zero? n))
(test (- n) d )
(test (- n) (- d)))))
(define (test-for-exception n d exception)
(let ((name (list n d)))
(pass-if-exception name exception (quo+rem n d))
(pass-if-exception name exception (quo n d))
(pass-if-exception name exception (rem n d))))
(run-test "documented?" #t
(lambda ()
(and (documented? quo+rem)
(documented? quo)
(documented? rem))))
(with-test-prefix "inum / inum"
(with-test-prefix "fixnum-min / -1"
(test fixnum-min -1))
(for '((1 2 5 10)) ;; denominators
(lambda (d)
(for '((0 1 2 5 10)) ;; multiples
(lambda (m)
(for '((-2 -1 0 1 2 3 4 5 7 10
12 15 16 19 20)) ;; offsets
(lambda (b)
(test+/- (+ b (* m d))
d))))))))
(with-test-prefix "inum / big"
(with-test-prefix "fixnum-min / -fixnum-min"
(test fixnum-min (- fixnum-min)))
(with-test-prefix "fixnum-max / (2*fixnum-max)"
(test+/- fixnum-max (* 2 fixnum-max)))
(for `((0 1 2 10 ,(1- fixnum-max) ,fixnum-max))
(lambda (n)
(test n (1+ fixnum-max))
(test (- n) (1+ fixnum-max))
(test n (1- fixnum-min))
(test (- n) (1- fixnum-min)))))
(with-test-prefix "big / inum"
(with-test-prefix "-fixnum-min / fixnum-min"
(test (- fixnum-min) fixnum-min))
(for '((1 4 5 10)) ;; denominators
(lambda (d)
(for `((1 2 5 ,@(if (even? d)
'(1/2 3/2 5/2)
'()))) ;; multiples
(lambda (m)
(for '((-2 -1 0 1 2)) ;; offsets
(lambda (b)
(test+/- (+ b (* m d big))
d))))))))
(with-test-prefix "big / big"
(for `((,big ,(1+ big))) ;; denominators
(lambda (d)
(for `((1 2 5 ,@(if (even? d)
'(1/2 3/2 5/2)
'()))) ;; multiples
(lambda (m)
(for '((-2 -1 0 1 2)) ;; offsets
(lambda (b)
(test+/- (+ b (* m d))
d))))))))
(with-test-prefix "inexact"
(for '((0.5 1.5 2.25 5.75)) ;; denominators
(lambda (d)
(for '((0 1 2 5 1/2 3/2 5/2)) ;; multiples
(lambda (m)
(for '((-2 -1 0 1 2)) ;; offsets
(lambda (b)
(test+/- (+ b (* m d))
d))))))))
(with-test-prefix "fractions"
(for '((1/10 16/3 10/7)) ;; denominators
(lambda (d)
(for '((0 1 2 5 1/2 3/2 5/2)) ;; multiples
(lambda (m)
(for '((-2/9 -1/11 0 1/3 2/3)) ;; offsets
(lambda (b)
(test+/- (+ b (* m d))
d))))))))
(with-test-prefix "mixed types"
(for `((10 ,big 12.0 10/7 +inf.0 -inf.0 +nan.0)) ;; denominators
(lambda (d)
(for `((25 ,(* 3/2 big) 130.0 15/7
0 0.0 -0.0 +inf.0 -inf.0 +nan.0)) ;; numerators
(lambda (n)
(test+/- n d))))))
(with-test-prefix "divide by zero"
(for `((0 0.0 +0.0)) ;; denominators
(lambda (d)
(for `((15 ,(* 3/2 big) 18.0 33/7
0 0.0 -0.0 +inf.0 -inf.0 +nan.0)) ;; numerators
(lambda (n)
(test-for-exception
n d exception:numerical-overflow)))))))
(with-test-prefix "euclidean/"
(run-division-tests euclidean/
euclidean-quotient
euclidean-remainder
valid-euclidean-answer?))
(with-test-prefix "floor/"
(run-division-tests floor/
floor-quotient
floor-remainder
valid-floor-answer?))
(with-test-prefix "ceiling/"
(run-division-tests ceiling/
ceiling-quotient
ceiling-remainder
valid-ceiling-answer?))
(with-test-prefix "truncate/"
(run-division-tests truncate/
truncate-quotient
truncate-remainder
valid-truncate-answer?))
(with-test-prefix "centered/"
(run-division-tests centered/
centered-quotient
centered-remainder
valid-centered-answer?))
(with-test-prefix "round/"
(run-division-tests round/
round-quotient
round-remainder
valid-round-answer?)))
View git blame Copy permalink