>From 031d60903ca677e982cfaf282914f9f59ddab0ea Mon Sep 17 00:00:00 2001 From: Peter Bex
Date: Fri, 23 Mar 2012 23:06:17 +0100 Subject: [PATCH] Add a few more number syntax tests from John Cowan and fix these cases. Furthermore, string->number shouldn't raise errors but return #f if given a number we can't represent. Finally, fix C_i_finitep for nan values and add entries for it to the library tests (without this the numbers test won't succeed) --- chicken.h | 7 ++++++- library.scm | 5 ++++- runtime.c | 27 ++++++++++++++++++--------- tests/library-tests.scm | 17 +++++++++++------ tests/numbers-string-conversion-tests.scm | 24 +++++++++++++++++++++++- 5 files changed, 62 insertions(+), 18 deletions(-) diff --git a/chicken.h b/chicken.h index cd73152..8b1d751 100644 --- a/chicken.h +++ b/chicken.h @@ -2224,8 +2224,13 @@ C_inline C_word C_i_flonump(C_word x) C_inline C_word C_i_finitep(C_word x) { + double val; + if((x & C_FIXNUM_BIT) != 0) return C_SCHEME_TRUE; - else return C_mk_bool(!C_isinf(C_flonum_magnitude(x))); + + val = C_flonum_magnitude(x); + if(C_isnan(val) || C_isinf(val)) return C_SCHEME_FALSE; + else return C_SCHEME_TRUE; } diff --git a/library.scm b/library.scm index cc84da1..c85c98a 100644 --- a/library.scm +++ b/library.scm @@ -1083,7 +1083,10 @@ EOF (let ((num (##core#inline_allocate ("C_a_i_string_to_number" 4) str radix))) (case exactness ((i) (##core#inline_allocate ("C_a_i_exact_to_inexact" 4) num)) - ((e) (##core#inline "C_i_inexact_to_exact" num)) + ;; If inf/nan, don't error but just return #f + ((e) (and num + (##core#inline "C_i_finitep" num) + (##core#inline "C_i_inexact_to_exact" num))) (else num)))) (define string->number ##sys#string->number) diff --git a/runtime.c b/runtime.c index ef8cf8e..1166049 100644 --- a/runtime.c +++ b/runtime.c @@ -475,6 +475,7 @@ static C_word C_fcall hash_string(int len, C_char *str, C_word m, C_word r, int static C_word C_fcall lookup(C_word key, int len, C_char *str, C_SYMBOL_TABLE *stable) C_regparm; static double compute_symbol_table_load(double *avg_bucket_len, int *total); static C_word C_fcall convert_string_to_number(C_char *str, int radix, C_word *fix, double *flo) C_regparm; +static C_word C_fcall C_i_maybe_inexact_to_exact(C_word n) C_regparm; static void C_fcall remark_system_globals(void) C_regparm; static void C_fcall really_remark(C_word *x) C_regparm; static C_word C_fcall intern0(C_char *name) C_regparm; @@ -4966,22 +4967,30 @@ C_regparm C_word C_fcall C_u_i_length(C_word lst) return C_fix(n); } - -C_regparm C_word C_fcall C_i_inexact_to_exact(C_word n) +C_regparm C_word C_i_maybe_inexact_to_exact(C_word n) { double m; C_word r; - - if(n & C_FIXNUM_BIT) return n; - else if(C_immediatep(n) || C_block_header(n) != C_FLONUM_TAG) - barf(C_BAD_ARGUMENT_TYPE_ERROR, "inexact->exact", n); - + if(modf(C_flonum_magnitude(n), &m) == 0.0) { r = (C_word)m; if(r == m && C_fitsinfixnump(r)) return C_fix(r); } + return C_SCHEME_FALSE; +} + +C_regparm C_word C_fcall C_i_inexact_to_exact(C_word n) +{ + C_word r; + + if(n & C_FIXNUM_BIT) return n; + else if(C_immediatep(n) || C_block_header(n) != C_FLONUM_TAG) + barf(C_BAD_ARGUMENT_TYPE_ERROR, "inexact->exact", n); + + r = C_i_maybe_inexact_to_exact(n); + if (r != C_SCHEME_FALSE) return r; barf(C_CANT_REPRESENT_INEXACT_ERROR, "inexact->exact", n); return 0; @@ -7336,7 +7345,7 @@ C_a_i_string_to_number(C_word **a, int c, C_word str, C_word radix0) if(sharpf || ratf || (exactpf && !exactf)) { n = C_flonum(a, ratf ? fn1 / (double)n : (double)n); - if(exactpf && exactf) n = C_i_inexact_to_exact(n); + if(exactpf && exactf) n = C_i_maybe_inexact_to_exact(n); } else n = C_fix(n); @@ -7345,7 +7354,7 @@ C_a_i_string_to_number(C_word **a, int c, C_word str, C_word radix0) case 2: /* flonum */ n = C_flonum(a, ratf ? fn1 / fn : fn); - if(exactpf && exactf) n = C_i_inexact_to_exact(n); + if(exactpf && exactf) n = C_i_maybe_inexact_to_exact(n); break; } diff --git a/tests/library-tests.scm b/tests/library-tests.scm index 6e9fdad..f133f3f 100644 --- a/tests/library-tests.scm +++ b/tests/library-tests.scm @@ -19,18 +19,23 @@ (assert (zero? (round 0.3))) (assert (= 1.0 (round 0.6))) (assert (rational? 1)) +(assert (finite? 1)) (assert (rational? 1.0)) -(assert (not (rational? +inf.))) -(assert (not (rational? -inf.))) -(assert (not (rational? +nan))) +(assert (finite? 1.0)) +(assert (not (rational? +inf.0))) +(assert (not (finite? +inf.0))) +(assert (not (rational? -inf.0))) +(assert (not (finite? -inf.0))) +(assert (not (rational? +nan.0))) +(assert (not (finite? +nan.0))) (assert (not (rational? 'foo))) (assert (not (rational? "foo"))) (assert (integer? 2)) (assert (integer? 2.0)) (assert (not (integer? 1.1))) -(assert (not (integer? +inf.))) -(assert (not (integer? -inf.))) -(assert (not (integer? +nan))) +(assert (not (integer? +inf.0))) +(assert (not (integer? -inf.0))) +(assert (not (integer? +nan.0))) (assert (not (integer? 'foo))) (assert (not (integer? "foo"))) ; XXX number missing diff --git a/tests/numbers-string-conversion-tests.scm b/tests/numbers-string-conversion-tests.scm index 815798d..09d8ee8 100644 --- a/tests/numbers-string-conversion-tests.scm +++ b/tests/numbers-string-conversion-tests.scm @@ -185,6 +185,13 @@ ("-inf.1" #f) ("+inf.0/1" #f) ("1/+inf.0" #f) + ;; Thanks to John Cowan for these + ("#e+nan.0" #f) + ("#e+inf.0" #f) + ("#e-inf.0" #f) + ("#i+nan.0" the-nan "+nan.0" "+NaN.0") + ("#i+inf.0" pos-inf "+inf.0" "+Inf.0") + ("#i-inf.0" neg-inf "-inf.0" "-Inf.0") #| ;; DEPRECATED (Disabled during deprecation period of "[+-]nan", "[+-]inf") ("+nan" #f) @@ -196,22 +203,37 @@ "Fractions" ("1/2" (/ 1 2) "0.5" ".5" "500.0e-3") + ("#e1/2" #f) ("10/2" 5.0 "5.0" "5.") + ("#i10/2" 5.0 "5.0" "5.") ("-1/2" (- (/ 1 2)) "-0.5" "-.5" "-500.0e-3") ("1/-2" #f) + ("10/0" +inf.0 "+inf.0") + ("0/10" 0.0 "0.0") + ("#e0/10" 0 "0") + ("#e1#/2" 5 "5") + ("#e1/2#" #f) ("1.0/2" #f) ("1/2.0" #f) ("1/2e2" #f) ("1/2e2" #f) ("1#/2" 5.0 7.5 "5.0" "5." "7.5") ("1/2#" 0.05 "0.05" ".05" "50.0e-3" "5.e-002") + ("#i3/2" (/ 3.0 2.0) "1.5") ("1#/#" #f) ("1/" #f) ("1/+" #f) ("+/1" #f) ("/1" #f) ("/" #f) - + ("#i1/0" pos-inf "+inf.0" "+Inf.0") + ("#i-1/0" neg-inf "-inf.0" "-Inf.0") + ("#i0/0" the-nan "+nan.0" "+NaN.0") + ;; This _could_ be valid (but isn't as pretty) + ;("#i1/0" #f) + ;("#i-1/0" #f) + ;("#i0/0" #f) + "Some invalid complex numbers syntax (not supported at all)" ("2i" #f) ("+-i" #f) -- 1.7.9.1