mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00
Code Activity

Improve standards conformance of string->number.

Browse source 
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.
This commit is contained in:
Mark H Weaver 2013-03-06 12:52:39 -05:00
parent aab9d46c83
commit 929d11b2c1
2 changed files with 61 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

76
libguile/numbers.c
View file

@ -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);

12
test-suite/tests/numbers.test
View file

@ -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)