[Guile-commits] 84/85: Have log and log10(real nan) return real nan regardless of sign

[Andy Wingo]

wingo pushed a commit to branch main
in repository guile.

commit 19bc021e349f4aaff53daa42032025929ee1c0f2
Author: Daniel Llorens <lloda@sarc.name>
AuthorDate: Mon Jan 10 13:26:00 2022 +0100

    Have log and log10(real nan) return real nan regardless of sign
    
    * 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.
---
 libguile/numbers.c            | 17 +++++++++--------
 test-suite/tests/numbers.test | 11 ++++++++++-
 2 files changed, 19 insertions(+), 9 deletions(-)

diff --git a/libguile/numbers.c b/libguile/numbers.c
index 83fe027a9..4417f861f 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -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
-         return scm_c_make_rectangular (l, M_LOG10E * M_PI);
+        /* 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))
diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test
index 51263f0ac..0b80c0356 100644
--- a/test-suite/tests/numbers.test
+++ b/test-suite/tests/numbers.test
@@ -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)))