From 68c5d3d1d60f9ff4a7256b98693e492330d98027 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 24 Jan 2015 08:47:33 -0700
Subject: [PATCH] fix error message for `inexact->exact` on `+inf.f`

---
 .../scribblings/reference/numbers.scrbl       |  3 +-
 .../racket-test-core/tests/racket/number.rktl |  4 +++
 racket/src/racket/src/number.c                | 33 +++++++++++--------
 racket/src/racket/src/numstr.c                | 21 ++++++++++++
 4 files changed, 46 insertions(+), 15 deletions(-)

diff --git a/pkgs/racket-doc/scribblings/reference/numbers.scrbl b/pkgs/racket-doc/scribblings/reference/numbers.scrbl
index 5054ad509e..b17ebcfc7f 100644
--- a/pkgs/racket-doc/scribblings/reference/numbers.scrbl
+++ b/pkgs/racket-doc/scribblings/reference/numbers.scrbl
@@ -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)]}
diff --git a/pkgs/racket-test-core/tests/racket/number.rktl b/pkgs/racket-test-core/tests/racket/number.rktl
index 5b85299485..e331691ba7 100644
--- a/pkgs/racket-test-core/tests/racket/number.rktl
+++ b/pkgs/racket-test-core/tests/racket/number.rktl
@@ -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)
diff --git a/racket/src/racket/src/number.c b/racket/src/racket/src/number.c
index 60f88aaa8c..051f53c1d3 100644
--- a/racket/src/racket/src/number.c
+++ b/racket/src/racket/src/number.c
@@ -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);
diff --git a/racket/src/racket/src/numstr.c b/racket/src/racket/src/numstr.c
index 375e9565ad..a82d68c794 100644
--- a/racket/src/racket/src/numstr.c
+++ b/racket/src/racket/src/numstr.c
@@ -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)
 {