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

17
libguile/numbers.c
View file

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

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

@ -21,7 +21,8 @@
#:use-module (ice-9 documentation) #:use-module (ice-9 documentation)
#:autoload (system base compile) (compile) #:autoload (system base compile) (compile)
#:use-module (srfi srfi-1) ; list library #: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 ;;; miscellaneous
@ -4762,6 +4763,10 @@
(pass-if-exception "(log 0)" exception:numerical-overflow (pass-if-exception "(log 0)" exception:numerical-overflow
(log 0)) (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 0.0)))
(pass-if (test-eqv? +inf.0 (log +inf.0))) (pass-if (test-eqv? +inf.0 (log +inf.0)))
(pass-if (test-eqv? -inf.0+3.14159265358979i (log -0.0))) (pass-if (test-eqv? -inf.0+3.14159265358979i (log -0.0)))
@ -4811,6 +4816,10 @@
(pass-if-exception "(log10 0)" exception:numerical-overflow (pass-if-exception "(log10 0)" exception:numerical-overflow
(log10 0)) (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 0.0)))
(pass-if (test-eqv? +inf.0 (log10 +inf.0))) (pass-if (test-eqv? +inf.0 (log10 +inf.0)))
(pass-if (test-eqv? -inf.0+1.36437635384184i (log10 -0.0))) (pass-if (test-eqv? -inf.0+1.36437635384184i (log10 -0.0)))