From: Taylor R Campbell <campbell@mumble.net>
Date: Thu, 29 Nov 2018 05:30:04 +0000 (+0000)
Subject: Add some more copysign tests.
X-Git-Tag: mit-scheme-pucked-10.1.7~3^2~121
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=be71a7708a02504df8495003abad8a02fe1b70b6;p=mit-scheme.git

Add some more copysign tests.
---

diff --git a/tests/runtime/test-flonum.scm b/tests/runtime/test-flonum.scm
index 1c103bbd6..0f692fe87 100644
--- a/tests/runtime/test-flonum.scm
+++ b/tests/runtime/test-flonum.scm
@@ -217,32 +217,155 @@ USA.
           (assert-eqv (flo:ulp x) u))))))
 
 (define-enumerated-test 'copysign
-  '((0. 0. 0.)
+  `((0. 0. 0.)
     (0. -0. -0.)
     (0. 1. 0.)
     (0. -1. -0.)
     (0. +inf.0 0.)
     (0. -inf.0 -0.)
+    (0. ,(flo:make-nan #t #t 0) -0.)
+    (0. ,(flo:make-nan #f #t 0) 0.)
+    (0. ,(flo:make-nan #t #f 1) -0.)
+    (0. ,(flo:make-nan #f #f 1) 0.)
     (1. 0. 1.)
     (1. -0. -1.)
     (1. 1. 1.)
     (1. -1. -1.)
     (1. +inf.0 1.)
     (1. -inf.0 -1.)
+    (1. ,(flo:make-nan #t #t 0) -1.)
+    (1. ,(flo:make-nan #f #t 0) 1.)
+    (1. ,(flo:make-nan #t #f 1) -1.)
+    (1. ,(flo:make-nan #f #f 1) 1.)
     (+inf.0 0. +inf.0)
     (+inf.0 -0. -inf.0)
     (+inf.0 1. +inf.0)
     (+inf.0 -1. -inf.0)
     (+inf.0 +inf.0 +inf.0)
     (+inf.0 -inf.0 -inf.0)
+    (+inf.0 ,(flo:make-nan #t #t 0) -inf.0)
+    (+inf.0 ,(flo:make-nan #f #t 0) +inf.0)
+    (+inf.0 ,(flo:make-nan #t #f 1) -inf.0)
+    (+inf.0 ,(flo:make-nan #f #f 1) +inf.0)
     (-inf.0 0. +inf.0)
     (-inf.0 -0. -inf.0)
     (-inf.0 1. +inf.0)
     (-inf.0 -1. -inf.0)
     (-inf.0 +inf.0 +inf.0)
-    (-inf.0 -inf.0 -inf.0))
+    (-inf.0 -inf.0 -inf.0)
+    (-inf.0 ,(flo:make-nan #t #t 0) -inf.0)
+    (-inf.0 ,(flo:make-nan #f #t 0) +inf.0)
+    (-inf.0 ,(flo:make-nan #t #f 1) -inf.0)
+    (-inf.0 ,(flo:make-nan #f #f 1) +inf.0))
   (lambda (x y z)
-    (assert-eqv (yes-traps (lambda () (flo:copysign x y))) z)))
+    (assert-eqv-nan (yes-traps (lambda () (flo:copysign x y))) z)))
+
+(define-enumerated-test 'copysign-var/neg
+  `((-inf.0 -inf.0)
+    (-1. -1.)
+    (-0. -0.)
+    (0. -0.)
+    (1. -1.)
+    (+inf.0 -inf.0)
+    (,(flo:make-nan #t #t 1234) ,(flo:make-nan #t #t 1234))
+    (,(flo:make-nan #f #t 1234) ,(flo:make-nan #t #t 1234))
+    (,(flo:make-nan #t #f 1234) ,(flo:make-nan #t #f 1234))
+    (,(flo:make-nan #f #f 1234) ,(flo:make-nan #t #f 1234)))
+  (lambda (x z)
+    (assert-eqv-nan (yes-traps (lambda () (flo:copysign x -1.23))) z)))
+
+(define-enumerated-test 'copysign-var/pos
+  `((-inf.0 +inf.0)
+    (-1. +1.)
+    (-0. +0.)
+    (0. +0.)
+    (1. +1.)
+    (+inf.0 +inf.0)
+    (,(flo:make-nan #t #t 1234) ,(flo:make-nan #f #t 1234))
+    (,(flo:make-nan #f #t 1234) ,(flo:make-nan #f #t 1234))
+    (,(flo:make-nan #t #f 1234) ,(flo:make-nan #f #f 1234))
+    (,(flo:make-nan #f #f 1234) ,(flo:make-nan #f #f 1234)))
+  (lambda (x z)
+    (assert-eqv-nan (yes-traps (lambda () (flo:copysign x +1.23))) z)))
+
+(define-enumerated-test 'copysign-1.23/var
+  `((-inf.0 -1.23)
+    (-1. -1.23)
+    (-0. -1.23)
+    (0. 1.23)
+    (1. 1.23)
+    (+inf.0 1.23)
+    (,(flo:make-nan #t #t 1234) -1.23)
+    (,(flo:make-nan #f #t 1234) 1.23)
+    (,(flo:make-nan #t #f 1234) -1.23)
+    (,(flo:make-nan #f #f 1234) 1.23))
+  (lambda (x z)
+    (assert-eqv-nan (yes-traps (lambda () (flo:copysign -1.23 x))) z)
+    (assert-eqv-nan (yes-traps (lambda () (flo:copysign +1.23 x))) z)))
+
+(define-enumerated-test 'copysign-0/var
+  `((-inf.0 -0.)
+    (-1. -0.)
+    (-0. -0.)
+    (0. +0.)
+    (1. +0.)
+    (+inf.0 +0.)
+    (,(flo:make-nan #t #t 1234) -0.)
+    (,(flo:make-nan #f #t 1234) +0.)
+    (,(flo:make-nan #t #f 1234) -0.)
+    (,(flo:make-nan #f #f 1234) +0.))
+  (lambda (x z)
+    (assert-eqv-nan (yes-traps (lambda () (flo:copysign -0. x))) z)
+    (assert-eqv-nan (yes-traps (lambda () (flo:copysign +0. x))) z)))
+
+(define-enumerated-test 'copysign-inf/var
+  `((-inf.0 -inf.0)
+    (-1. -inf.0)
+    (-0. -inf.0)
+    (0. +inf.0)
+    (1. +inf.0)
+    (+inf.0 +inf.0)
+    (,(flo:make-nan #t #t 1234) -inf.0)
+    (,(flo:make-nan #f #t 1234) +inf.0)
+    (,(flo:make-nan #t #f 1234) -inf.0)
+    (,(flo:make-nan #f #f 1234) +inf.0))
+  (lambda (x z)
+    (assert-eqv-nan (yes-traps (lambda () (flo:copysign -inf.0 x))) z)
+    (assert-eqv-nan (yes-traps (lambda () (flo:copysign +inf.0 x))) z)))
+
+(define-enumerated-test 'copysign-qnan/var
+  `((-inf.0 ,(flo:make-nan #t #t 54321))
+    (-1. ,(flo:make-nan #t #t 54321))
+    (-0. ,(flo:make-nan #t #t 54321))
+    (0. ,(flo:make-nan #f #t 54321))
+    (1. ,(flo:make-nan #f #t 54321))
+    (+inf.0 ,(flo:make-nan #f #t 54321))
+    (,(flo:make-nan #t #t 1234) ,(flo:make-nan #t #t 54321))
+    (,(flo:make-nan #f #t 1234) ,(flo:make-nan #f #t 54321))
+    (,(flo:make-nan #t #f 1234) ,(flo:make-nan #t #t 54321))
+    (,(flo:make-nan #f #f 1234) ,(flo:make-nan #f #t 54321)))
+  (lambda (x z)
+    (let ((nan+ (flo:make-nan #f #t 54321))
+          (nan- (flo:make-nan #t #t 54321)))
+      (assert-eqv-nan (yes-traps (lambda () (flo:copysign nan+ x))) z)
+      (assert-eqv-nan (yes-traps (lambda () (flo:copysign nan- x))) z))))
+
+(define-enumerated-test 'copysign-snan/var
+  `((-inf.0 ,(flo:make-nan #t #f 54321))
+    (-1. ,(flo:make-nan #t #f 54321))
+    (-0. ,(flo:make-nan #t #f 54321))
+    (0. ,(flo:make-nan #f #f 54321))
+    (1. ,(flo:make-nan #f #f 54321))
+    (+inf.0 ,(flo:make-nan #f #f 54321))
+    (,(flo:make-nan #t #t 1234) ,(flo:make-nan #t #f 54321))
+    (,(flo:make-nan #f #t 1234) ,(flo:make-nan #f #f 54321))
+    (,(flo:make-nan #t #f 1234) ,(flo:make-nan #t #f 54321))
+    (,(flo:make-nan #f #f 1234) ,(flo:make-nan #f #f 54321)))
+  (lambda (x z)
+    (let ((nan+ (flo:make-nan #f #f 54321))
+          (nan- (flo:make-nan #t #f 54321)))
+      (assert-eqv-nan (yes-traps (lambda () (flo:copysign nan+ x))) z)
+      (assert-eqv-nan (yes-traps (lambda () (flo:copysign nan- x))) z))))
 
 (define-enumerated-test 'nextafter
   `((0. 1. ,subnormal+)