[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#11887: [PATCH] Improve standards conformance of string->number (was
|
From: |
Mark H Weaver |
|
Subject: |
bug#11887: [PATCH] Improve standards conformance of string->number (was Re: bug#11887: string->number edge cases) |
|
Date: |
Wed, 06 Mar 2013 13:15:42 -0500 |
|
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/24.3 (gnu/linux) |
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 <address@hidden>
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" "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)
--
1.7.10.4