Parse and print nonfinite parts in rectangular complex numbers.

diff --git a/src/runtime/arith.scm b/src/runtime/arith.scm
index cd482a9dbd82b5321330db032f6f59416f1f0ab3..ba54034a727727c01d99970391a4663ca89377da 100644 (file)
--- 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 4f78bcec62dc04875a54ced9098c105110f2a11b..6370d6a0ebc742d04c95a889365af4c8196ed3ce 100644 (file)
--- 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 d6a8c1874995010b1465fd2dda51832bbb1e2cf7..46f5d5126cf0454728a451d70ad1cbe26c449f13 100644 (file)
--- 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 ()