suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix error message for inexact->exact on +inf.f

Browse Source
This commit is contained in:
Matthew Flatt 2015-01-24 08:47:33 -07:00
parent bac11bf8f5
commit 68c5d3d1d6
4 changed files with 46 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
pkgs/racket-doc/scribblings/reference/numbers.scrbl
View File

@ -213,7 +213,8 @@ number, @racket[#f] otherwise.}
@defproc[(inexact->exact [z number?]) exact?]{ Coerces @racket[z] to an
exact number. If @racket[z] is already exact, it is returned. If @racket[z]
is @racket[+inf.0], @racket[-inf.0], or @racket[+nan.0], then the
is @racket[+inf.0], @racket[-inf.0], @racket[+nan.0],
@racket[+inf.f], @racket[-inf.f], or @racket[+nan.f], then the
@exnraise[exn:fail:contract].
@mz-examples[(inexact->exact 1) (inexact->exact 1.0)]}

4
pkgs/racket-test-core/tests/racket/number.rktl
View File

@ -705,6 +705,10 @@
(err/rt-test (inexact->exact -inf.0))
(err/rt-test (inexact->exact +nan.0))
(err/rt-test (inexact->exact +inf.f) (lambda (exn) (regexp-match? #rx"[+]inf[.]f" (exn-messgae exn))))
(err/rt-test (inexact->exact -inf.f) (lambda (exn) (regexp-match? #rx"[-]inf[.]f" (exn-messgae exn))))
(err/rt-test (inexact->exact +nan.f) (lambda (exn) (regexp-match? #rx"[+]nan[.]f" (exn-messgae exn))))
(test 2.0f0 real->single-flonum 2)
(test 2.25f0 real->single-flonum 2.25)
(test 2.25f0 real->single-flonum 2.25f0)

33
racket/src/racket/src/number.c
View File

@ -3948,17 +3948,13 @@ scheme_inexact_to_exact (int argc, Scheme_Object *argv[])
if (SCHEME_INTP(o))
return o;
t = _SCHEME_TYPE(o);
if (t == scheme_double_type
#ifdef MZ_USE_SINGLE_FLOATS
|| t == scheme_float_type
#endif
) {
double d = SCHEME_FLOAT_VAL(o);
if (t == scheme_double_type) {
double d = SCHEME_DBL_VAL(o);
/* Try simple case: */
Scheme_Object *i = scheme_make_integer((intptr_t)d);
if ((double)SCHEME_INT_VAL(i) == d) {
# ifdef NAN_EQUALS_ANYTHING
#ifdef NAN_EQUALS_ANYTHING
if (!MZ_IS_NAN(d))
#endif
return i;
@ -3966,6 +3962,22 @@ scheme_inexact_to_exact (int argc, Scheme_Object *argv[])
return scheme_rational_from_double(d);
}
#ifdef MZ_USE_SINGLE_FLOATS
if (t == scheme_float_type) {
float d = SCHEME_FLT_VAL(o);
/* Try simple case: */
Scheme_Object *i = scheme_make_integer((intptr_t)d);
if ((double)SCHEME_INT_VAL(i) == d) {
# ifdef NAN_EQUALS_ANYTHING
if (!MZ_IS_NAN(d))
# endif
return i;
}
return scheme_rational_from_float(d);
}
#endif
if (t == scheme_bignum_type)
return o;
if (t == scheme_rational_type)
@ -4063,13 +4075,6 @@ extfl_to_inexact (int argc, Scheme_Object *argv[])
#endif
}
#ifdef MZ_USE_SINGLE_FLOATS
int scheme_check_float(const char *where, float f, const char *dest)
{
return scheme_check_double(where, f, dest);
}
#endif
GEN_BIN_PROT(bin_bitwise_and);
GEN_BIN_PROT(bin_bitwise_or);
GEN_BIN_PROT(bin_bitwise_xor);

21
racket/src/racket/src/numstr.c
View File

@ -2014,6 +2014,27 @@ int scheme_check_double(const char *where, double d, const char *dest)
return 1;
}
#ifdef MZ_USE_SINGLE_FLOATS
int scheme_check_float(const char *where, float f, const char *dest)
{
if (MZ_IS_INFINITY(f)
|| MZ_IS_NAN(f)) {
if (where) {
char buf[32];
sprintf(buf, "no %s representation", dest);
scheme_contract_error(where,
buf,
"number", 1, scheme_make_float(f),
NULL);
}
return 0;
}
return 1;
}
#endif
#ifdef MZ_LONG_DOUBLE
int scheme_check_long_double(const char *where, long_double d, const char *dest)
{