From: Taylor R Campbell <campbell@mumble.net>
Date: Fri, 7 Dec 2018 04:38:20 +0000 (+0000)
Subject: Expand test-numpar.scm a little with some bugs.
X-Git-Tag: mit-scheme-pucked-10.1.7~3^2~42
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=98a58cfa095f3a04cc05b2abdf6d3130af07d0b7;p=mit-scheme.git

Expand test-numpar.scm a little with some bugs.
---

diff --git a/tests/runtime/test-numpar.scm b/tests/runtime/test-numpar.scm
index ddaef1b85..534680696 100644
--- a/tests/runtime/test-numpar.scm
+++ b/tests/runtime/test-numpar.scm
@@ -38,7 +38,29 @@ USA.
     (lambda ()
       (with-xfail xfail
         (lambda ()
-          (assert-eqv (string->number s) v))))))
+          (assert-eqv-nan (string->number s) v))))))
+
+(define (define-error-test s #!optional xfail)
+  (define-test s
+    (lambda ()
+      (with-xfail xfail
+        (lambda ()
+          (assert-error (lambda () (string->number s))))))))
+
+(define (eqv-nan? x y)
+  (if (and (flo:flonum? x) (flo:nan? x))
+      (and (flo:flonum? y)
+           (flo:nan? y)
+           (eqv? (flo:sign-negative? x) (flo:sign-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-xfail xfail body)
   (if (default-object? xfail)
@@ -143,3 +165,25 @@ USA.
 (define-eqv-test "-2+0.i" (make-rectangular -2 0.))
 (define-eqv-test "2-0.i" (make-rectangular 2 -0.))
 (define-eqv-test "-2-0.i" (make-rectangular -2 -0.))
+
+(define-eqv-test "+nan.0" (flo:make-nan #f #t 0))
+(define-eqv-test "-nan.0" (flo:make-nan #t #t 0) expect-failure)
+(define-eqv-test "+inf.0" (flo:+inf.0))
+(define-eqv-test "-inf.0" (flo:-inf.0))
+
+(define-eqv-test "#i+nan.0" (flo:make-nan #f #t 0))
+(define-eqv-test "#i-nan.0" (flo:make-nan #t #t 0) expect-failure)
+(define-eqv-test "#i+inf.0" (flo:+inf.0))
+(define-eqv-test "#i-inf.0" (flo:-inf.0))
+
+(define-error-test "#e+nan.0" expect-failure)
+(define-error-test "#e-nan.0" expect-failure)
+(define-error-test "#e+inf.0" expect-failure)
+(define-error-test "#e-inf.0" expect-failure)
+
+(define-error-test "+0+0" expect-failure)
+(define-error-test "0+0" expect-failure)
+(define-error-test "+1+0" expect-failure)
+(define-error-test "1+0" expect-failure)
+(define-error-test "+0+0+i" expect-failure)
+(define-error-test "0+0+i" expect-failure)