Reject inf and NaN with #e notation.

There is no exact infinity or exact NaN.

diff --git a/src/runtime/numpar.scm b/src/runtime/numpar.scm
index 1157e3ddfbdc0bfb45cb579b9275da94d9031d40..76d5a2c606387333b5ad1b68827d8730b41e01c6 100644 (file)
--- a/src/runtime/numpar.scm
+++ b/src/runtime/numpar.scm
@@ -114,9 +114,12 @@ USA.
                                sign))
               ((and (char-ci=? #\i char)
                     (string-prefix-ci? "nf.0" string start end))
-               (parse-complex string (+ start 4) end
-                              (if (eq? #\- sign) (flo:-inf.0) (flo:+inf.0))
-                              exactness radix sign))
+               (and (not (eq? exactness 'exact))
+                    (parse-complex string (+ start 4) end
+                                   (if (eq? #\- sign)
+                                       (flo:-inf.0)
+                                       (flo:+inf.0))
+                                   exactness radix sign)))
               ((and (char-ci=? #\n char)
                     (string-prefix-ci? "an." string start end))
                 (parse-nan-payload string (+ start 3) end exactness radix
@@ -318,20 +321,21 @@ USA.
 
 (define (parse-nan-payload string start end exactness radix quiet? sign)
   (let loop ((payload 0) (start start))
-    (define (finish)
+    (define (finish-nan)
       (and (or quiet? (not (zero? payload)))
-          (apply-sign sign (flo:make-nan #f quiet? payload))))
+          (not (eq? exactness 'exact))
+          (flo:make-nan (if (eq? sign #\-) #t #f) quiet? payload)))
     (if (fix:< start end)
         (let ((char (string-ref string start)))
           (cond ((char->digit char radix)
                  => (lambda (digit)
                       (loop (+ (* payload radix) digit) (fix:+ start 1))))
-                ((finish)
+                ((finish-nan)
                 => (lambda (nan)
                      (parse-complex string start end nan
                                     exactness radix sign)))
                (else #f)))
-        (finish))))
+        (finish-nan))))
 
 (define (finish-integer integer exactness sign)
   ;; State: result is integer, apply exactness and sign.

diff --git a/tests/runtime/test-numpar.scm b/tests/runtime/test-numpar.scm
index 3f6c9fe7b826fbdbfe9fee1225c8199976d05a8d..18ddc40ed833ef269360640d329734c021796d2d 100644 (file)
--- a/tests/runtime/test-numpar.scm
+++ b/tests/runtime/test-numpar.scm
@@ -196,12 +196,12 @@ USA.
 (define-eqv-test "#i+inf.0" (flo:+inf.0))
 (define-eqv-test "#i-inf.0" (flo:-inf.0))
 
-(define-error-test "#e+nan.0" expect-failure)
-(define-error-test "#e-nan.0" expect-failure)
+(define-error-test "#e+nan.0")
+(define-error-test "#e-nan.0")
 (define-error-test "#e+snan.0")         ;correctly errors by accident
 (define-error-test "#e-snan.0")
-(define-error-test "#e+inf.0" expect-failure)
-(define-error-test "#e-inf.0" expect-failure)
+(define-error-test "#e+inf.0")
+(define-error-test "#e-inf.0")
 
 (define-error-test "+0+0" expect-failure)
 (define-error-test "0+0" expect-failure)

diff --git a/tests/runtime/test-readwrite.scm b/tests/runtime/test-readwrite.scm
index fedc3905c90153cf12ee62d81f56e68d60a85327..e77a2e7f1733eb8907883c67152520c70f018d6d 100644 (file)
--- a/tests/runtime/test-readwrite.scm
+++ b/tests/runtime/test-readwrite.scm
@@ -232,22 +232,22 @@ USA.
     ("-snan.deadbeef" ,expect-failure)
     ("#i+snan.0")
     ("#i-snan.0")
-    ("#e+nan.0" ,expect-failure)
-    ("#e-nan.0" ,expect-failure)
-    ("#e+nan.1" ,expect-failure)
-    ("#e-nan.1" ,expect-failure)
-    ("#e+nan.123" ,expect-failure)
-    ("#e-nan.123" ,expect-failure)
+    ("#e+nan.0")
+    ("#e-nan.0")
+    ("#e+nan.1")
+    ("#e-nan.1")
+    ("#e+nan.123")
+    ("#e-nan.123")
     ("#e+nan.deadbeef")
     ("#e-nan.deadbeef")
-    ("#e+snan.1" ,expect-failure)
-    ("#e-snan.1" ,expect-failure)
-    ("#e+snan.123" ,expect-failure)
-    ("#e-snan.123" ,expect-failure)
+    ("#e+snan.1")
+    ("#e-snan.1")
+    ("#e+snan.123")
+    ("#e-snan.123")
     ("#e+snan.deadbeef")
     ("#e-snan.deadbeef")
-    ("#e+inf.0" ,expect-failure)
-    ("#e-inf.0" ,expect-failure)
+    ("#e+inf.0")
+    ("#e-inf.0")
     ("+inf.0+snan.0i" ,expect-failure)
     ("+snan.0+inf.0i" ,expect-failure)
     ("+inf.0-snan.0i" ,expect-failure)