Subject: bug#11887: [PATCH] Improve standards conformance of string->number (was Re: bug#11887: string->number edge cases)

From: Mark H Weaver <[email-masked]>
Date: Wed, 06 Mar 2013 13:15:42 -0500

Here's a patch to fix these problems.  Comments and suggestions welcome.

    Mark

>From a1926777b03445d397bb1069b325d243e765f84b Mon Sep 17 00:00:00 2001
From: Mark H Weaver <[email-masked]>
Date: Wed, 6 Mar 2013 12:52:39 -0500
Subject: [PATCH] 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.
---
 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 66c95db..f9538f5 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -5740,7 +5740,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;
@@ -5753,30 +5754,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) == '.')
     {
@@ -5809,7 +5833,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 */
@@ -5885,7 +5909,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 */
@@ -5954,9 +5978,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)
@@ -5978,7 +6002,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" "12@12+0i"))
+		"#i#i1" "12@12+0i" "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"
+                "[email-masked]" "[email-masked]"))
     #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)
-- 
1.7.10.4