From: Taylor R Campbell <campbell@mumble.net>
Date: Fri, 7 Dec 2018 16:00:07 +0000 (+0000)
Subject: Reject inf and NaN with #e notation.
X-Git-Tag: mit-scheme-pucked-10.1.7~3^2~35
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=c0af2184f649b958fc481b00daf806393793cfa1;p=mit-scheme.git

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 1157e3ddf..76d5a2c60 100644
--- 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 3f6c9fe7b..18ddc40ed 100644
--- 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 fedc3905c..e77a2e7f1 100644
--- 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)