From: Taylor R Campbell <campbell@mumble.net>
Date: Fri, 30 Nov 2018 06:37:51 +0000 (+0000)
Subject: Test NaN preservation of sqrt.
X-Git-Tag: mit-scheme-pucked-10.1.7~3^2~97
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=1b414c24f079f37b3bb2763a87c72df7051c46e4;p=mit-scheme.git

Test NaN preservation of sqrt.
---

diff --git a/tests/runtime/test-arith.scm b/tests/runtime/test-arith.scm
index 49958c9f4..14153679c 100644
--- a/tests/runtime/test-arith.scm
+++ b/tests/runtime/test-arith.scm
@@ -762,6 +762,14 @@ USA.
   (lambda ()
     (let ((x (identity-procedure (flo:qnan 1234))))
       (assert-eqv-nan (yes-traps (lambda () (sqrt x))) x)
+      (let ((x+0i (make-rectangular x +0.))
+            (x-0i (make-rectangular x -0.))
+            (xi+0 (make-rectangular +0. x))
+            (xi-0 (make-rectangular -0. x)))
+        (assert-eqv-nan (no-traps (lambda () (real-part (sqrt x+0i)))) x)
+        (assert-eqv-nan (no-traps (lambda () (real-part (sqrt x-0i)))) x)
+        (assert-eqv-nan (no-traps (lambda () (real-part (sqrt xi+0)))) x)
+        (assert-eqv-nan (no-traps (lambda () (real-part (sqrt xi-0)))) x))
       (assert-eqv
        (flo:preserving-environment
         (lambda ()
@@ -774,9 +782,22 @@ USA.
 
 (define-test 'sqrt-snan
   (lambda ()
-    (let ((x (identity-procedure (flo:snan 4321))))
-      (assert-eqv-nan (no-traps (lambda () (sqrt x))) (flo:qnan 4321))
+    (let ((x (identity-procedure (flo:snan 4321)))
+          (x* (flo:qnan 4321)))
+      (assert-eqv-nan (no-traps (lambda () (sqrt x))) x*)
       (assert-error (lambda () (yes-traps (lambda () (sqrt x)))))
+      (let ((x+0i (make-rectangular x +0.))
+            (x-0i (make-rectangular x -0.))
+            (xi+0 (make-rectangular +0. x))
+            (xi-0 (make-rectangular -0. x)))
+        (assert-eqv-nan (no-traps (lambda () (real-part (sqrt x+0i)))) x*)
+        (assert-eqv-nan (no-traps (lambda () (real-part (sqrt x-0i)))) x*)
+        (assert-eqv-nan (no-traps (lambda () (real-part (sqrt xi+0)))) x*)
+        (assert-eqv-nan (no-traps (lambda () (real-part (sqrt xi-0)))) x*)
+        (assert-error (lambda () (yes-traps (lambda () (sqrt x+0i)))))
+        (assert-error (lambda () (yes-traps (lambda () (sqrt x-0i)))))
+        (assert-error (lambda () (yes-traps (lambda () (sqrt xi+0)))))
+        (assert-error (lambda () (yes-traps (lambda () (sqrt xi-0))))))
       (assert-eqv
        (flo:preserving-environment
         (lambda ()