From: Taylor R Campbell <campbell@mumble.net>
Date: Wed, 28 Nov 2018 02:10:00 +0000 (+0000)
Subject: Test for exceptions from ordered comparisons.
X-Git-Tag: mit-scheme-pucked-10.1.7~3^2~167
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=58e70844df0171d5723592d11c0d2591340dafb8;p=mit-scheme.git

Test for exceptions from ordered comparisons.

These are currently broken at least on x86 because the compiler
generates the wrong instructions.

When we switch the compiler to generating the right ones we may need to
adjust the runtime to use flo:safeX in certain places.
---

diff --git a/tests/microcode/test-flonum-except.scm b/tests/microcode/test-flonum-except.scm
index 40bb64825..80c2cf312 100644
--- a/tests/microcode/test-flonum-except.scm
+++ b/tests/microcode/test-flonum-except.scm
@@ -106,6 +106,15 @@ USA.
     condition-type:invalid-floating-point-operation
     procedure xfail))
 
+(define (define-invop-compare-test name procedure #!optional xfail)
+  (define-exception-flag-test name 'invalid-operation
+    (flo:exception:invalid-operation)
+    assert-false procedure xfail)
+  (define-exception-trap-test name 'invalid-operation
+    (flo:exception:invalid-operation)
+    condition-type:invalid-floating-point-operation
+    procedure xfail))
+
 (define (define-divbyzero-flag-test name procedure #!optional xfail)
   (define-exception-flag-test name 'divide-by-zero
     (flo:exception:divide-by-zero)
@@ -265,3 +274,23 @@ USA.
 ;; XXX Not clear how to make atan underflow reliably.
 
 ;; XXX sinh, cosh, tanh, asinh, acosh, atanh
+
+(define-invop-compare-test 'flo:= (applicator flo:= 0. +nan.0) expect-failure)
+(define-invop-compare-test 'flo:= (applicator flo:= +nan.0 0.) expect-failure)
+(define-invop-compare-test 'flo:= (applicator flo:= +nan.0 +nan.0) expect-failure)
+
+(define-invop-compare-test 'flo:< (applicator flo:< 0. +nan.0) expect-failure)
+(define-invop-compare-test 'flo:< (applicator flo:< +nan.0 0.) expect-failure)
+(define-invop-compare-test 'flo:< (applicator flo:< +nan.0 +nan.0) expect-failure)
+
+(define-invop-compare-test 'flo:> (applicator flo:> 0. +nan.0) expect-failure)
+(define-invop-compare-test 'flo:> (applicator flo:> +nan.0 0.) expect-failure)
+(define-invop-compare-test 'flo:> (applicator flo:> +nan.0 +nan.0) expect-failure)
+
+(define-invop-compare-test 'flo:<= (applicator flo:<= 0. +nan.0) expect-failure)
+(define-invop-compare-test 'flo:<= (applicator flo:<= +nan.0 0.) expect-failure)
+(define-invop-compare-test 'flo:<= (applicator flo:<= +nan.0 +nan.0) expect-failure)
+
+(define-invop-compare-test 'flo:>= (applicator flo:>= 0. +nan.0) expect-failure)
+(define-invop-compare-test 'flo:>= (applicator flo:>= +nan.0 0.) expect-failure)
+(define-invop-compare-test 'flo:>= (applicator flo:>= +nan.0 +nan.0) expect-failure)