From 58898b5570924c3bef3477eeee4760f43d552c44 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Thu, 29 Nov 2018 02:57:09 +0000 Subject: [PATCH] sqrt is busted on infinities. --- tests/runtime/test-arith.scm | 47 +++++++++++++++++++++++++++++++++++- 1 file changed, 46 insertions(+), 1 deletion(-) diff --git a/tests/runtime/test-arith.scm b/tests/runtime/test-arith.scm index ccc6a15ed..de18b6854 100644 --- a/tests/runtime/test-arith.scm +++ b/tests/runtime/test-arith.scm @@ -56,11 +56,31 @@ USA. (define assert-real (predicate-assertion real? "real number")) +(define (eqv-nan? x y) + (if (and (flo:flonum? x) (flo:nan? x)) + (and (flo:flonum? y) + (flo:nan? y) + (eqv? (flo:safe-negative? x) (flo:safe-negative? y)) + (eqv? (flo:nan-quiet? x) (flo:nan-quiet? y)) + (eqv? (flo:nan-payload x) (flo:nan-payload y))) + (and (not (and (flo:flonum? y) (flo:nan? y))) + (eqv? x y)))) + +(define-comparator eqv-nan? 'eqv-nan?) + +(define assert-eqv-nan + (simple-binary-assertion eqv-nan? #f)) + (define (with-expected-failure xfail body) (if (default-object? xfail) (body) (xfail body))) +(define (no-traps f) + (if (flo:have-trap-enable/disable?) + (flo:with-trapped-exceptions 0 f) + (f))) + (define (define-enumerated-test prefix cases procedure) (for-each (lambda (arguments) (define-test (symbol prefix '/ arguments) @@ -625,4 +645,29 @@ USA. (list -inf.0-inf.0i (* pi -3/4)) (list -inf.0+inf.0i (* pi 3/4))) (lambda (z t) - (assert-<= (relerr t (angle z)) 1e-15))) \ No newline at end of file + (assert-<= (relerr t (angle z)) 1e-15))) + +(define-enumerated-test 'sqrt + `((0 0) + (0. 0.) + (1 1) + (1. 1.) + (4 2) + (4. 2.) + (-inf.0 +inf.0i) + (+inf.0 +inf.0) + (-inf.0+1.i +inf.0i ,expect-failure) + (+inf.0+1.i +inf.0 ,expect-failure) + (-inf.0-1.i +inf.0i ,expect-failure) + (+inf.0-1.i +inf.0 ,expect-failure) + (-inf.0i -inf.0+inf.0i ,expect-failure) + (+inf.0i +inf.0+inf.0i) + (1.-inf.0i -inf.0+inf.0i ,expect-failure) + (1.+inf.0i +inf.0+inf.0i) + (-1.-inf.0i -inf.0+inf.0i ,expect-failure) + (-1.+inf.0i +inf.0+inf.0i) + (,(flo:qnan 1234) ,(flo:qnan 1234))) + (lambda (z r #!optional xfail) + (with-expected-failure xfail + (lambda () + (assert-eqv-nan (no-traps (lambda () (sqrt z))) r))))) \ No newline at end of file -- 2.25.1