From a03995e6513743d824208444ba8f80d2f6e416a8 Mon Sep 17 00:00:00 2001
From: Taylor R Campbell <campbell@mumble.net>
Date: Sun, 25 Aug 2019 18:35:37 +0000
Subject: [PATCH] Show for which parameters the test failed.
---
tests/runtime/test-flonum.scm | 57 ++++++++++++++++++-----------------
1 file changed, 30 insertions(+), 27 deletions(-)
diff --git a/tests/runtime/test-flonum.scm b/tests/runtime/test-flonum.scm
index 6a2146fcb..91b43ca21 100644
--- a/tests/runtime/test-flonum.scm
+++ b/tests/runtime/test-flonum.scm
@@ -618,33 +618,36 @@ USA.
(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))))
- (if (safe-compare x y)
- (begin
- (assert-true (not (flo:nan? x)))
- (assert-true (not (flo:nan? y)))
- (assert-true (unsafe-compare x y))))
- (if (not (safe-compare x y))
- (begin
- (assert-true
- (or (flo:nan? x)
- (flo:nan? y)
- (not (unsafe-compare x y))))))
- (if (not (or (flo:nan? x) (flo:nan? y)))
- (begin
- (if (unsafe-compare x y)
- (assert-true (safe-compare x y)))
- (if (not (unsafe-compare x y))
- (assert-false (safe-compare x y)))))))
+ (with-test-properties
+ (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))))
+ (if (safe-compare x y)
+ (begin
+ (assert-true (not (flo:nan? x)))
+ (assert-true (not (flo:nan? y)))
+ (assert-true (unsafe-compare x y))))
+ (if (not (safe-compare x y))
+ (begin
+ (assert-true
+ (or (flo:nan? x)
+ (flo:nan? y)
+ (not (unsafe-compare x y))))))
+ (if (not (or (flo:nan? x) (flo:nan? y)))
+ (begin
+ (if (unsafe-compare x y)
+ (assert-true (safe-compare x y)))
+ (if (not (unsafe-compare x y))
+ (assert-false (safe-compare x y))))))
+ 'SEED (list x y))))
cases))
cases)))))
--
2.25.1