From: Taylor R Campbell <campbell@mumble.net>
Date: Sat, 17 Nov 2018 23:31:56 +0000 (+0000)
Subject: Parse and print nonfinite parts in rectangular complex numbers.
X-Git-Tag: mit-scheme-pucked-10.1.2~16^2~55
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=adbef5e5f419cd4b19f6f91d866e013a8d81e060;p=mit-scheme.git

Parse and print nonfinite parts in rectangular complex numbers.
---

diff --git a/src/runtime/arith.scm b/src/runtime/arith.scm
index cd482a9db..ba54034a7 100644
--- a/src/runtime/arith.scm
+++ b/src/runtime/arith.scm
@@ -1946,9 +1946,12 @@ USA.
 		(if (real:exact1= i)
 		    ""
 		    (real:->string i radix)))))
-	 (if (real:negative? i)
-	     (string-append "-" (positive-case (real:negate i)))
-	     (string-append "+" (positive-case i))))
+	 (cond ((not (real:finite? i))
+		(real:->string i radix))
+	       ((real:negative? i)
+		(string-append "-" (positive-case (real:negate i))))
+	       (else
+		(string-append "+" (positive-case i)))))
        (if imaginary-unit-j? "j" "i"))
       (real:->string z radix)))
 
diff --git a/src/runtime/numpar.scm b/src/runtime/numpar.scm
index 4f78bcec6..6370d6a0e 100644
--- a/src/runtime/numpar.scm
+++ b/src/runtime/numpar.scm
@@ -34,14 +34,9 @@ USA.
 	 (end (fix:end-index end (string-length string) caller))
 	 (start (fix:start-index start end caller))
 	 (z
-	  (cond ((string=? string "+nan.0") (flo:nan.0))
-		((string=? string "-nan.0") (flo:nan.0))
-		((string=? string "+inf.0") (flo:+inf.0))
-		((string=? string "-inf.0") (flo:-inf.0))
-		(else
-		 (parse-number string start end
-			       (if (default-object? radix) #f radix)
-			       caller)))))
+	  (parse-number string start end
+			(if (default-object? radix) #f radix)
+			caller)))
     (if (and (not z) (if (default-object? error?) #f error?))
 	(error:bad-range-argument string caller))
     z))
@@ -117,6 +112,16 @@ USA.
 				(or exactness 'implicit-inexact)
 				radix
 				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 (char-ci=? #\n char)
+		     (string-prefix-ci? "an.0" string start end))
+		(parse-complex string (+ start 4) end
+			       (flo:nan.0)
+			       exactness radix sign))
 	       ((i? char)
 		(and (fix:= start end)
 		     (make-rectangular 0 (if (eq? #\- sign) -1 1))))
@@ -278,7 +283,7 @@ USA.
 	     (get-digits start #f)))))
 
 (define (parse-dotted-5 string start end integer rexponent exactness radix
-                        sign base bexponent)
+			sign base bexponent)
   (parse-complex string start end
 		 (finish-real integer rexponent exactness radix sign
 			      base bexponent)
diff --git a/tests/runtime/test-readwrite.scm b/tests/runtime/test-readwrite.scm
index d6a8c1874..46f5d5126 100644
--- a/tests/runtime/test-readwrite.scm
+++ b/tests/runtime/test-readwrite.scm
@@ -91,18 +91,22 @@ USA.
     ("1/34" ,assert-exact-rational)
     ("123+456i" ,assert-complex-nonreal)
     ("1.23" ,assert-flonum)
-    ("+inf.0i" ,assert-complex-nonreal xfail)
-    ("-inf.0i" ,assert-complex-nonreal xfail)
-    ("1+inf.0i" ,assert-complex-nonreal xfail)
-    ("1-inf.0i" ,assert-complex-nonreal xfail)
-    ("+inf.0+1i" ,assert-complex-nonreal xfail)
-    ("-inf.0+1i" ,assert-complex-nonreal xfail)
-    ("+inf.0+inf.0i" ,assert-complex-nonreal xfail)
-    ("+inf.0-inf.0i" ,assert-complex-nonreal xfail)
-    ("-inf.0+inf.0i" ,assert-complex-nonreal xfail)
-    ("-inf.0-inf.0i" ,assert-complex-nonreal xfail)
-    ("+inf.0+nan.0i" ,assert-complex-nonreal xfail)
-    ("+nan.0+inf.0i" ,assert-complex-nonreal xfail))
+    ("+inf.0i" ,assert-complex-nonreal)
+    ("-inf.0i" ,assert-complex-nonreal)
+    ("1+inf.0i" ,assert-complex-nonreal)
+    ("1-inf.0i" ,assert-complex-nonreal)
+    ("2+inf.0i" ,assert-complex-nonreal)
+    ("2-inf.0i" ,assert-complex-nonreal)
+    ("+inf.0+i" ,assert-complex-nonreal)
+    ("-inf.0+i" ,assert-complex-nonreal)
+    ("+inf.0+2i" ,assert-complex-nonreal)
+    ("-inf.0+2i" ,assert-complex-nonreal)
+    ("+inf.0+inf.0i" ,assert-complex-nonreal)
+    ("+inf.0-inf.0i" ,assert-complex-nonreal)
+    ("-inf.0+inf.0i" ,assert-complex-nonreal)
+    ("-inf.0-inf.0i" ,assert-complex-nonreal)
+    ("+inf.0+nan.0i" ,assert-complex-nonreal)
+    ("+nan.0+inf.0i" ,assert-complex-nonreal))
   (lambda (string #!optional assertion xfail?)
     (with-expected-failure xfail?
       (lambda ()
@@ -120,26 +124,28 @@ USA.
     ("#x123+456i" ,assert-complex-nonreal)
     ("#x1.23p+4-1.ffp-8i" ,assert-complex-nonreal)
     ("#x1.23p+0" ,assert-flonum)
-    ("#x+inf.0i" ,assert-complex-nonreal xerror)
-    ("#x-inf.0i" ,assert-complex-nonreal xerror)
-    ("#x1+inf.0i" ,assert-complex-nonreal xerror)
-    ("#x1-inf.0i" ,assert-complex-nonreal xerror)
-    ("#x1p+1+inf.0i" ,assert-complex-nonreal xerror)
-    ("#x1p+1-inf.0i" ,assert-complex-nonreal xerror)
-    ("#x-1p+1+inf.0i" ,assert-complex-nonreal xerror)
-    ("#x-1p+1-inf.0i" ,assert-complex-nonreal xerror)
-    ("#x+inf.0+1p+1i" ,assert-complex-nonreal xerror)
-    ("#x-inf.0+1p+1i" ,assert-complex-nonreal xerror)
-    ("#x+inf.0-1p+1i" ,assert-complex-nonreal xerror)
-    ("#x-inf.0-1p+1i" ,assert-complex-nonreal xerror)
-    ("#x+inf.0+1i" ,assert-complex-nonreal xerror)
-    ("#x-inf.0+1i" ,assert-complex-nonreal xerror)
-    ("#x+inf.0+inf.0i" ,assert-complex-nonreal xerror)
-    ("#x+inf.0-inf.0i" ,assert-complex-nonreal xerror)
-    ("#x-inf.0+inf.0i" ,assert-complex-nonreal xerror)
-    ("#x-inf.0-inf.0i" ,assert-complex-nonreal xerror)
-    ("#x+inf.0+nan.0i" ,assert-complex-nonreal xerror)
-    ("#x+nan.0+inf.0i" ,assert-complex-nonreal xerror))
+    ("#x+inf.0i" ,assert-complex-nonreal)
+    ("#x-inf.0i" ,assert-complex-nonreal)
+    ("#x1+inf.0i" ,assert-complex-nonreal)
+    ("#x1-inf.0i" ,assert-complex-nonreal)
+    ("#x+inf.0+i" ,assert-complex-nonreal)
+    ("#x-inf.0+i" ,assert-complex-nonreal)
+    ("#x+inf.0-i" ,assert-complex-nonreal)
+    ("#x-inf.0-i" ,assert-complex-nonreal)
+    ("#x1p+1+inf.0i" ,assert-complex-nonreal)
+    ("#x1p+1-inf.0i" ,assert-complex-nonreal)
+    ("#x-1p+1+inf.0i" ,assert-complex-nonreal)
+    ("#x-1p+1-inf.0i" ,assert-complex-nonreal)
+    ("#x+inf.0+1p+1i" ,assert-complex-nonreal)
+    ("#x-inf.0+1p+1i" ,assert-complex-nonreal)
+    ("#x+inf.0-1p+1i" ,assert-complex-nonreal)
+    ("#x-inf.0-1p+1i" ,assert-complex-nonreal)
+    ("#x+inf.0+inf.0i" ,assert-complex-nonreal)
+    ("#x+inf.0-inf.0i" ,assert-complex-nonreal)
+    ("#x-inf.0+inf.0i" ,assert-complex-nonreal)
+    ("#x-inf.0-inf.0i" ,assert-complex-nonreal)
+    ("#x+inf.0+nan.0i" ,assert-complex-nonreal)
+    ("#x+nan.0+inf.0i" ,assert-complex-nonreal))
   (lambda (string #!optional assertion xfail?)
     (with-expected-failure xfail?
       (lambda ()