mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Have log and log10(real nan) return real nan regardless of sign

Browse source 
* libguile/numbers.c (log_of_shifted_double, scm_log10): Avoid complex
  extension when the argument is a real nan.
* test-suite/tests/numbers.test: Tests for nans of either sign.
This commit is contained in:
Daniel Llorens 2022-01-10 13:26:00 +01:00 • committed by Andy Wingo
parent 4feff820be
commit 19bc021e34
2 changed files with 19 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

15
libguile/numbers.c
View file

@ -6967,12 +6967,12 @@ scm_is_number (SCM z)
static SCM
log_of_shifted_double (double x, long shift)
{
/* cf scm_log10 */
double ans = log (fabs (x)) + shift * M_LN2;
if (copysign (1.0, x) > 0.0)
return scm_i_from_double (ans);
else
if (signbit (x) && SCM_LIKELY (!isnan (x)))
return scm_c_make_rectangular (ans, M_PI);
else
return scm_i_from_double (ans);
}
/* Returns log(n), for exact integer n */
@ -7081,10 +7081,11 @@ SCM_PRIMITIVE_GENERIC (scm_log10, "log10", 1, 0, 0,
{
double re = scm_to_double (z);
double l = log10 (fabs (re));
if (copysign (1.0, re) > 0.0)
return scm_i_from_double (l);
else
/* cf log_of_shifted_double */
if (signbit (re) && SCM_LIKELY (!isnan (re)))
return scm_c_make_rectangular (l, M_LOG10E * M_PI);
else
return scm_i_from_double (l);
}
}
else if (SCM_BIGP (z))

11
test-suite/tests/numbers.test
View file

@ -21,7 +21,8 @@
#:use-module (ice-9 documentation)
#:autoload (system base compile) (compile)
#:use-module (srfi srfi-1) ; list library
#:use-module (srfi srfi-11)) ; let-values
#:use-module (srfi srfi-11) ; let-values
#:use-module (rnrs bytevectors))
;;;
;;; miscellaneous
@ -4762,6 +4763,10 @@
(pass-if-exception "(log 0)" exception:numerical-overflow
(log 0))
; result of log(nan) is real nan regardless of the sign of the nan.
(pass-if (test-eqv? +nan.0 (log (bytevector-ieee-double-ref #vu8(0 0 0 0 0 0 248 127) 0 'little))))
(pass-if (test-eqv? +nan.0 (log (bytevector-ieee-double-ref #vu8(0 0 0 0 0 0 248 255) 0 'little))))
(pass-if (test-eqv? -inf.0 (log 0.0)))
(pass-if (test-eqv? +inf.0 (log +inf.0)))
(pass-if (test-eqv? -inf.0+3.14159265358979i (log -0.0)))
@ -4811,6 +4816,10 @@
(pass-if-exception "(log10 0)" exception:numerical-overflow
(log10 0))
; result of log10(nan) is real nan regardless of the sign of the nan.
(pass-if (test-eqv? +nan.0 (log10 (bytevector-ieee-double-ref #vu8(0 0 0 0 0 0 248 127) 0 'little))))
(pass-if (test-eqv? +nan.0 (log10 (bytevector-ieee-double-ref #vu8(0 0 0 0 0 0 248 255) 0 'little))))
(pass-if (test-eqv? -inf.0 (log10 0.0)))
(pass-if (test-eqv? +inf.0 (log10 +inf.0)))
(pass-if (test-eqv? -inf.0+1.36437635384184i (log10 -0.0)))