sqrt is busted on infinities.

diff --git a/tests/runtime/test-arith.scm b/tests/runtime/test-arith.scm
index ccc6a15edbb4ee518013e46698c0f6af88e007d4..de18b68546df253cdbd7db8e3ce8414981173f82 100644 (file)
--- a/tests/runtime/test-arith.scm
+++ b/tests/runtime/test-arith.scm
@@ -56,11 +56,31 @@ USA.
 (define assert-real
   (predicate-assertion real? "real number"))
 
+(define (eqv-nan? x y)
+  (if (and (flo:flonum? x) (flo:nan? x))
+      (and (flo:flonum? y)
+           (flo:nan? y)
+           (eqv? (flo:safe-negative? x) (flo:safe-negative? y))
+           (eqv? (flo:nan-quiet? x) (flo:nan-quiet? y))
+           (eqv? (flo:nan-payload x) (flo:nan-payload y)))
+      (and (not (and (flo:flonum? y) (flo:nan? y)))
+           (eqv? x y))))
+
+(define-comparator eqv-nan? 'eqv-nan?)
+
+(define assert-eqv-nan
+  (simple-binary-assertion eqv-nan? #f))
+
 (define (with-expected-failure xfail body)
   (if (default-object? xfail)
       (body)
       (xfail body)))
 
+(define (no-traps f)
+  (if (flo:have-trap-enable/disable?)
+      (flo:with-trapped-exceptions 0 f)
+      (f)))
+
 (define (define-enumerated-test prefix cases procedure)
   (for-each (lambda (arguments)
               (define-test (symbol prefix '/ arguments)
@@ -625,4 +645,29 @@ USA.
    (list -inf.0-inf.0i (* pi -3/4))
    (list -inf.0+inf.0i (* pi 3/4)))
   (lambda (z t)
-    (assert-<= (relerr t (angle z)) 1e-15)))
\ No newline at end of file
+    (assert-<= (relerr t (angle z)) 1e-15)))
+
+(define-enumerated-test 'sqrt
+  `((0 0)
+    (0. 0.)
+    (1 1)
+    (1. 1.)
+    (4 2)
+    (4. 2.)
+    (-inf.0 +inf.0i)
+    (+inf.0 +inf.0)
+    (-inf.0+1.i +inf.0i ,expect-failure)
+    (+inf.0+1.i +inf.0 ,expect-failure)
+    (-inf.0-1.i +inf.0i ,expect-failure)
+    (+inf.0-1.i +inf.0 ,expect-failure)
+    (-inf.0i -inf.0+inf.0i ,expect-failure)
+    (+inf.0i +inf.0+inf.0i)
+    (1.-inf.0i -inf.0+inf.0i ,expect-failure)
+    (1.+inf.0i +inf.0+inf.0i)
+    (-1.-inf.0i -inf.0+inf.0i ,expect-failure)
+    (-1.+inf.0i +inf.0+inf.0i)
+    (,(flo:qnan 1234) ,(flo:qnan 1234)))
+  (lambda (z r #!optional xfail)
+    (with-expected-failure xfail
+      (lambda ()
+        (assert-eqv-nan (no-traps (lambda () (sqrt z))) r)))))
\ No newline at end of file