From f78c2f581b6ab8086c1ef636b078057ee6def823 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Thu, 20 Jun 2013 15:45:51 +0000 Subject: [PATCH] Tweak floenv tests so they preserve the floating-point environment. --- tests/runtime/test-floenv.scm | 30 ++++++++++++++---------------- 1 file changed, 14 insertions(+), 16 deletions(-) diff --git a/tests/runtime/test-floenv.scm b/tests/runtime/test-floenv.scm index 03d803349..123832943 100644 --- a/tests/runtime/test-floenv.scm +++ b/tests/runtime/test-floenv.scm @@ -57,9 +57,10 @@ USA. (define-test (symbol-append 'FLO:SET-ROUNDING-MODE ': mode) (lambda () (let ((mode* (flo:rounding-mode))) - (dynamic-wind (lambda () (flo:set-rounding-mode! mode)) - (lambda () (assert-eqv (flo:rounding-mode) mode)) - (lambda () (flo:set-rounding-mode! mode*))) + (flo:preserving-environment + (lambda () + (flo:set-rounding-mode! mode) + (assert-eqv (flo:rounding-mode) mode))) (assert-eqv (flo:rounding-mode) mode*)))))) (for-each-rounding-mode @@ -187,8 +188,7 @@ USA. (lambda () (flo:raise-exceptions! (flo:exception:invalid-operation)))) (define-fpe-elicitor 'INVALID-OPERATION 'ZERO-OVER-ZERO - (lambda () - (flo:/ (no-op 0.) (no-op 0.)))) + (lambda () (flo:/ (no-op 0.) (no-op 0.)))) (define-fpe-descriptor 'OVERFLOW #t flo:exception:overflow condition-type:floating-point-overflow) @@ -275,12 +275,10 @@ USA. (lambda () (let ((exceptions (to-trap)) (trapped (flo:trapped-exceptions))) - (dynamic-wind - (lambda () unspecific) - (lambda () + (flo:preserving-environment + (lambda () (assert-eqv (flo:set-trapped-exceptions! exceptions) trapped) - (assert-eqv (flo:trapped-exceptions) exceptions)) - (lambda () (flo:set-trapped-exceptions! trapped))))))) + (assert-eqv (flo:trapped-exceptions) exceptions))))))) (define (define-with-trapped-exceptions-test name to-trap) (define-test (symbol-append 'FLO:WITH-TRAPPED-EXCEPTIONS ': name) @@ -410,7 +408,9 @@ USA. (define-test 'FLO:SET-ENVIRONMENT (lambda () - (flo:set-environment! (flo:environment)))) + (flo:preserving-environment + (lambda () + (flo:set-environment! (flo:environment)))))) (define-test 'FLO:DEFAULT-ENVIRONMENT (lambda () @@ -418,11 +418,9 @@ USA. (define-test 'FLO:SET-DEFAULT-ENVIRONMENT (lambda () - (let ((environment (flo:environment))) - (dynamic-wind - (lambda () unspecific) - (lambda () (flo:set-environment! (flo:default-environment))) - (lambda () (flo:set-environment! environment)))))) + (flo:preserving-environment + (lambda () + (flo:set-environment! (flo:default-environment)))))) (define-test 'FLO:WITH-DEFAULT-ENVIRONMENT (lambda () -- 2.25.1