[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. release_1-9-14-179-gc
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. release_1-9-14-179-gc721848 |
|
Date: |
Wed, 02 Feb 2011 20:31:01 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=c721848287984e668a4f2fe7c3accba4a1bd8d10
The branch, master has been updated
via c721848287984e668a4f2fe7c3accba4a1bd8d10 (commit)
via 9b9ef10cf06db2c0349fb6e0ce6a5c4fa48341d1 (commit)
via 8deddc948d0b9cbd082d58e9c316a5380ea850a8 (commit)
via 2e2743113a944108ff8f9ad1becaec26960f5787 (commit)
from 09cb3ae237f6563bc5d3189562cfc841784751f2 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit c721848287984e668a4f2fe7c3accba4a1bd8d10
Author: Mark H Weaver <address@hidden>
Date: Wed Feb 2 05:29:55 2011 -0500
Support non-real complex numbers with inexact zero imaginary part
Add the ability to represent non-real complex numbers whose imaginary
part is an _inexact_ zero (0.0 or -0.0), per R6RS. Previously, such
numbers were immediately changed into inexact reals.
* libguile/numbers.c: Remove from the list of `General assumptions' in
numbers.c that objects satisfying SCM_COMPLEXP() have a non-zero
complex component. This is no longer true. Also add a warning
about another unrelated assumption that is not entirely correct
(that floor(r) == r implies that mpz_set_d will DTRT; it won't
if r is infinite).
(icmplx2str): Always print the imaginary part, even if it is zero.
Also handle a negative zero imaginary part more gracefully. It
now prints 0.0-0.0i, where previously it would print 0.0+-0.0i.
(mem2ureal): Replace scm_from_double (0.0) with flo0.
(scm_c_make_rectangular): Always create non-real complex numbers.
Previously it would create inexact reals if the specified imaginary
part was zero.
(scm_make_rectangular): If the imaginary part is an _exact_ 0, return
the real part unchanged (possibly exact), otherwise return a non-real
complex number (possibly with an inexact zero imaginary part).
Previously, it would return an inexact real number whenever the
imaginary part was any kind of zero.
(scm_make_polar): If the magnitude is an exact 0, return an exact 0.
If the angle is an exact 0, return the magnitude unchanged (possibly
exact). Otherwise return a non-real complex number (possibly with an
inexact zero imaginary part). Previously, it would return a real
number whenever the imaginary part was any kind of zero.
(scm_imag_part): Return an exact 0 if applied to a real number.
Previously it would return an inexact zero if applied to an inexact
real number.
(scm_inexact_to_exact): Accept complex numbers with inexact zero
imaginary part. In that case, simply use the real part and ignore the
imaginary part. Essentially we coerce the inexact zero imaginary part
to an exact 0.
* test-suite/tests/numbers.test: Add many test cases, and modify
existing tests as needed to reflect these changes. Also add a new
internal predicate: `almost-real-nan?' which tests for a non-real
complex number with zero imaginary part whose real part is a NaN.
* doc/ref/api-data.texi (Complex Numbers): Update description of complex
numbers to reflect these changes: non-real complex numbers in Guile
need not have non-zero imaginary part. Also, each part of a complex
number may be any inexact real, not just rationals as was previously
stated. Explicitly mention that each part may be an infinity, a NaN,
or a signed zero.
(Complex Number Operations): Change the formal parameter names of
`make-polar' from `x' and `y' to `mag' and `ang'.
* NEWS: Add news entries.
commit 9b9ef10cf06db2c0349fb6e0ce6a5c4fa48341d1
Author: Mark H Weaver <address@hidden>
Date: Wed Feb 2 03:14:13 2011 -0500
Improve handling of signed zeroes
* libguile/numbers.c (scm_abs): (abs -0.0) now returns 0.0. Previously
it returned -0.0. Also move the REALP case above the BIGP case,
and consider it SCM_LIKELY to be REALP if not INUMP.
(scm_difference): (- 0 0.0) now returns -0.0. Previously it returned
0.0. Also make sure that (- 0 0.0+0.0i) will return -0.0-0.0i.
* test-suite/tests/numbers.test (abs, -): Add test cases, and change
some tests to use `eqv?' instead of `=', in order to test exactness
and distinguish signed zeroes.
commit 8deddc948d0b9cbd082d58e9c316a5380ea850a8
Author: Mark H Weaver <address@hidden>
Date: Tue Feb 1 06:56:02 2011 -0500
Trigonometric functions return exact numbers in some cases
* libguile/numbers.c (scm_sin, scm_cos, scm_tan, scm_asin, scm_acos,
scm_atan, scm_sinh, scm_cosh, scm_tanh, scm_sys_asinh, scm_sys_acosh,
scm_sys_atanh): Return an exact result in some cases.
* test-suite/tests/numbers.test: Add test cases.
* NEWS: Add NEWS entry
commit 2e2743113a944108ff8f9ad1becaec26960f5787
Author: Mark H Weaver <address@hidden>
Date: Wed Feb 2 01:02:49 2011 -0500
Fix `min' and `max' handling of NaNs, infinities, and signed zeroes
* libguile/numbers.c (scm_min, scm_max): Properly order the real
infinities and NaNs, per R6RS, and also take care to handle signed
zeroes properly. Note that this ordering is different than that of
`<', `>', `<=', and `>=', which return #f if any argument is a real
NaN, and consider the real zeroes to be equal. The relevant real
infinity (-inf.0 for min, +inf.0 for max) beats everything, including
NaNs, and NaNs beat everything else. Previously these were handled
improperly in some cases, e.g.:
(min 1/2 +nan.0) now returns +nan.0 (previously returned 0.5),
(max 1/2 +nan.0) now returns +nan.0 (previously returned 0.5),
(min -inf.0 +nan.0) now returns -inf.0 (previously returned +nan.0),
(max +inf.0 +nan.0) now returns +inf.0 (previously returned +nan.0),
(min -0.0 0.0) now returns -0.0 (previously returned 0.0),
(max 0.0 -0.0) now returns 0.0 (previously returned -0.0),
(max 0 -0.0) now returns 0.0 (previously returned -0.0),
(max -0.0 0 ) now returns 0.0 (previously returned -0.0).
* test-suite/tests/numbers.test (min, max): Add many more test cases
relating to NaNs, infinities, and signed zeroes. Change most existing
test cases to use `eqv?' instead of `=', in order to check exactness.
-----------------------------------------------------------------------
Summary of changes:
NEWS | 49 ++++
doc/ref/api-data.texi | 20 +-
libguile/numbers.c | 288 ++++++++++++++------
test-suite/tests/numbers.test | 592 ++++++++++++++++++++++++++++++++++-------
4 files changed, 760 insertions(+), 189 deletions(-)
diff --git a/NEWS b/NEWS
index 73ef153..6781fa0 100644
--- a/NEWS
+++ b/NEWS
@@ -121,6 +121,48 @@ Note that these operators are equivalent to the R6RS
integer division
operators `div', `mod', `div-and-mod', `div0', `mod0', and
`div0-and-mod0'.
+*** Complex number changes
+
+Guile is now able to represent non-real complex numbers whose
+imaginary part is an _inexact_ zero (0.0 or -0.0), per R6RS.
+Previously, such numbers were immediately changed into inexact reals.
+
+(real? 0.0+0.0i) now returns #f, per R6RS, although (zero? 0.0+0.0i)
+still returns #t, per R6RS. (= 0 0.0+0.0i) and (= 0.0 0.0+0.0i) are
+#t, but the same comparisons using `eqv?' or `equal?' are #f.
+
+Like other non-real numbers, these complex numbers with inexact zero
+imaginary part will raise exceptions is passed to procedures requiring
+reals, such as `<', `>', `<=', `>=', `min', `max', `positive?',
+`negative?', `inf?', `nan?', `finite?', etc.
+
+**** `make-rectangular' changes
+
+scm_make_rectangular `make-rectangular' now returns a real number only
+if the imaginary part is an _exact_ 0. Previously, it would return a
+real number if the imaginary part was an inexact zero.
+
+scm_c_make_rectangular now always returns a non-real complex number,
+even if the imaginary part is zero. Previously, it would return a
+real number if the imaginary part was zero.
+
+**** `make-polar' changes
+
+scm_make_polar `make-polar' now returns a real number only if the
+angle or magnitude is an _exact_ 0. If the magnitude is an exact 0,
+it now returns an exact 0. Previously, it would return a real
+number if the imaginary part was an inexact zero.
+
+scm_c_make_polar now always returns a non-real complex number, even if
+the imaginary part is 0.0. Previously, it would return a real number
+if the imaginary part was 0.0.
+
+**** `imag-part' changes
+
+scm_imag_part `imag-part' now returns an exact 0 if applied to an
+inexact real number. Previously it returned an inexact zero in this
+case.
+
*** `eqv?' and `equal?' now compare numbers equivalently
scm_equal_p `equal?' now behaves equivalently to scm_eqv_p `eqv?' for
@@ -193,6 +235,13 @@ was at least 1 or inexact, e.g. (rationalize 4 1) should
return 3 per
R5RS and R6RS, but previously it returned 4. It also now handles
cases involving infinities and NaNs properly, per R6RS.
+*** Trigonometric functions now return exact numbers in some cases
+
+scm_sin `sin', scm_cos `cos', scm_tan `tan', scm_asin `asin', scm_acos
+`acos', scm_atan `atan', scm_sinh `sinh', scm_cosh `cosh', scm_tanh
+`tanh', scm_sys_asinh `asinh', scm_sys_acosh `acosh', and
+scm_sys_atanh `atanh' now return exact results in some cases.
+
*** New procedure: `finite?'
Add scm_finite_p `finite?' from R6RS to guile core, which returns #t
diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index 1ce9e1e..9b065a5 100755
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -683,11 +683,15 @@ angle,
-1@@1.57079 @result{} 0.0-1.0i (approx)
@end lisp
-Guile represents a complex number with a non-zero imaginary part as a
-pair of inexact rationals, so the real and imaginary parts of a
-complex number have the same properties of inexactness and limited
-precision as single inexact rational numbers. Guile can not represent
-exact complex numbers with non-zero imaginary parts.
+Guile represents a complex number as a pair of inexact reals, so the
+real and imaginary parts of a complex number have the same properties of
+inexactness and limited precision as single inexact real numbers.
+
+Note that each part of a complex number may contain any inexact real
+value, including the special values @samp{+nan.0}, @samp{+inf.0} and
address@hidden, as well as either of the signed zeroes @samp{0.0} or
address@hidden
+
@deffn {Scheme Procedure} complex? z
@deffnx {C Function} scm_complex_p (z)
@@ -1077,10 +1081,10 @@ locale-dependent parsing).
Return a complex number constructed of the given @var{real-part} and
@var{imaginary-part} parts.
@end deffn
address@hidden {Scheme Procedure} make-polar x y
address@hidden {C Function} scm_make_polar (x, y)
address@hidden {Scheme Procedure} make-polar mag ang
address@hidden {C Function} scm_make_polar (mag, ang)
@cindex polar form
-Return the complex number @var{x} * e^(i * @var{y}).
+Return the complex number @var{mag} * e^(i * @var{ang}).
@end deffn
@c begin (texi-doc-string "guile" "real-part")
diff --git a/libguile/numbers.c b/libguile/numbers.c
index f9e00e6..18d5755 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -22,10 +22,10 @@
/* General assumptions:
- * All objects satisfying SCM_COMPLEXP() have a non-zero complex component.
* All objects satisfying SCM_BIGP() are too large to fit in a fixnum.
* If an object satisfies integer?, it's either an inum, a bignum, or a real.
* If floor (r) == r, r is an int, and mpz_set_d will DTRT.
+ * XXX What about infinities? They are equal to their own floor! -mhw
* All objects satisfying SCM_FRACTIONP are never an integer.
*/
@@ -498,6 +498,14 @@ scm_i_fraction2double (SCM z)
SCM_FRACTION_DENOMINATOR (z)));
}
+static int
+double_is_non_negative_zero (double x)
+{
+ static double zero = 0.0;
+
+ return !memcmp (&x, &zero, sizeof(double));
+}
+
SCM_PRIMITIVE_GENERIC (scm_exact_p, "exact?", 1, 0, 0,
(SCM x),
"Return @code{#t} if @var{x} is an exact number, @code{#f}\n"
@@ -737,6 +745,18 @@ SCM_PRIMITIVE_GENERIC (scm_abs, "abs", 1, 0, 0,
else
return scm_i_inum2big (-xx);
}
+ else if (SCM_LIKELY (SCM_REALP (x)))
+ {
+ double xx = SCM_REAL_VALUE (x);
+ /* If x is a NaN then xx<0 is false so we return x unchanged */
+ if (xx < 0.0)
+ return scm_from_double (-xx);
+ /* Handle signed zeroes properly */
+ else if (SCM_UNLIKELY (xx == 0.0))
+ return flo0;
+ else
+ return x;
+ }
else if (SCM_BIGP (x))
{
const int sgn = mpz_sgn (SCM_I_BIG_MPZ (x));
@@ -745,15 +765,6 @@ SCM_PRIMITIVE_GENERIC (scm_abs, "abs", 1, 0, 0,
else
return x;
}
- else if (SCM_REALP (x))
- {
- /* note that if x is a NaN then xx<0 is false so we return x unchanged */
- double xx = SCM_REAL_VALUE (x);
- if (xx < 0.0)
- return scm_from_double (-xx);
- else
- return x;
- }
else if (SCM_FRACTIONP (x))
{
if (scm_is_false (scm_negative_p (SCM_FRACTION_NUMERATOR (x))))
@@ -3638,17 +3649,20 @@ static size_t
icmplx2str (double real, double imag, char *str, int radix)
{
size_t i;
+ double sgn;
i = idbl2str (real, str, radix);
- if (imag != 0.0)
- {
- /* Don't output a '+' for negative numbers or for Inf and
- NaN. They will provide their own sign. */
- if (0 <= imag && !isinf (imag) && !isnan (imag))
- str[i++] = '+';
- i += idbl2str (imag, &str[i], radix);
- str[i++] = 'i';
- }
+#ifdef HAVE_COPYSIGN
+ sgn = copysign (1.0, imag);
+#else
+ sgn = imag;
+#endif
+ /* Don't output a '+' for negative numbers or for Inf and
+ NaN. They will provide their own sign. */
+ if (sgn >= 0 && DOUBLE_IS_FINITE (imag))
+ str[i++] = '+';
+ i += idbl2str (imag, &str[i], radix);
+ str[i++] = 'i';
return i;
}
@@ -4195,7 +4209,7 @@ mem2ureal (SCM mem, unsigned int *p_idx,
floating point value so that we can change its sign.
*/
if (scm_is_eq (result, SCM_INUM0) && *p_exactness == INEXACT)
- result = scm_from_double (0.0);
+ result = flo0;
return result;
}
@@ -5148,9 +5162,19 @@ scm_max (SCM x, SCM y)
}
else if (SCM_REALP (y))
{
- double z = xx;
- /* if y==NaN then ">" is false and we return NaN */
- return (z > SCM_REAL_VALUE (y)) ? scm_from_double (z) : y;
+ double xxd = xx;
+ double yyd = SCM_REAL_VALUE (y);
+
+ if (xxd > yyd)
+ return scm_from_double (xxd);
+ /* If y is a NaN, then "==" is false and we return the NaN */
+ else if (SCM_LIKELY (!(xxd == yyd)))
+ return y;
+ /* Handle signed zeroes properly */
+ else if (xx == 0)
+ return flo0;
+ else
+ return y;
}
else if (SCM_FRACTIONP (y))
{
@@ -5194,9 +5218,20 @@ scm_max (SCM x, SCM y)
{
if (SCM_I_INUMP (y))
{
- double z = SCM_I_INUM (y);
- /* if x==NaN then "<" is false and we return NaN */
- return (SCM_REAL_VALUE (x) < z) ? scm_from_double (z) : x;
+ scm_t_inum yy = SCM_I_INUM (y);
+ double xxd = SCM_REAL_VALUE (x);
+ double yyd = yy;
+
+ if (yyd > xxd)
+ return scm_from_double (yyd);
+ /* If x is a NaN, then "==" is false and we return the NaN */
+ else if (SCM_LIKELY (!(xxd == yyd)))
+ return x;
+ /* Handle signed zeroes properly */
+ else if (yy == 0)
+ return flo0;
+ else
+ return x;
}
else if (SCM_BIGP (y))
{
@@ -5205,12 +5240,25 @@ scm_max (SCM x, SCM y)
}
else if (SCM_REALP (y))
{
- /* if x==NaN then our explicit check means we return NaN
- if y==NaN then ">" is false and we return NaN
- calling isnan is unavoidable, since it's the only way to know
- which of x or y causes any compares to be false */
double xx = SCM_REAL_VALUE (x);
- return (isnan (xx) || xx > SCM_REAL_VALUE (y)) ? x : y;
+ double yy = SCM_REAL_VALUE (y);
+
+ /* For purposes of max: +inf.0 > nan > everything else, per R6RS */
+ 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 (isinf (yy) == 1) ? y : x;
+ else if (SCM_UNLIKELY (isnan (yy)))
+ return (isinf (xx) == 1) ? x : y;
+ /* xx == yy, but handle signed zeroes properly */
+ else if (double_is_non_negative_zero (yy))
+ return y;
+ else
+ return x;
}
else if (SCM_FRACTIONP (y))
{
@@ -5234,7 +5282,8 @@ scm_max (SCM x, SCM y)
else if (SCM_REALP (y))
{
double xx = scm_i_fraction2double (x);
- return (xx < SCM_REAL_VALUE (y)) ? y : scm_from_double (xx);
+ /* if y==NaN then ">" is false, so we return the NaN y */
+ return (xx > SCM_REAL_VALUE (y)) ? scm_from_double (xx) : y;
}
else if (SCM_FRACTIONP (y))
{
@@ -5351,12 +5400,25 @@ scm_min (SCM x, SCM y)
}
else if (SCM_REALP (y))
{
- /* if x==NaN then our explicit check means we return NaN
- if y==NaN then "<" is false and we return NaN
- calling isnan is unavoidable, since it's the only way to know
- which of x or y causes any compares to be false */
double xx = SCM_REAL_VALUE (x);
- return (isnan (xx) || xx < SCM_REAL_VALUE (y)) ? x : y;
+ double yy = SCM_REAL_VALUE (y);
+
+ /* For purposes of min: -inf.0 < nan < everything else, per R6RS */
+ 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 (isinf (yy) == -1) ? y : x;
+ else if (SCM_UNLIKELY (isnan (yy)))
+ return (isinf (xx) == -1) ? x : y;
+ /* xx == yy, but handle signed zeroes properly */
+ else if (double_is_non_negative_zero (xx))
+ return y;
+ else
+ return x;
}
else if (SCM_FRACTIONP (y))
{
@@ -5380,7 +5442,8 @@ scm_min (SCM x, SCM y)
else if (SCM_REALP (y))
{
double xx = scm_i_fraction2double (x);
- return (SCM_REAL_VALUE (y) < xx) ? y : scm_from_double (xx);
+ /* if y==NaN then "<" is false, so we return the NaN y */
+ return (xx < SCM_REAL_VALUE (y)) ? scm_from_double (xx) : y;
}
else if (SCM_FRACTIONP (y))
{
@@ -5701,13 +5764,35 @@ scm_difference (SCM x, SCM y)
else if (SCM_REALP (y))
{
scm_t_inum xx = SCM_I_INUM (x);
- return scm_from_double (xx - SCM_REAL_VALUE (y));
+
+ /*
+ * We need to handle x == exact 0
+ * specially because R6RS states that:
+ * (- 0.0) ==> -0.0 and
+ * (- 0.0 0.0) ==> 0.0
+ * and the scheme compiler changes
+ * (- 0.0) into (- 0 0.0)
+ * So we need to treat (- 0 0.0) like (- 0.0).
+ * At the C level, (-x) is different than (0.0 - x).
+ * (0.0 - 0.0) ==> 0.0, but (- 0.0) ==> -0.0.
+ */
+ if (xx == 0)
+ return scm_from_double (- SCM_REAL_VALUE (y));
+ else
+ return scm_from_double (xx - SCM_REAL_VALUE (y));
}
else if (SCM_COMPLEXP (y))
{
scm_t_inum xx = SCM_I_INUM (x);
- return scm_c_make_rectangular (xx - SCM_COMPLEX_REAL (y),
- - SCM_COMPLEX_IMAG (y));
+
+ /* We need to handle x == exact 0 specially.
+ See the comment above (for SCM_REALP (y)) */
+ if (xx == 0)
+ return scm_c_make_rectangular (- SCM_COMPLEX_REAL (y),
+ - SCM_COMPLEX_IMAG (y));
+ else
+ return scm_c_make_rectangular (xx - SCM_COMPLEX_REAL (y),
+ - SCM_COMPLEX_IMAG (y));
}
else if (SCM_FRACTIONP (y))
/* a - b/c = (ac - b) / c */
@@ -6744,7 +6829,9 @@ SCM_PRIMITIVE_GENERIC (scm_sin, "sin", 1, 0, 0,
"Compute the sine of @var{z}.")
#define FUNC_NAME s_scm_sin
{
- if (scm_is_real (z))
+ if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM0)))
+ return z; /* sin(exact0) = exact0 */
+ else if (scm_is_real (z))
return scm_from_double (sin (scm_to_double (z)));
else if (SCM_COMPLEXP (z))
{ double x, y;
@@ -6763,7 +6850,9 @@ SCM_PRIMITIVE_GENERIC (scm_cos, "cos", 1, 0, 0,
"Compute the cosine of @var{z}.")
#define FUNC_NAME s_scm_cos
{
- if (scm_is_real (z))
+ if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM0)))
+ return SCM_INUM1; /* cos(exact0) = exact1 */
+ else if (scm_is_real (z))
return scm_from_double (cos (scm_to_double (z)));
else if (SCM_COMPLEXP (z))
{ double x, y;
@@ -6782,7 +6871,9 @@ SCM_PRIMITIVE_GENERIC (scm_tan, "tan", 1, 0, 0,
"Compute the tangent of @var{z}.")
#define FUNC_NAME s_scm_tan
{
- if (scm_is_real (z))
+ if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM0)))
+ return z; /* tan(exact0) = exact0 */
+ else if (scm_is_real (z))
return scm_from_double (tan (scm_to_double (z)));
else if (SCM_COMPLEXP (z))
{ double x, y, w;
@@ -6805,7 +6896,9 @@ SCM_PRIMITIVE_GENERIC (scm_sinh, "sinh", 1, 0, 0,
"Compute the hyperbolic sine of @var{z}.")
#define FUNC_NAME s_scm_sinh
{
- if (scm_is_real (z))
+ if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM0)))
+ return z; /* sinh(exact0) = exact0 */
+ else if (scm_is_real (z))
return scm_from_double (sinh (scm_to_double (z)));
else if (SCM_COMPLEXP (z))
{ double x, y;
@@ -6824,7 +6917,9 @@ SCM_PRIMITIVE_GENERIC (scm_cosh, "cosh", 1, 0, 0,
"Compute the hyperbolic cosine of @var{z}.")
#define FUNC_NAME s_scm_cosh
{
- if (scm_is_real (z))
+ if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM0)))
+ return SCM_INUM1; /* cosh(exact0) = exact1 */
+ else if (scm_is_real (z))
return scm_from_double (cosh (scm_to_double (z)));
else if (SCM_COMPLEXP (z))
{ double x, y;
@@ -6843,7 +6938,9 @@ SCM_PRIMITIVE_GENERIC (scm_tanh, "tanh", 1, 0, 0,
"Compute the hyperbolic tangent of @var{z}.")
#define FUNC_NAME s_scm_tanh
{
- if (scm_is_real (z))
+ if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM0)))
+ return z; /* tanh(exact0) = exact0 */
+ else if (scm_is_real (z))
return scm_from_double (tanh (scm_to_double (z)));
else if (SCM_COMPLEXP (z))
{ double x, y, w;
@@ -6866,7 +6963,9 @@ SCM_PRIMITIVE_GENERIC (scm_asin, "asin", 1, 0, 0,
"Compute the arc sine of @var{z}.")
#define FUNC_NAME s_scm_asin
{
- if (scm_is_real (z))
+ if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM0)))
+ return z; /* asin(exact0) = exact0 */
+ else if (scm_is_real (z))
{
double w = scm_to_double (z);
if (w >= -1.0 && w <= 1.0)
@@ -6892,7 +6991,9 @@ SCM_PRIMITIVE_GENERIC (scm_acos, "acos", 1, 0, 0,
"Compute the arc cosine of @var{z}.")
#define FUNC_NAME s_scm_acos
{
- if (scm_is_real (z))
+ if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM1)))
+ return SCM_INUM0; /* acos(exact1) = exact0 */
+ else if (scm_is_real (z))
{
double w = scm_to_double (z);
if (w >= -1.0 && w <= 1.0)
@@ -6924,7 +7025,9 @@ SCM_PRIMITIVE_GENERIC (scm_atan, "atan", 1, 1, 0,
{
if (SCM_UNBNDP (y))
{
- if (scm_is_real (z))
+ if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM0)))
+ return z; /* atan(exact0) = exact0 */
+ else if (scm_is_real (z))
return scm_from_double (atan (scm_to_double (z)));
else if (SCM_COMPLEXP (z))
{
@@ -6955,7 +7058,9 @@ SCM_PRIMITIVE_GENERIC (scm_sys_asinh, "asinh", 1, 0, 0,
"Compute the inverse hyperbolic sine of @var{z}.")
#define FUNC_NAME s_scm_sys_asinh
{
- if (scm_is_real (z))
+ if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM0)))
+ return z; /* asinh(exact0) = exact0 */
+ else if (scm_is_real (z))
return scm_from_double (asinh (scm_to_double (z)));
else if (scm_is_number (z))
return scm_log (scm_sum (z,
@@ -6971,7 +7076,9 @@ SCM_PRIMITIVE_GENERIC (scm_sys_acosh, "acosh", 1, 0, 0,
"Compute the inverse hyperbolic cosine of @var{z}.")
#define FUNC_NAME s_scm_sys_acosh
{
- if (scm_is_real (z) && scm_to_double (z) >= 1.0)
+ if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM1)))
+ return SCM_INUM0; /* acosh(exact1) = exact0 */
+ else if (scm_is_real (z) && scm_to_double (z) >= 1.0)
return scm_from_double (acosh (scm_to_double (z)));
else if (scm_is_number (z))
return scm_log (scm_sum (z,
@@ -6987,7 +7094,9 @@ SCM_PRIMITIVE_GENERIC (scm_sys_atanh, "atanh", 1, 0, 0,
"Compute the inverse hyperbolic tangent of @var{z}.")
#define FUNC_NAME s_scm_sys_atanh
{
- if (scm_is_real (z) && scm_to_double (z) >= -1.0 && scm_to_double (z) <= 1.0)
+ if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM0)))
+ return z; /* atanh(exact0) = exact0 */
+ else if (scm_is_real (z) && scm_to_double (z) >= -1.0 && scm_to_double (z)
<= 1.0)
return scm_from_double (atanh (scm_to_double (z)));
else if (scm_is_number (z))
return scm_divide (scm_log (scm_divide (scm_sum (SCM_INUM1, z),
@@ -7001,19 +7110,14 @@ SCM_PRIMITIVE_GENERIC (scm_sys_atanh, "atanh", 1, 0, 0,
SCM
scm_c_make_rectangular (double re, double im)
{
- if (im == 0.0)
- return scm_from_double (re);
- else
- {
- SCM z;
+ SCM z;
- z = PTR2SCM (scm_gc_malloc_pointerless (sizeof (scm_t_complex),
- "complex"));
- SCM_SET_CELL_TYPE (z, scm_tc16_complex);
- SCM_COMPLEX_REAL (z) = re;
- SCM_COMPLEX_IMAG (z) = im;
- return z;
- }
+ z = PTR2SCM (scm_gc_malloc_pointerless (sizeof (scm_t_complex),
+ "complex"));
+ SCM_SET_CELL_TYPE (z, scm_tc16_complex);
+ SCM_COMPLEX_REAL (z) = re;
+ SCM_COMPLEX_IMAG (z) = im;
+ return z;
}
SCM_DEFINE (scm_make_rectangular, "make-rectangular", 2, 0, 0,
@@ -7026,8 +7130,13 @@ SCM_DEFINE (scm_make_rectangular, "make-rectangular", 2,
0, 0,
SCM_ARG1, FUNC_NAME, "real");
SCM_ASSERT_TYPE (scm_is_real (imaginary_part), imaginary_part,
SCM_ARG2, FUNC_NAME, "real");
- return scm_c_make_rectangular (scm_to_double (real_part),
- scm_to_double (imaginary_part));
+
+ /* Return a real if and only if the imaginary_part is an _exact_ 0 */
+ if (scm_is_eq (imaginary_part, SCM_INUM0))
+ return real_part;
+ else
+ return scm_c_make_rectangular (scm_to_double (real_part),
+ scm_to_double (imaginary_part));
}
#undef FUNC_NAME
@@ -7050,13 +7159,21 @@ scm_c_make_polar (double mag, double ang)
}
SCM_DEFINE (scm_make_polar, "make-polar", 2, 0, 0,
- (SCM x, SCM y),
- "Return the complex number @var{x} * e^(i * @var{y}).")
+ (SCM mag, SCM ang),
+ "Return the complex number @var{mag} * e^(i * @var{ang}).")
#define FUNC_NAME s_scm_make_polar
{
- SCM_ASSERT_TYPE (scm_is_real (x), x, SCM_ARG1, FUNC_NAME, "real");
- SCM_ASSERT_TYPE (scm_is_real (y), y, SCM_ARG2, FUNC_NAME, "real");
- return scm_c_make_polar (scm_to_double (x), scm_to_double (y));
+ SCM_ASSERT_TYPE (scm_is_real (mag), mag, SCM_ARG1, FUNC_NAME, "real");
+ SCM_ASSERT_TYPE (scm_is_real (ang), ang, SCM_ARG2, FUNC_NAME, "real");
+
+ /* If mag is exact0, return exact0 */
+ if (scm_is_eq (mag, SCM_INUM0))
+ return SCM_INUM0;
+ /* Return a real if ang is exact0 */
+ else if (scm_is_eq (ang, SCM_INUM0))
+ return mag;
+ else
+ return scm_c_make_polar (scm_to_double (mag), scm_to_double (ang));
}
#undef FUNC_NAME
@@ -7083,9 +7200,7 @@ SCM_PRIMITIVE_GENERIC (scm_imag_part, "imag-part", 1, 0,
0,
{
if (SCM_COMPLEXP (z))
return scm_from_double (SCM_COMPLEX_IMAG (z));
- else if (SCM_REALP (z))
- return flo0;
- else if (SCM_I_INUMP (z) || SCM_BIGP (z) || SCM_FRACTIONP (z))
+ else if (SCM_I_INUMP (z) || SCM_REALP (z) || SCM_BIGP (z) || SCM_FRACTIONP
(z))
return SCM_INUM0;
else
SCM_WTA_DISPATCH_1 (g_scm_imag_part, z, SCM_ARG1, s_scm_imag_part);
@@ -7238,11 +7353,20 @@ SCM_PRIMITIVE_GENERIC (scm_inexact_to_exact,
"inexact->exact", 1, 0, 0,
"Return an exact number that is numerically closest to @var{z}.")
#define FUNC_NAME s_scm_inexact_to_exact
{
- if (SCM_I_INUMP (z) || SCM_BIGP (z))
+ if (SCM_I_INUMP (z) || SCM_BIGP (z) || SCM_FRACTIONP (z))
return z;
- else if (SCM_REALP (z))
+ else
{
- if (!DOUBLE_IS_FINITE (SCM_REAL_VALUE (z)))
+ double val;
+
+ if (SCM_REALP (z))
+ val = SCM_REAL_VALUE (z);
+ else if (SCM_COMPLEXP (z) && SCM_COMPLEX_IMAG (z) == 0.0)
+ val = SCM_COMPLEX_REAL (z);
+ else
+ SCM_WTA_DISPATCH_1 (g_scm_inexact_to_exact, z, 1,
s_scm_inexact_to_exact);
+
+ if (!SCM_LIKELY (DOUBLE_IS_FINITE (val)))
SCM_OUT_OF_RANGE (1, z);
else
{
@@ -7250,9 +7374,9 @@ SCM_PRIMITIVE_GENERIC (scm_inexact_to_exact,
"inexact->exact", 1, 0, 0,
SCM q;
mpq_init (frac);
- mpq_set_d (frac, SCM_REAL_VALUE (z));
+ mpq_set_d (frac, val);
q = scm_i_make_ratio (scm_i_mpz2num (mpq_numref (frac)),
- scm_i_mpz2num (mpq_denref (frac)));
+ scm_i_mpz2num (mpq_denref (frac)));
/* When scm_i_make_ratio throws, we leak the memory allocated
for frac...
@@ -7261,10 +7385,6 @@ SCM_PRIMITIVE_GENERIC (scm_inexact_to_exact,
"inexact->exact", 1, 0, 0,
return q;
}
}
- else if (SCM_FRACTIONP (z))
- return z;
- else
- SCM_WTA_DISPATCH_1 (g_scm_inexact_to_exact, z, 1, s_scm_inexact_to_exact);
}
#undef FUNC_NAME
diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test
index 96fb6d9..96f37df 100644
--- a/test-suite/tests/numbers.test
+++ b/test-suite/tests/numbers.test
@@ -125,6 +125,14 @@
(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)
@@ -137,6 +145,12 @@
(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)
@@ -423,17 +437,23 @@
(with-test-prefix "abs"
(pass-if (documented? abs))
- (pass-if (zero? (abs 0)))
- (pass-if (= 1 (abs 1)))
- (pass-if (= 1 (abs -1)))
- (pass-if (= (+ fixnum-max 1) (abs (+ fixnum-max 1))))
- (pass-if (= (+ (- fixnum-min) 1) (abs (- fixnum-min 1))))
- (pass-if (= 0.0 (abs 0.0)))
- (pass-if (= 1.0 (abs 1.0)))
- (pass-if (= 1.0 (abs -1.0)))
- (pass-if (real-nan? (abs +nan.0)))
- (pass-if (= +inf.0 (abs +inf.0)))
- (pass-if (= +inf.0 (abs -inf.0))))
+ (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
@@ -1504,14 +1524,15 @@
;; * <digit 10>+ #+ . #* <suffix>
("3#." 30.0) ("3#.e0" 30.0) ("3#.#" 30.0) ("3#.#e0" 30.0)
;; Complex:
- ("address@hidden" 1.0) ("address@hidden" 1.0)
("address@hidden" 1.0)
+ ("address@hidden" 1) ("address@hidden" 1) ("address@hidden" 1)
+ ("address@hidden" 1.0+0i) ("address@hidden" 1+0.0i)
("address@hidden" 1.0-0i)
("2+3i" ,(+ 2 (* 3 +i))) ("4-5i" ,(- 4 (* 5 +i)))
("1+i" 1+1i) ("1-i" 1-1i) ("+1i" 0+1i) ("-1i" 0-1i)
("+i" +1i) ("-i" -1i)
("1.0+.1i" 1.0+0.1i)
("1.0-.1i" 1.0-0.1i)
- (".1+.0i" 0.1)
- ("1.+.0i" 1.0)
+ (".1+.0i" 0.1+0.0i)
+ ("1.+.0i" 1.0+0.0i)
(".1+.1i" 0.1+0.1i)
("1e1+.1i" 10+0.1i)
))
@@ -1637,6 +1658,8 @@
(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")))
@@ -1702,12 +1725,19 @@
(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))))
@@ -1772,12 +1802,21 @@
(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))))
@@ -1829,9 +1868,34 @@
(with-test-prefix "="
(pass-if (documented? =))
- (pass-if (= 0 0))
(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)))
@@ -2400,13 +2464,28 @@
(with-test-prefix "zero?"
(pass-if (documented? zero?))
- (pass-if (zero? 0))
- (pass-if (not (zero? 7)))
+
+ (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? 3.1+4.2i)))
+ (pass-if (not (zero? 1.0+0.0i)))
+ (pass-if (not (zero? 0.0-1.0i))))
;;;
;;; positive?
@@ -2471,26 +2550,79 @@
(big*5 (* fixnum-max 5)))
(with-test-prefix "inum / frac"
- (pass-if (= 3 (max 3 5/2)))
- (pass-if (= 5/2 (max 2 5/2))))
+ (pass-if (eqv? 3 (max 3 5/2)))
+ (pass-if (eqv? 5/2 (max 2 5/2))))
(with-test-prefix "frac / inum"
- (pass-if (= 3 (max 5/2 3)))
- (pass-if (= 5/2 (max 5/2 2))))
-
- (with-test-prefix "inum / real"
- (pass-if (real-nan? (max 123 +nan.0))))
-
- (with-test-prefix "real / inum"
- (pass-if (real-nan? (max +nan.0 123))))
+ (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 (= big*2 (max big*2 5/2)))
- (pass-if (= 5/2 (max (- big*2) 5/2))))
+ (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 (= big*2 (max 5/2 big*2)))
- (pass-if (= 5/2 (max 5/2 (- big*2)))))
+ (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)))
@@ -2507,29 +2639,29 @@
(pass-if (eqv? 1.0 (max 1.0 (- big*5)))))
(with-test-prefix "frac / frac"
- (pass-if (= 2/3 (max 1/2 2/3)))
- (pass-if (= 2/3 (max 2/3 1/2)))
- (pass-if (= -1/2 (max -1/2 -2/3)))
- (pass-if (= -1/2 (max -2/3 -1/2))))
+ (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 (= 456.0 (max 123.0 456.0)))
- (pass-if (= 456.0 (max 456.0 123.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)
- (= +inf.0 (max b +inf.0)))
+ (eqv? +inf.0 (max b +inf.0)))
(pass-if (list +inf.0 b)
- (= +inf.0 (max b +inf.0)))
+ (eqv? +inf.0 (max b +inf.0)))
(pass-if (list b -inf.0)
- (= (exact->inexact b) (max b -inf.0)))
+ (eqv? (exact->inexact b) (max b -inf.0)))
(pass-if (list -inf.0 b)
- (= (exact->inexact b) (max b -inf.0))))
+ (eqv? (exact->inexact b) (max b -inf.0))))
(list (1- (ash 1 1024))
(ash 1 1024)
(1+ (ash 1 1024))
@@ -2579,43 +2711,96 @@
(big*5 (* fixnum-max 5)))
(pass-if (documented? min))
- (pass-if (= 1 (min 7 3 1 5)))
- (pass-if (= 1 (min 1 7 3 5)))
- (pass-if (= 1 (min 7 3 5 1)))
- (pass-if (= -7 (min 2 3 4 -2 5 -7 1 -1 4 2)))
- (pass-if (= -7 (min -7 2 3 4 -2 5 1 -1 4 2)))
- (pass-if (= -7 (min 2 3 4 -2 5 1 -1 4 2 -7)))
- (pass-if (= big*2 (min big*3 big*5 big*2 big*4)))
- (pass-if (= big*2 (min big*2 big*3 big*5 big*4)))
- (pass-if (= big*2 (min big*3 big*5 big*4 big*2)))
+ (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
- (= (- fixnum-min 1) (min 2 4 (- fixnum-min 1) 3 (* 2 fixnum-max))))
+ (eqv? (- fixnum-min 1) (min 2 4 (- fixnum-min 1) 3 (* 2 fixnum-max))))
(pass-if
- (= (- fixnum-min 1) (min (- fixnum-min 1) 2 4 3 (* 2 fixnum-max))))
+ (eqv? (- fixnum-min 1) (min (- fixnum-min 1) 2 4 3 (* 2 fixnum-max))))
(pass-if
- (= (- fixnum-min 1) (min 2 4 3 (* 2 fixnum-max) (- fixnum-min 1))))
+ (eqv? (- fixnum-min 1) (min 2 4 3 (* 2 fixnum-max) (- fixnum-min 1))))
(with-test-prefix "inum / frac"
- (pass-if (= 5/2 (min 3 5/2)))
- (pass-if (= 2 (min 2 5/2))))
+ (pass-if (eqv? 5/2 (min 3 5/2)))
+ (pass-if (eqv? 2 (min 2 5/2))))
(with-test-prefix "frac / inum"
- (pass-if (= 5/2 (min 5/2 3)))
- (pass-if (= 2 (min 5/2 2))))
-
- (with-test-prefix "inum / real"
- (pass-if (real-nan? (min 123 +nan.0))))
-
- (with-test-prefix "real / inum"
- (pass-if (real-nan? (min +nan.0 123))))
+ (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 (= 5/2 (min big*2 5/2)))
- (pass-if (= (- big*2) (min (- big*2) 5/2))))
+ (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 (= 5/2 (min 5/2 big*2)))
- (pass-if (= (- big*2) (min 5/2 (- big*2)))))
+ (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)))
@@ -2632,30 +2817,30 @@
(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)))
- (pass-if (= 1/2 (min 2/3 1/2)))
- (pass-if (= -2/3 (min -1/2 -2/3)))
- (pass-if (= -2/3 (min -2/3 -1/2))))
+ (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 (= 123.0 (min 123.0 456.0)))
- (pass-if (= 123.0 (min 456.0 123.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)
- (= (exact->inexact b) (min b +inf.0)))
+ (eqv? (exact->inexact b) (min b +inf.0)))
(pass-if (list +inf.0 b)
- (= (exact->inexact b) (min b +inf.0)))
+ (eqv? (exact->inexact b) (min b +inf.0)))
(pass-if (list b -inf.0)
- (= -inf.0 (min b -inf.0)))
+ (eqv? -inf.0 (min b -inf.0)))
(pass-if (list -inf.0 b)
- (= -inf.0 (min b -inf.0))))
+ (eqv? -inf.0 (min b -inf.0))))
(list (1- (ash 1 1024))
(ash 1 1024)
(1+ (ash 1 1024))
@@ -2677,6 +2862,54 @@
(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)))
@@ -2708,6 +2941,55 @@
(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)))
@@ -2745,6 +3027,16 @@
(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 )))
@@ -2780,10 +3072,10 @@
(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 (real-nan? (* 0 +nan.0+i)))
- (pass-if (real-nan? (* +nan.0+i 0 )))
+ (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 )))
@@ -2830,13 +3122,13 @@
(pass-if (real-nan? (* 0 +inf.0 )))
(pass-if (real-nan? (* +inf.0 0 )))
- (pass-if (real-nan? (* 0 +inf.0+i)))
- (pass-if (real-nan? (* +inf.0+i 0 )))
-
(pass-if (real-nan? (* 0 -inf.0 )))
(pass-if (real-nan? (* -inf.0 0 )))
- (pass-if (real-nan? (* 0 -inf.0+i)))
- (pass-if (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 (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 )))
@@ -3305,7 +3597,7 @@
(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 (eqv? (* -1.0 12398 12398) (expt +12398i 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)))
@@ -3316,29 +3608,130 @@
;;;
+;;; 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 (asinh 0)))
+ (pass-if (= 0.0 (asinh 0.0))))
;;;
;;; acosh
;;;
(with-test-prefix "acosh"
- (pass-if (= 0 (acosh 1))))
+ (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 (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
@@ -3349,10 +3742,15 @@
(define (almost= x y)
(> 0.01 (magnitude (- x y))))
- (pass-if (= 0 (make-polar 0 0)))
- (pass-if (= 0 (make-polar 0 123.456)))
- (pass-if (= 1 (make-polar 1 0)))
- (pass-if (= -1 (make-polar -1 0)))
+ (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))))
@@ -3377,7 +3775,7 @@
(with-test-prefix "imag-part"
(pass-if (documented? imag-part))
- (pass-if (eqv? 0.0 (imag-part 5.0)))
+ (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)))
@@ -3469,7 +3867,7 @@
(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 (eqv? (* -1.0 12398 12398) (integer-expt +12398.0i 2))))
+ (pass-if (test-eqv? (* -1.0+0.0i 12398 12398) (integer-expt +12398.0i 2))))
;;;
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. release_1-9-14-179-gc721848,
Andy Wingo <=