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 <m...@netris.org> 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" + "3@inf.0" "4@nan.0")) #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