[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-157-g929d11b

[Mark H Weaver]

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=929d11b2c1e1060a51bf7e395ab0ddd48e599144

The branch, stable-2.0 has been updated
       via  929d11b2c1e1060a51bf7e395ab0ddd48e599144 (commit)
      from  aab9d46c83c2ad03abb0a2dc000167e552de2c29 (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 929d11b2c1e1060a51bf7e395ab0ddd48e599144
Author: Mark H Weaver <address@hidden>
Date:   Wed Mar 6 12:52:39 2013 -0500

    Improve standards conformance of string->number.
    
    Fixes <http://bugs.gnu.org/11887>.
    
    * libguile/numbers.c (mem2ureal): New argument 'allow_inf_or_nan'.
      Accept infinities and NaNs only if 'allow_inf_or_nan' is true and "#e"
      is not present.  Check for "inf.0" or "nan." case-insensitively.  Do
      not accept rationals with zero divisors.
    
      (mem2complex): Pass new 'allow_inf_or_nan' argument to 'mem2ureal',
      which is set if and only if a explicit sign was present.
    
    * test-suite/tests/numbers.test ("string->number"): Add tests.

-----------------------------------------------------------------------

Summary of changes:
 libguile/numbers.c            |   76 +++++++++++++++++++++++++++--------------
 test-suite/tests/numbers.test |   12 ++++++-
 2 files changed, 61 insertions(+), 27 deletions(-)

diff --git a/libguile/numbers.c b/libguile/numbers.c
index 393cf64..bb1ecf5 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -5749,7 +5749,8 @@ mem2decimal_from_point (SCM result, SCM mem,
 
 static SCM
 mem2ureal (SCM mem, unsigned int *p_idx,
-          unsigned int radix, enum t_exactness forced_x)
+          unsigned int radix, enum t_exactness forced_x,
+           int allow_inf_or_nan)
 {
   unsigned int idx = *p_idx;
   SCM result;
@@ -5762,30 +5763,53 @@ mem2ureal (SCM mem, unsigned int *p_idx,
   if (idx == len)
     return SCM_BOOL_F;
 
-  if (idx+5 <= len && !scm_i_string_strcmp (mem, idx, "inf.0"))
-    {
-      *p_idx = idx+5;
-      return scm_inf ();
-    }
-
-  if (idx+4 < len && !scm_i_string_strcmp (mem, idx, "nan."))
-    {
-      /* Cobble up the fractional part.  We might want to set the
-        NaN's mantissa from it. */
-      idx += 4;
-      if (!scm_is_eq (mem2uinteger (mem, &idx, 10, &implicit_x), SCM_INUM0))
-        {
+  if (allow_inf_or_nan && forced_x != EXACT && idx+5 <= len)
+    switch (scm_i_string_ref (mem, idx))
+      {
+      case 'i': case 'I':
+        switch (scm_i_string_ref (mem, idx + 1))
+          {
+          case 'n': case 'N':
+            switch (scm_i_string_ref (mem, idx + 2))
+              {
+              case 'f': case 'F':
+                if (scm_i_string_ref (mem, idx + 3) == '.'
+                    && scm_i_string_ref (mem, idx + 4) == '0')
+                  {
+                    *p_idx = idx+5;
+                    return scm_inf ();
+                  }
+              }
+          }
+      case 'n': case 'N':
+        switch (scm_i_string_ref (mem, idx + 1))
+          {
+          case 'a': case 'A':
+            switch (scm_i_string_ref (mem, idx + 2))
+              {
+              case 'n': case 'N':
+                if (scm_i_string_ref (mem, idx + 3) == '.')
+                  {
+                    /* Cobble up the fractional part.  We might want to
+                       set the NaN's mantissa from it. */
+                    idx += 4;
+                    if (!scm_is_eq (mem2uinteger (mem, &idx, 10, &implicit_x),
+                                    SCM_INUM0))
+                      {
 #if SCM_ENABLE_DEPRECATED == 1
-          scm_c_issue_deprecation_warning
-            ("Non-zero suffixes to `+nan.' are deprecated.  Use `+nan.0'.");
+                        scm_c_issue_deprecation_warning
+                          ("Non-zero suffixes to `+nan.' are deprecated.  Use 
`+nan.0'.");
 #else
-          return SCM_BOOL_F;
+                        return SCM_BOOL_F;
 #endif
-        }
+                      }
           
-      *p_idx = idx;
-      return scm_nan ();
-    }
+                    *p_idx = idx;
+                    return scm_nan ();
+                  }
+              }
+          }
+      }
 
   if (scm_i_string_ref (mem, idx) == '.')
     {
@@ -5818,7 +5842,7 @@ mem2ureal (SCM mem, unsigned int *p_idx,
             return SCM_BOOL_F;
 
          divisor = mem2uinteger (mem, &idx, radix, &implicit_x);
-         if (scm_is_false (divisor))
+         if (scm_is_false (divisor) || scm_is_eq (divisor, SCM_INUM0))
            return SCM_BOOL_F;
 
          /* both are int/big here, I assume */
@@ -5894,7 +5918,7 @@ mem2complex (SCM mem, unsigned int idx,
   if (idx == len)
     return SCM_BOOL_F;
 
-  ureal = mem2ureal (mem, &idx, radix, forced_x);
+  ureal = mem2ureal (mem, &idx, radix, forced_x, sign != 0);
   if (scm_is_false (ureal))
     {
       /* input must be either +i or -i */
@@ -5963,9 +5987,9 @@ mem2complex (SCM mem, unsigned int idx,
                  sign = -1;
                }
              else
-               sign = 1;
+               sign = 0;
 
-             angle = mem2ureal (mem, &idx, radix, forced_x);
+             angle = mem2ureal (mem, &idx, radix, forced_x, sign != 0);
              if (scm_is_false (angle))
                return SCM_BOOL_F;
              if (idx != len)
@@ -5987,7 +6011,7 @@ mem2complex (SCM mem, unsigned int idx,
          else
            {
              int sign = (c == '+') ? 1 : -1;
-             SCM imag = mem2ureal (mem, &idx, radix, forced_x);
+             SCM imag = mem2ureal (mem, &idx, radix, forced_x, sign != 0);
 
              if (scm_is_false (imag))
                imag = SCM_I_MAKINUM (sign);
diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test
index 66aa01a..be378b7 100644
--- a/test-suite/tests/numbers.test
+++ b/test-suite/tests/numbers.test
@@ -1493,7 +1493,9 @@
                "#o.2" "3.4q" "15.16e17q" "18.19e+q" ".q" ".17#18" "10q" "#b2"
                "#b3" "#b4" "#b5" "#b6" "#b7" "#b8" "#b9" "#ba" "#bb" "#bc"
                "#bd" "#be" "#bf" "#q" "#b#b1" "#o#o1" "#d#d1" "#x#x1" "#e#e1"
-               "#i#i1" "address@hidden"))
+               "#i#i1" "address@hidden" "3/0" "0/0" "4+3/0i" "4/0-3i" "2+0/0i"
+                "nan.0" "inf.0" "#e+nan.0" "#e+inf.0" "#e-inf.0"
+                "address@hidden" "address@hidden"))
     #t)
 
   (pass-if "valid number strings"
@@ -1532,6 +1534,14 @@
                 ("1/1" 1) ("1/2" 1/2) ("-1/2" -1/2) ("1#/1" 10.0)
                 ("10/1#" 1.0) ("1#/1#" 1.0) ("#e9/10" 9/10) ("#e10/1#" 1)
                 ("#i6/8" 0.75) ("#i1/1" 1.0)
+                ;; Infinities and NaNs:
+                ("+inf.0" ,(inf)) ("-inf.0" ,(- (inf)))
+                ("+Inf.0" ,(inf)) ("-Inf.0" ,(- (inf)))
+                ("+InF.0" ,(inf)) ("-InF.0" ,(- (inf)))
+                ("+INF.0" ,(inf)) ("-INF.0" ,(- (inf)))
+                ("#i+InF.0" ,(inf)) ("#i-InF.0" ,(- (inf)))
+                ("+nan.0" ,(nan)) ("-nan.0" ,(nan))
+                ("#i+nan.0" ,(nan)) ("#i-nan.0" ,(nan))
                 ;; Decimal numbers:
                 ;; * <uinteger 10> <suffix>
                 ("1e2" 100.0) ("1E2" 100.0) ("1s2" 100.0) ("1S2" 100.0)


hooks/post-receive
-- 
GNU Guile