(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)))
+
+(define const-e 2.7182818284590452354)
+(define const-e^2 7.3890560989306502274)
+(define const-1/e 0.3678794411714423215)
+
+
;;;
;;; 1+
;;;
(pass-if "sqrt ((fixnum-max+1)^2 - 1)"
(eq? #f (exact? (sqrt (- (expt (+ fixnum-max 1) 2) 1)))))))
+;;;
+;;; exp
+;;;
+
+(with-test-prefix "exp"
+ (pass-if "documented?"
+ (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 "big / real"
(pass-if (nan? (max big*5 +nan.0)))
- (pass-if (= big*5 (max big*5 -inf.0)))
- (pass-if (= +inf.0 (max big*5 +inf.0)))
- (pass-if (= 1.0 (max (- big*5) 1.0)))
- (pass-if (inexact? (max big*5 1.0)))
- (pass-if (= (exact->inexact big*5) (max big*5 1.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 (nan? (max +nan.0 big*5)))
- (pass-if (= +inf.0 (max +inf.0 big*5)))
- (pass-if (= big*5 (max -inf.0 big*5)))
- (pass-if (= 1.0 (max 1.0 (- big*5))))
- (pass-if (inexact? (max 1.0 big*5)))
- (pass-if (= (exact->inexact big*5) (max 1.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 (= 2/3 (max 1/2 2/3)))
(with-test-prefix "big / real"
(pass-if (nan? (min big*5 +nan.0)))
- (pass-if (= big*5 (min big*5 +inf.0)))
- (pass-if (= -inf.0 (min big*5 -inf.0)))
- (pass-if (= 1.0 (min big*5 1.0)))
- (pass-if (inexact? (min (- big*5) 1.0)))
- (pass-if (= (exact->inexact (- big*5)) (min (- big*5) 1.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 (nan? (min +nan.0 big*5)))
- (pass-if (= big*5 (min +inf.0 big*5)))
- (pass-if (= -inf.0 (min -inf.0 big*5)))
- (pass-if (= 1.0 (min 1.0 big*5)))
- (pass-if (inexact? (min 1.0 (- big*5))))
- (pass-if (= (exact->inexact (- big*5)) (min 1.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 (= 1/2 (min 1/2 2/3)))
(with-test-prefix "*"
+ (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"
+ (eqv? 0 (* 0 1.0))))
+
+ (with-test-prefix "inum * complex"
+
+ (pass-if "0 * 1+1i = 0"
+ (eqv? 0 (* 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"
+
+ ;; in guile 1.6.8 and 1.8.1 and earlier this returned inexact 0.0
+ (pass-if "1.0 * 0 = 0"
+ (eqv? 0 (* 1.0 0))))
+
+ (with-test-prefix "complex * inum"
+
+ ;; in guile 1.6.8 and 1.8.1 and earlier this returned inexact 0.0
+ (pass-if "1+1i * 0 = 0"
+ (eqv? 0 (* 1+1i 0))))
+
(pass-if "complex * bignum"
(let ((big (ash 1 90)))
(= (make-rectangular big big)
- (* 1+1i big)))))
+ (* 1+1i big))))
+
+ (with-test-prefix "frac * inum"
+
+ (pass-if "2/3 * 0 = 0"
+ (eqv? 0 (* 2/3 0)))))
;;;
;;; /
(pass-if n
(= i (integer-length n))))))
+;;;
+;;; log
+;;;
+
+(with-test-prefix "log"
+ (pass-if "documented?"
+ (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?"
+ (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?
;;;
(lognot #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)))
(pass-if (= #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
(lognot #x-100000000000000000000000000000000))))
+
+;;;
+;;; sqrt
+;;;
+
+(with-test-prefix "sqrt"
+ (pass-if "documented?"
+ (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))))
+
+
+;;
+;; equal?
+;;
+
+
+(with-test-prefix "equal?"
+ (pass-if
+
+ ;; lazy reduction bit for rationals should not affect equal?
+ (equal? 1/2 ((lambda (x) (denominator x) x) 1/2))))
+
HCoop / bpt / guile.git / blobdiff