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 40bb648259e9c79a115f5b8f2ef664e9776b72f0..80c2cf312dda22c000b2a63c013481a1d1f8a056 100644 (file)
--- 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)