From: Taylor R Campbell <campbell@mumble.net>
Date: Wed, 28 Nov 2018 04:45:03 +0000 (+0000)
Subject: Test compiling in-line calls to the flonum comparators too.
X-Git-Tag: mit-scheme-pucked-10.1.7~3^2~157
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=368508d660b01fbfbfe732b9b56cfed12b68e7fc;p=mit-scheme.git

Test compiling in-line calls to the flonum comparators too.
---

diff --git a/tests/runtime/test-flonum.scm b/tests/runtime/test-flonum.scm
index 48f8342c6..f0cd3b48d 100644
--- a/tests/runtime/test-flonum.scm
+++ b/tests/runtime/test-flonum.scm
@@ -194,33 +194,44 @@ USA.
   (lambda (x n?)
     (assert-eqv (yes-traps (lambda () (flo:safe-negative? x))) n?)))
 
+(define-syntax define-comparison-test
+  (syntax-rules ()
+    ((define-comparison-test name safe-compare unsafe-compare cases)
+     (define-test name
+       (map (lambda (x)
+              (map (lambda (y)
+                     (lambda ()
+                       (assert-eqv
+                        (yes-traps (lambda () (safe-compare x y)))
+                        (if (or (flo:nan? x) (flo:nan? y))
+                            #f
+                            (unsafe-compare x y)))
+                       (assert-eqv
+                        (yes-traps (lambda () (not (safe-compare x y))))
+                        (if (or (flo:nan? x) (flo:nan? y))
+                            #t
+                            (not (unsafe-compare x y))))))
+                   cases))
+            cases)))))
+
 (let* ((subnormal+ flo:smallest-positive-subnormal)
        (subnormal- (no-traps (lambda () (- subnormal+))))
        (cases
         `(-inf.0 -1. ,subnormal- -0. +0. ,subnormal+ +1. +inf.0 +nan.0)))
-  (define (define-comparison-test name safe-compare unsafe-compare)
-    (define-test name
-      (map (lambda (x)
-             (map (lambda (y)
-                    (lambda ()
-                      (assert-eqv
-                       (yes-traps (lambda () (safe-compare x y)))
-                       (if (or (flo:nan? x) (flo:nan? y))
-                           #f
-                           (unsafe-compare x y)))))
-                  cases))
-           cases)))
-  (define-comparison-test '< flo:safe< flo:<)
-  (define-comparison-test '> flo:safe> flo:>)
-  (define-comparison-test '>= flo:safe>= flo:>=)
-  (define-comparison-test '<= flo:safe<= flo:<=)
-  (define-comparison-test '<> flo:safe<> flo:<>)
+  (define-comparison-test '< flo:safe< flo:< cases)
+  (define-comparison-test '> flo:safe> flo:> cases)
+  (define-comparison-test '>= flo:safe>= flo:>= cases)
+  (define-comparison-test '<= flo:safe<= flo:<= cases)
+  (define-comparison-test '<> flo:safe<> flo:<> cases)
   (define-test 'unordered?
     (map (lambda (x)
            (map (lambda (y)
                   (lambda ()
                     (assert-eqv (yes-traps (lambda () (flo:unordered? x y)))
-                                (or (flo:nan? x) (flo:nan? y)))))
+                                (or (flo:nan? x) (flo:nan? y)))
+                    (assert-eqv (yes-traps (lambda ()
+                                             (not (flo:unordered? x y))))
+                                (not (or (flo:nan? x) (flo:nan? y))))))
                 cases))
          cases))
   (define-test 'tetrachotomy