For +/-2i x, compute sqrt by sqrt(x) +/- i sqrt(x).

Strike off some expected failures.

diff --git a/src/runtime/arith.scm b/src/runtime/arith.scm
index 4ebed69e16f3e13b2e53524fba2758290bd11a5d..c620b906838fc322cdf38cc51dce688754a9c7f8 100644 (file)
--- a/src/runtime/arith.scm
+++ b/src/runtime/arith.scm
@@ -1316,6 +1316,11 @@ USA.
                 (rat:negative? y))
             (- (rat:abs x))
             (rat:abs x)))))
+
+(define (real:safe-negative? x)
+  (if (flonum? x)
+      (flo:safe-negative? x)
+      ((copy rat:negative?) x)))
 \f
 (define-syntax define-transcendental-unary
   (sc-macro-transformer
@@ -1963,8 +1968,16 @@ USA.
 
 (define (complex:sqrt z)
   (cond ((recnum? z)
-        (complex:%make-polar (real:sqrt (complex:magnitude z))
-                             (real:/ (complex:angle z) 2)))
+        (let ((x (rec:real-part z))
+              (y (rec:imag-part z)))
+          (if (real:zero? x)
+              ;; sqrt(+/- 2i x) = sqrt(x) +/- sqrt(x)i
+              (let ((sqrt-abs-y/2 (real:sqrt (real:/ (real:abs y) 2))))
+                (complex:%make-rectangular
+                 sqrt-abs-y/2
+                 (real:copysign sqrt-abs-y/2 y)))
+              (complex:%make-polar (real:sqrt (complex:magnitude z))
+                                    (real:/ (complex:angle z) 2)))))
        ((real:negative? z)
         (complex:%make-rectangular 0 (real:sqrt (real:negate z))))
        (else

diff --git a/tests/runtime/test-arith.scm b/tests/runtime/test-arith.scm
index c93638458e44a6955bd8f8cca0bd3b5d4a03bde7..4c6c984d05e953b7993332b3a4b47e268122112b 100644 (file)
--- a/tests/runtime/test-arith.scm
+++ b/tests/runtime/test-arith.scm
@@ -667,22 +667,20 @@ USA.
      ,expect-failure)
     (,(make-rectangular 0. (* 2 flo:smallest-positive-subnormal))
      ,(make-rectangular (expt 2. (/ flo:subnormal-exponent-min 2))
-                        (expt 2. (/ flo:subnormal-exponent-min 2)))
-     ,expect-failure)
-    (+.125i .25+.25i ,expect-failure)
-    (+1/8i 1/4+1/4i ,expect-failure)
-    (+2i 1+1i ,expect-failure)
-    (+8i 2+2i ,expect-failure)
-    (+18i 3+3i ,expect-failure)
-    (+32i 4+4i ,expect-failure)
-    (+2.i 1.+1.i ,expect-failure)
-    (+8.i 2.+2.i ,expect-failure)
-    (+18.i 3.+3.i ,expect-failure)
-    (+32.i 4.+4.i ,expect-failure)
+                        (expt 2. (/ flo:subnormal-exponent-min 2))))
+    (+.125i .25+.25i)
+    (+1/8i 1/4+1/4i)
+    (+2i 1+1i)
+    (+8i 2+2i)
+    (+18i 3+3i)
+    (+32i 4+4i)
+    (+2.i 1.+1.i)
+    (+8.i 2.+2.i)
+    (+18.i 3.+3.i)
+    (+32.i 4.+4.i)
     (,(make-rectangular 0. (expt 2. flo:normal-exponent-max))
      ,(make-rectangular (expt 2. (/ (- flo:normal-exponent-max 1) 2))
-                        (expt 2. (/ (- flo:normal-exponent-max 1) 2)))
-     ,expect-failure)
+                        (expt 2. (/ (- flo:normal-exponent-max 1) 2))))
     (,(make-rectangular 0 (* 2 (expt 2 4000)))
      ,(make-rectangular (expt 2 2000) (expt 2 2000))
      ,expect-error)
@@ -693,30 +691,28 @@ USA.
     (,(make-rectangular 0. (- (* 2 flo:smallest-positive-subnormal)))
      ,(make-rectangular
        (expt 2. (/ flo:subnormal-exponent-min 2))
-       (- (expt 2. (/ flo:subnormal-exponent-min 2))))
-     ,expect-failure)
-    (-.125i .25-.25i ,expect-failure)
-    (-1/8i 1/4-1/4i ,expect-failure)
-    (-2i 1-1i ,expect-failure)
-    (-8i 2-2i ,expect-failure)
-    (-18i 3-3i ,expect-failure)
-    (-32i 4-4i ,expect-failure)
-    (-2.i 1.-1.i ,expect-failure)
-    (-8.i 2.-2.i ,expect-failure)
-    (-18.i 3.-3.i ,expect-failure)
-    (-32.i 4.-4.i ,expect-failure)
+       (- (expt 2. (/ flo:subnormal-exponent-min 2)))))
+    (-.125i .25-.25i)
+    (-1/8i 1/4-1/4i)
+    (-2i 1-1i)
+    (-8i 2-2i)
+    (-18i 3-3i)
+    (-32i 4-4i)
+    (-2.i 1.-1.i)
+    (-8.i 2.-2.i)
+    (-18.i 3.-3.i)
+    (-32.i 4.-4.i)
     (,(make-rectangular 0. (- (expt 2. flo:normal-exponent-max)))
      ,(make-rectangular (expt 2. (/ (- flo:normal-exponent-max 1) 2))
-                        (- (expt 2. (/ (- flo:normal-exponent-max 1) 2))))
-     ,expect-failure)
+                        (- (expt 2. (/ (- flo:normal-exponent-max 1) 2)))))
     (,(make-rectangular 0 (- (* 2 (expt 2 4000))))
      ,(make-rectangular (expt 2 2000) (- (expt 2 2000)))
      ,expect-error)
     ;; Handle signed zero carefully.
     (+0.i 0.+0.i)
-    (-0.i 0.-0.i ,expect-failure)
+    (-0.i 0.-0.i)
     (-0.+0.i +0.+0.i)
-    (-0.-0.i +0.-0.i ,expect-failure)
+    (-0.-0.i +0.-0.i)
     ;; Treat infinities carefully around branch cuts.
     (-inf.0 +inf.0i)
     (+inf.0 +inf.0)