From: Taylor R Campbell <campbell@mumble.net>
Date: Tue, 20 Nov 2018 09:18:03 +0000 (+0000)
Subject: Use flo:hypot to compute inexact magnitudes with edge caess.
X-Git-Tag: mit-scheme-pucked-10.1.2~16^2~8
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=49454f82ffecad969764f71841155762a5e7a269;p=mit-scheme.git

Use flo:hypot to compute inexact magnitudes with edge caess.

Maybe not the best way but it'll do for now.
---

diff --git a/src/runtime/arith.scm b/src/runtime/arith.scm
index 9e0071659..ae39d37e1 100644
--- a/src/runtime/arith.scm
+++ b/src/runtime/arith.scm
@@ -1934,11 +1934,15 @@ USA.
   (if (recnum? z)
       (let ((ar (real:abs (rec:real-part z)))
 	    (ai (real:abs (rec:imag-part z))))
-	(let ((v (real:max ar ai))
-	      (w (real:min ar ai)))
-	  (if (real:zero? v)
-	      v
-	      (real:* v (real:sqrt (real:1+ (real:square (real:/ w v))))))))
+	(if (and (real:exact? ar)
+		 (real:exact? ai))
+	    (let ((v (real:max ar ai))
+		  (w (real:min ar ai)))
+	      (if (real:zero? v)
+		  v
+		  (real:* v
+			  (real:sqrt (real:1+ (real:square (real:/ w v)))))))
+	    (flo:hypot (real:->inexact ar) (real:->inexact ai))))
       (real:abs z)))
 
 (define (complex:sqrt z)
diff --git a/tests/runtime/test-arith.scm b/tests/runtime/test-arith.scm
index d18e254f0..0bce9039e 100644
--- a/tests/runtime/test-arith.scm
+++ b/tests/runtime/test-arith.scm
@@ -764,12 +764,7 @@ USA.
    -inf.0-inf.0i
    -inf.0+inf.0i)
   (lambda (z)
-    (with-expected-failure
-        (and (infinite? (real-part z))
-             (infinite? (imag-part z))
-             'xfail)
-      (lambda ()
-        (assert-inf+ (magnitude z))))))
+    (assert-inf+ (magnitude z))))
 
 (define-enumerated-test 'infinite-angle
   (vector