mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 03:30:27 +02:00
Merge remote-tracking branch 'origin/stable-2.0'
Conflicts: libguile/numbers.c
This commit is contained in:
Mark H Weaver
commit
902a4e779d
4 changed files with 185 additions and 71 deletions
|
|
@ -4144,6 +4144,8 @@ scm_gcd (SCM x, SCM y)
|
|||
SCM_SWAP (x, y);
|
||||
goto big_inum;
|
||||
}
|
||||
else if (SCM_REALP (y) && scm_is_integer (y))
|
||||
goto handle_inexacts;
|
||||
else
|
||||
return scm_wta_dispatch_2 (g_gcd, x, y, SCM_ARG2, s_gcd);
|
||||
}
|
||||
|
|
@ -4174,6 +4176,20 @@ scm_gcd (SCM x, SCM y)
|
|||
scm_remember_upto_here_2 (x, y);
|
||||
return scm_i_normbig (result);
|
||||
}
|
||||
else if (SCM_REALP (y) && scm_is_integer (y))
|
||||
goto handle_inexacts;
|
||||
else
|
||||
SCM_WTA_DISPATCH_2 (g_gcd, x, y, SCM_ARG2, s_gcd);
|
||||
}
|
||||
else if (SCM_REALP (x) && scm_is_integer (x))
|
||||
{
|
||||
if (SCM_I_INUMP (y) || SCM_BIGP (y)
|
||||
|| (SCM_REALP (y) && scm_is_integer (y)))
|
||||
{
|
||||
handle_inexacts:
|
||||
return scm_exact_to_inexact (scm_gcd (scm_inexact_to_exact (x),
|
||||
scm_inexact_to_exact (y)));
|
||||
}
|
||||
else
|
||||
return scm_wta_dispatch_2 (g_gcd, x, y, SCM_ARG2, s_gcd);
|
||||
}
|
||||
|
|
@ -4202,22 +4218,12 @@ SCM_PRIMITIVE_GENERIC (scm_i_lcm, "lcm", 0, 2, 1,
|
|||
SCM
|
||||
scm_lcm (SCM n1, SCM n2)
|
||||
{
|
||||
if (SCM_UNBNDP (n2))
|
||||
{
|
||||
if (SCM_UNBNDP (n1))
|
||||
return SCM_I_MAKINUM (1L);
|
||||
n2 = SCM_I_MAKINUM (1L);
|
||||
}
|
||||
if (SCM_UNLIKELY (SCM_UNBNDP (n2)))
|
||||
return SCM_UNBNDP (n1) ? SCM_INUM1 : scm_abs (n1);
|
||||
|
||||
if (SCM_UNLIKELY (!(SCM_I_INUMP (n1) || SCM_BIGP (n1))))
|
||||
return scm_wta_dispatch_2 (g_lcm, n1, n2, SCM_ARG1, s_lcm);
|
||||
|
||||
if (SCM_UNLIKELY (!(SCM_I_INUMP (n2) || SCM_BIGP (n2))))
|
||||
return scm_wta_dispatch_2 (g_lcm, n1, n2, SCM_ARG2, s_lcm);
|
||||
|
||||
if (SCM_I_INUMP (n1))
|
||||
if (SCM_LIKELY (SCM_I_INUMP (n1)))
|
||||
{
|
||||
if (SCM_I_INUMP (n2))
|
||||
if (SCM_LIKELY (SCM_I_INUMP (n2)))
|
||||
{
|
||||
SCM d = scm_gcd (n1, n2);
|
||||
if (scm_is_eq (d, SCM_INUM0))
|
||||
|
|
@ -4225,7 +4231,7 @@ scm_lcm (SCM n1, SCM n2)
|
|||
else
|
||||
return scm_abs (scm_product (n1, scm_quotient (n2, d)));
|
||||
}
|
||||
else
|
||||
else if (SCM_LIKELY (SCM_BIGP (n2)))
|
||||
{
|
||||
/* inum n1, big n2 */
|
||||
inumbig:
|
||||
|
|
@ -4239,8 +4245,12 @@ scm_lcm (SCM n1, SCM n2)
|
|||
return result;
|
||||
}
|
||||
}
|
||||
else if (SCM_REALP (n2) && scm_is_integer (n2))
|
||||
goto handle_inexacts;
|
||||
else
|
||||
return scm_wta_dispatch_2 (g_lcm, n1, n2, SCM_ARG2, s_lcm);
|
||||
}
|
||||
else
|
||||
else if (SCM_LIKELY (SCM_BIGP (n1)))
|
||||
{
|
||||
/* big n1 */
|
||||
if (SCM_I_INUMP (n2))
|
||||
|
|
@ -4248,7 +4258,7 @@ scm_lcm (SCM n1, SCM n2)
|
|||
SCM_SWAP (n1, n2);
|
||||
goto inumbig;
|
||||
}
|
||||
else
|
||||
else if (SCM_LIKELY (SCM_BIGP (n2)))
|
||||
{
|
||||
SCM result = scm_i_mkbig ();
|
||||
mpz_lcm(SCM_I_BIG_MPZ (result),
|
||||
|
|
@ -4258,7 +4268,25 @@ scm_lcm (SCM n1, SCM n2)
|
|||
/* shouldn't need to normalize b/c lcm of 2 bigs should be big */
|
||||
return result;
|
||||
}
|
||||
else if (SCM_REALP (n2) && scm_is_integer (n2))
|
||||
goto handle_inexacts;
|
||||
else
|
||||
return scm_wta_dispatch_2 (g_lcm, n1, n2, SCM_ARG2, s_lcm);
|
||||
}
|
||||
else if (SCM_REALP (n1) && scm_is_integer (n1))
|
||||
{
|
||||
if (SCM_I_INUMP (n2) || SCM_BIGP (n2)
|
||||
|| (SCM_REALP (n2) && scm_is_integer (n2)))
|
||||
{
|
||||
handle_inexacts:
|
||||
return scm_exact_to_inexact (scm_lcm (scm_inexact_to_exact (n1),
|
||||
scm_inexact_to_exact (n2)));
|
||||
}
|
||||
else
|
||||
return scm_wta_dispatch_2 (g_lcm, n1, n2, SCM_ARG2, s_lcm);
|
||||
}
|
||||
else
|
||||
return scm_wta_dispatch_2 (g_lcm, n1, n2, SCM_ARG1, s_lcm);
|
||||
}
|
||||
|
||||
/* Emulating 2's complement bignums with sign magnitude arithmetic:
|
||||
|
|
@ -7230,17 +7258,16 @@ scm_max (SCM x, SCM y)
|
|||
double xx = SCM_REAL_VALUE (x);
|
||||
double yy = SCM_REAL_VALUE (y);
|
||||
|
||||
/* For purposes of max: +inf.0 > nan > everything else, per R6RS */
|
||||
/* For purposes of max: nan > +inf.0 > everything else,
|
||||
per the R6RS errata */
|
||||
if (xx > yy)
|
||||
return x;
|
||||
else if (SCM_LIKELY (xx < yy))
|
||||
return y;
|
||||
/* If neither (xx > yy) nor (xx < yy), then
|
||||
either they're equal or one is a NaN */
|
||||
else if (SCM_UNLIKELY (isnan (xx)))
|
||||
return DOUBLE_IS_POSITIVE_INFINITY (yy) ? y : x;
|
||||
else if (SCM_UNLIKELY (isnan (yy)))
|
||||
return DOUBLE_IS_POSITIVE_INFINITY (xx) ? x : y;
|
||||
else if (SCM_UNLIKELY (xx != yy))
|
||||
return (xx != xx) ? x : y; /* Return the NaN */
|
||||
/* xx == yy, but handle signed zeroes properly */
|
||||
else if (double_is_non_negative_zero (yy))
|
||||
return y;
|
||||
|
|
@ -7390,17 +7417,16 @@ scm_min (SCM x, SCM y)
|
|||
double xx = SCM_REAL_VALUE (x);
|
||||
double yy = SCM_REAL_VALUE (y);
|
||||
|
||||
/* For purposes of min: -inf.0 < nan < everything else, per R6RS */
|
||||
/* For purposes of min: nan < -inf.0 < everything else,
|
||||
per the R6RS errata */
|
||||
if (xx < yy)
|
||||
return x;
|
||||
else if (SCM_LIKELY (xx > yy))
|
||||
return y;
|
||||
/* If neither (xx < yy) nor (xx > yy), then
|
||||
either they're equal or one is a NaN */
|
||||
else if (SCM_UNLIKELY (isnan (xx)))
|
||||
return DOUBLE_IS_NEGATIVE_INFINITY (yy) ? y : x;
|
||||
else if (SCM_UNLIKELY (isnan (yy)))
|
||||
return DOUBLE_IS_NEGATIVE_INFINITY (xx) ? x : y;
|
||||
else if (SCM_UNLIKELY (xx != yy))
|
||||
return (xx != xx) ? x : y; /* Return the NaN */
|
||||
/* xx == yy, but handle signed zeroes properly */
|
||||
else if (double_is_non_negative_zero (xx))
|
||||
return y;
|
||||
|
|
|
|||
|
|
@ -61,18 +61,24 @@
|
|||
(only (guile) inf?)
|
||||
(rnrs arithmetic fixnums (6))
|
||||
(rnrs base (6))
|
||||
(rnrs control (6))
|
||||
(rnrs conditions (6))
|
||||
(rnrs exceptions (6))
|
||||
(rnrs lists (6))
|
||||
(rnrs r5rs (6)))
|
||||
|
||||
(define (flonum? obj) (and (number? obj) (inexact? obj)))
|
||||
(define (flonum? obj) (and (real? obj) (inexact? obj)))
|
||||
(define (assert-flonum . args)
|
||||
(or (for-all flonum? args) (raise (make-assertion-violation))))
|
||||
(define (assert-iflonum . args)
|
||||
(or (for-all (lambda (i) (and (flonum? i) (integer? i))) args)
|
||||
(raise (make-assertion-violation))))
|
||||
|
||||
(define (ensure-flonum z)
|
||||
(cond ((real? z) z)
|
||||
((zero? (imag-part z)) (real-part z))
|
||||
(else +nan.0)))
|
||||
|
||||
(define (real->flonum x)
|
||||
(or (real? x) (raise (make-assertion-violation)))
|
||||
(exact->inexact x))
|
||||
|
|
@ -89,7 +95,7 @@
|
|||
(define (flnegative? fl) (assert-flonum fl) (negative? fl))
|
||||
(define (flodd? ifl) (assert-iflonum ifl) (odd? ifl))
|
||||
(define (fleven? ifl) (assert-iflonum ifl) (even? ifl))
|
||||
(define (flfinite? fl) (assert-flonum fl) (not (inf? fl)))
|
||||
(define (flfinite? fl) (assert-flonum fl) (not (or (inf? fl) (nan? fl))))
|
||||
(define (flinfinite? fl) (assert-flonum fl) (inf? fl))
|
||||
(define (flnan? fl) (assert-flonum fl) (nan? fl))
|
||||
|
||||
|
|
@ -103,15 +109,13 @@
|
|||
(apply assert-flonum flargs)
|
||||
(apply min flargs)))
|
||||
|
||||
(define (fl+ fl1 . args)
|
||||
(let ((flargs (cons fl1 args)))
|
||||
(apply assert-flonum flargs)
|
||||
(apply + flargs)))
|
||||
(define (fl+ . args)
|
||||
(apply assert-flonum args)
|
||||
(if (null? args) 0.0 (apply + args)))
|
||||
|
||||
(define (fl* fl1 . args)
|
||||
(let ((flargs (cons fl1 args)))
|
||||
(apply assert-flonum flargs)
|
||||
(apply * flargs)))
|
||||
(define (fl* . args)
|
||||
(apply assert-flonum args)
|
||||
(if (null? args) 1.0 (apply * args)))
|
||||
|
||||
(define (fl- fl1 . args)
|
||||
(let ((flargs (cons fl1 args)))
|
||||
|
|
@ -169,23 +173,30 @@
|
|||
(define (flround fl) (assert-flonum fl) (round fl))
|
||||
|
||||
(define (flexp fl) (assert-flonum fl) (exp fl))
|
||||
(define* (fllog fl #:optional fl2)
|
||||
(assert-flonum fl)
|
||||
(cond ((fl=? fl -inf.0) +nan.0)
|
||||
(fl2 (begin (assert-flonum fl2) (/ (log fl) (log fl2))))
|
||||
(else (log fl))))
|
||||
(define fllog
|
||||
(case-lambda
|
||||
((fl)
|
||||
(assert-flonum fl)
|
||||
;; add 0.0 to fl, to change -0.0 to 0.0,
|
||||
;; so that (fllog -0.0) will be -inf.0, not -inf.0+pi*i.
|
||||
(ensure-flonum (log (+ fl 0.0))))
|
||||
((fl fl2)
|
||||
(assert-flonum fl fl2)
|
||||
(ensure-flonum (/ (log (+ fl 0.0))
|
||||
(log (+ fl2 0.0)))))))
|
||||
|
||||
(define (flsin fl) (assert-flonum fl) (sin fl))
|
||||
(define (flcos fl) (assert-flonum fl) (cos fl))
|
||||
(define (fltan fl) (assert-flonum fl) (tan fl))
|
||||
(define (flasin fl) (assert-flonum fl) (asin fl))
|
||||
(define (flacos fl) (assert-flonum fl) (acos fl))
|
||||
(define* (flatan fl #:optional fl2)
|
||||
(assert-flonum fl)
|
||||
(if fl2 (begin (assert-flonum fl2) (atan fl fl2)) (atan fl)))
|
||||
(define (flasin fl) (assert-flonum fl) (ensure-flonum (asin fl)))
|
||||
(define (flacos fl) (assert-flonum fl) (ensure-flonum (acos fl)))
|
||||
(define flatan
|
||||
(case-lambda
|
||||
((fl) (assert-flonum fl) (atan fl))
|
||||
((fl fl2) (assert-flonum fl fl2) (atan fl fl2))))
|
||||
|
||||
(define (flsqrt fl) (assert-flonum fl) (sqrt fl))
|
||||
(define (flexpt fl1 fl2) (assert-flonum fl1 fl2) (expt fl1 fl2))
|
||||
(define (flsqrt fl) (assert-flonum fl) (ensure-flonum (sqrt fl)))
|
||||
(define (flexpt fl1 fl2) (assert-flonum fl1 fl2) (ensure-flonum (expt fl1 fl2)))
|
||||
|
||||
(define-condition-type &no-infinities
|
||||
&implementation-restriction
|
||||
|
|
|
|||
|
|
@ -1322,6 +1322,32 @@
|
|||
(pass-if "n = fixnum-min - 1"
|
||||
(eqv? (- (- fixnum-min 1)) (gcd (- fixnum-min 1) (- fixnum-min 1)))))
|
||||
|
||||
(with-test-prefix "flonum arguments"
|
||||
|
||||
(pass-if-equal "flonum"
|
||||
15.0
|
||||
(gcd -15.0))
|
||||
|
||||
(pass-if-equal "flonum/flonum"
|
||||
3.0
|
||||
(gcd 6.0 -15.0))
|
||||
|
||||
(pass-if-equal "flonum/fixnum"
|
||||
3.0
|
||||
(gcd 6.0 -15))
|
||||
|
||||
(pass-if-equal "fixnum/flonum"
|
||||
3.0
|
||||
(gcd -6 15.0))
|
||||
|
||||
(pass-if-equal "flonum/bignum"
|
||||
2.0
|
||||
(gcd -6.0 (expt 2 fixnum-bit)))
|
||||
|
||||
(pass-if-equal "bignum/flonum"
|
||||
3.0
|
||||
(gcd (- (expt 3 fixnum-bit)) 6.0)))
|
||||
|
||||
;; Are wrong type arguments detected correctly?
|
||||
|
||||
)
|
||||
|
|
@ -1334,8 +1360,40 @@
|
|||
;; 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))
|
||||
(pass-if-equal 1 (lcm))
|
||||
(pass-if-equal 15 (lcm -15))
|
||||
(pass-if-equal 288 (lcm 32 -36))
|
||||
|
||||
(with-test-prefix "flonum arguments"
|
||||
|
||||
(pass-if-equal "flonum"
|
||||
15.0
|
||||
(lcm -15.0))
|
||||
|
||||
(pass-if-equal "flonum/flonum"
|
||||
30.0
|
||||
(lcm 6.0 -15.0))
|
||||
|
||||
(pass-if-equal "flonum/fixnum"
|
||||
30.0
|
||||
(lcm 6.0 -15))
|
||||
|
||||
(pass-if-equal "fixnum/flonum"
|
||||
30.0
|
||||
(lcm -6 15.0))
|
||||
|
||||
(pass-if "flonum/bignum"
|
||||
(let ((want (* 3.0 (expt 2 fixnum-bit)))
|
||||
(got (lcm -6.0 (expt 2 fixnum-bit))))
|
||||
(and (inexact? got)
|
||||
(test-eqv? 1.0 (/ want got)))))
|
||||
|
||||
(pass-if "bignum/flonum"
|
||||
(let ((want (* 2.0 (expt 3 fixnum-bit)))
|
||||
(got (lcm (- (expt 3 fixnum-bit)) 6.0)))
|
||||
(and (inexact? got)
|
||||
(test-eqv? 1.0 (/ want got))))))
|
||||
|
||||
(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)))
|
||||
|
|
@ -2690,7 +2748,7 @@
|
|||
(pass-if (eqv? 5/2 (max 5/2 2))))
|
||||
|
||||
(with-test-prefix "infinities and NaNs"
|
||||
;; +inf.0 beats everything else, including NaNs
|
||||
;; +inf.0 beats everything except 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 )))
|
||||
|
|
@ -2703,11 +2761,9 @@
|
|||
(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
|
||||
;; NaNs beat everything
|
||||
(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 )))
|
||||
|
|
@ -2721,6 +2777,8 @@
|
|||
(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 )))
|
||||
(pass-if (real-nan? (max +inf.0 +nan.0 )))
|
||||
(pass-if (real-nan? (max +nan.0 +inf.0 )))
|
||||
|
||||
;; -inf.0 always loses, except against itself
|
||||
(pass-if (eqv? -inf.0 (max -inf.0 -inf.0 )))
|
||||
|
|
@ -2868,7 +2926,7 @@
|
|||
(pass-if (eqv? 2 (min 5/2 2))))
|
||||
|
||||
(with-test-prefix "infinities and NaNs"
|
||||
;; -inf.0 beats everything else, including NaNs
|
||||
;; -inf.0 beats everything except 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 )))
|
||||
|
|
@ -2881,11 +2939,9 @@
|
|||
(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
|
||||
;; NaNs beat everything
|
||||
(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 )))
|
||||
|
|
@ -2899,6 +2955,8 @@
|
|||
(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 )))
|
||||
(pass-if (real-nan? (min -inf.0 +nan.0 )))
|
||||
(pass-if (real-nan? (min +nan.0 -inf.0 )))
|
||||
|
||||
;; +inf.0 always loses, except against itself
|
||||
(pass-if (eqv? +inf.0 (min +inf.0 +inf.0 )))
|
||||
|
|
|
|||
|
|
@ -30,7 +30,10 @@
|
|||
(pass-if "flonum? is #t on flonum"
|
||||
(flonum? 1.5))
|
||||
|
||||
(pass-if "flonum? is #f on non-flonum"
|
||||
(pass-if "flonum? is #f on complex"
|
||||
(not (flonum? 1.5+0.0i)))
|
||||
|
||||
(pass-if "flonum? is #f on exact integer"
|
||||
(not (flonum? 3))))
|
||||
|
||||
(with-test-prefix "real->flonum"
|
||||
|
|
@ -139,7 +142,10 @@
|
|||
(flfinite? 2.0))
|
||||
|
||||
(pass-if "flfinite? is #f on infinities"
|
||||
(and (not (flfinite? +inf.0)) (not (flfinite? -inf.0)))))
|
||||
(and (not (flfinite? +inf.0)) (not (flfinite? -inf.0))))
|
||||
|
||||
(pass-if "flfinite? is #f on NaNs"
|
||||
(not (flfinite? +nan.0))))
|
||||
|
||||
(with-test-prefix "flinfinite?"
|
||||
(pass-if "flinfinite? is #t on infinities"
|
||||
|
|
@ -162,10 +168,12 @@
|
|||
(pass-if "simple" (fl=? (flmin -1.0 0.0 2.0) -1.0)))
|
||||
|
||||
(with-test-prefix "fl+"
|
||||
(pass-if "simple" (fl=? (fl+ 2.141 1.0 0.1) 3.241)))
|
||||
(pass-if "simple" (fl=? (fl+ 2.141 1.0 0.1) 3.241))
|
||||
(pass-if "zero args" (fl=? (fl+) 0.0)))
|
||||
|
||||
(with-test-prefix "fl*"
|
||||
(pass-if "simple" (fl=? (fl* 1.0 2.0 3.0 1.5) 9.0)))
|
||||
(pass-if "simple" (fl=? (fl* 1.0 2.0 3.0 1.5) 9.0))
|
||||
(pass-if "zero args" (fl=? (fl*) 1.0)))
|
||||
|
||||
(with-test-prefix "fl-"
|
||||
(pass-if "unary fl- negates argument" (fl=? (fl- 2.0) -2.0))
|
||||
|
|
@ -248,14 +256,18 @@
|
|||
|
||||
(with-test-prefix "fllog"
|
||||
(pass-if "unary fllog returns natural log"
|
||||
(let ((l (fllog 2.718281828459045)))
|
||||
(and (fl<=? 0.9 l) (fl>=? 1.1 l))))
|
||||
(reasonably-close? (fllog 2.718281828459045) 1.0))
|
||||
|
||||
(pass-if "infinities"
|
||||
(and (fl=? (fllog +inf.0) +inf.0)
|
||||
(flnan? (fllog -inf.0))))
|
||||
|
||||
(pass-if "zeroes" (fl=? (fllog 0.0) -inf.0))
|
||||
(pass-if "negative argument"
|
||||
(flnan? (fllog -1.0)))
|
||||
|
||||
(pass-if "zero" (fl=? (fllog 0.0) -inf.0))
|
||||
(pass-if "negative zero" (fl=? (fllog -0.0) -inf.0))
|
||||
(pass-if "negative zero with base" (fl=? (fllog -0.0 0.5) +inf.0))
|
||||
|
||||
(pass-if "binary fllog returns log in specified base"
|
||||
(fl=? (fllog 8.0 2.0) 3.0)))
|
||||
|
|
@ -277,12 +289,16 @@
|
|||
(with-test-prefix "flasin"
|
||||
(pass-if "simple"
|
||||
(and (reasonably-close? (flasin 1.0) (/ fake-pi 2))
|
||||
(reasonably-close? (flasin 0.5) (/ fake-pi 6)))))
|
||||
(reasonably-close? (flasin 0.5) (/ fake-pi 6))))
|
||||
(pass-if "out of range"
|
||||
(flnan? (flasin 2.0))))
|
||||
|
||||
(with-test-prefix "flacos"
|
||||
(pass-if "simple"
|
||||
(and (fl=? (flacos 1.0) 0.0)
|
||||
(reasonably-close? (flacos 0.5) (/ fake-pi 3)))))
|
||||
(reasonably-close? (flacos 0.5) (/ fake-pi 3))))
|
||||
(pass-if "out of range"
|
||||
(flnan? (flacos 2.0))))
|
||||
|
||||
(with-test-prefix "flatan"
|
||||
(pass-if "unary flatan"
|
||||
|
|
@ -298,12 +314,15 @@
|
|||
|
||||
(with-test-prefix "flsqrt"
|
||||
(pass-if "simple" (fl=? (flsqrt 4.0) 2.0))
|
||||
|
||||
(pass-if "negative" (flnan? (flsqrt -1.0)))
|
||||
(pass-if "infinity" (fl=? (flsqrt +inf.0) +inf.0))
|
||||
|
||||
(pass-if "negative zero" (fl=? (flsqrt -0.0) -0.0)))
|
||||
|
||||
(with-test-prefix "flexpt" (pass-if "simple" (fl=? (flexpt 2.0 3.0) 8.0)))
|
||||
(with-test-prefix "flexpt"
|
||||
(pass-if "simple" (fl=? (flexpt 2.0 3.0) 8.0))
|
||||
(pass-if "negative squared" (fl=? (flexpt -2.0 2.0) 4.0))
|
||||
(pass-if "negative cubed" (fl=? (flexpt -2.0 3.0) -8.0))
|
||||
(pass-if "negative to non-integer power" (flnan? (flexpt -2.0 2.5))))
|
||||
|
||||
(with-test-prefix "fixnum->flonum"
|
||||
(pass-if "simple" (fl=? (fixnum->flonum 100) 100.0)))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue