From: Taylor R Campbell Date: Tue, 27 Nov 2018 02:25:20 +0000 (+0000) Subject: Define expect-error as an alias for assert-error. X-Git-Tag: mit-scheme-pucked-10.1.7~3^2~168 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=099108f7e11cd9becf572ae2f8b66c2059d1b8e1;p=mit-scheme.git Define expect-error as an alias for assert-error. The difference is in intent: expect-error means something is broken, and the test signals an error because of a bug; assert-error means the correct behaviour is to signal an error. Pass expect-error or expect-failure as procedures, not as symbols representing them, throughout the test suite. Now we can find documented bugs by grepping for expect-error and expect-failure. --- diff --git a/tests/microcode/test-flonum-except.scm b/tests/microcode/test-flonum-except.scm index 8bf8502fe..40bb64825 100644 --- a/tests/microcode/test-flonum-except.scm +++ b/tests/microcode/test-flonum-except.scm @@ -55,14 +55,13 @@ USA. (define assert-nothing (predicate-assertion (lambda (x) x #t) "nothing")) -(define (with-failure-expected xfail? procedure) - (case xfail? - ((xfail) (expect-failure procedure)) - ((xerror) (assert-error procedure)) - (else (procedure)))) +(define (with-failure-expected xfail procedure) + (if (default-object? xfail) + (procedure) + (xfail procedure))) (define (define-exception-flag-test name excname exception assertion procedure - #!optional xfail?) + #!optional xfail) (define-test (symbol name '/ excname '/ 'flag) (lambda () (flo:preserving-environment @@ -73,21 +72,21 @@ USA. (flo:with-exceptions-untrapped (flo:supported-exceptions) body) (body))) (lambda () - (with-failure-expected xfail? + (with-failure-expected xfail (lambda () (assertion (procedure)) (assert-nonzero (flo:test-exceptions exception))))))))))) (define (define-exception-trap-test name excname exception condition-type - procedure #!optional xfail?) + procedure #!optional xfail) (define-test (symbol name '/ excname '/ 'trap) (lambda () (flo:preserving-environment (lambda () (with-failure-expected (if (flo:have-trap-enable/disable?) - xfail? - 'xerror) + xfail + assert-error) (lambda () (assert-error (lambda () @@ -96,54 +95,54 @@ USA. (flo:with-exceptions-trapped exception procedure)))) (list condition-type))))))))) -(define (define-invop-flag-test name procedure #!optional xfail?) +(define (define-invop-flag-test name procedure #!optional xfail) (define-exception-flag-test name 'invalid-operation (flo:exception:invalid-operation) - assert-nan procedure xfail?)) + assert-nan procedure xfail)) -(define (define-invop-trap-test name procedure #!optional xfail?) +(define (define-invop-trap-test name procedure #!optional xfail) (define-exception-trap-test name 'invalid-operation (flo:exception:invalid-operation) condition-type:invalid-floating-point-operation - procedure xfail?)) + procedure xfail)) -(define (define-divbyzero-flag-test name procedure #!optional xfail?) +(define (define-divbyzero-flag-test name procedure #!optional xfail) (define-exception-flag-test name 'divide-by-zero (flo:exception:divide-by-zero) - assert-inf procedure xfail?)) + assert-inf procedure xfail)) -(define (define-divbyzero-trap-test name procedure #!optional xfail?) +(define (define-divbyzero-trap-test name procedure #!optional xfail) (define-exception-trap-test name 'divide-by-zero (flo:exception:divide-by-zero) condition-type:floating-point-divide-by-zero - procedure xfail?)) + procedure xfail)) -(define (define-overflow-flag-test name procedure #!optional xfail?) +(define (define-overflow-flag-test name procedure #!optional xfail) (define-exception-flag-test name 'overflow (flo:exception:overflow) - assert-inf procedure xfail?)) + assert-inf procedure xfail)) -(define (define-overflow-trap-test name procedure #!optional xfail?) +(define (define-overflow-trap-test name procedure #!optional xfail) (define-exception-trap-test name 'overflow (flo:exception:overflow) condition-type:floating-point-overflow - procedure xfail?)) + procedure xfail)) -(define (define-underflow-flag-test name procedure #!optional xfail?) +(define (define-underflow-flag-test name procedure #!optional xfail) (define-exception-flag-test name 'underflow (flo:exception:underflow) - assert-subnormal procedure xfail?)) + assert-subnormal procedure xfail)) -(define (define-underflow-trap-test name procedure #!optional xfail?) +(define (define-underflow-trap-test name procedure #!optional xfail) (define-exception-trap-test name 'underflow (flo:exception:underflow) condition-type:floating-point-underflow - procedure xfail?)) + procedure xfail)) -(define (define-inexact-flag-test name procedure #!optional xfail?) +(define (define-inexact-flag-test name procedure #!optional xfail) (define-exception-flag-test name 'inexact-result (flo:exception:inexact-result) - assert-nothing procedure xfail?)) + assert-nothing procedure xfail)) (define (applicator procedure . arguments) (lambda () diff --git a/tests/runtime/test-arith.scm b/tests/runtime/test-arith.scm index 8c7fbbb75..eefe322e5 100644 --- a/tests/runtime/test-arith.scm +++ b/tests/runtime/test-arith.scm @@ -74,11 +74,10 @@ USA. (define assert-subnormal (predicate-assertion flo:subnormal? "subnormal floating-point number")) -(define (with-expected-failure xfail? body) - (case xfail? - ((xfail) (expect-failure body)) - ((xerror) (assert-error body)) - (else (body)))) +(define (with-expected-failure xfail body) + (if (default-object? xfail) + (body) + (xfail body))) (define (define-enumerated-test prefix elements procedure) (let ((n (vector-length elements))) @@ -280,8 +279,8 @@ USA. (lambda (v) (let ((x (car v)) (z (cadr v)) - (xfail? (if (pair? (cddr v)) (caddr v) #f))) - (with-expected-failure xfail? + (xfail (if (pair? (cddr v)) (caddr v) #!default))) + (with-expected-failure xfail (lambda () (assert-<= (relerr z (log1p x)) 1e-15)))))) @@ -537,29 +536,29 @@ USA. (vector -1+i -.6662394324925153+1.0612750619050357i) (vector -1-i -.6662394324925153-1.0612750619050357i) (vector 1-i .6662394324925153-1.0612750619050357i) - (vector 2 1.5707963267948966+1.3169578969248166i 'xfail) + (vector 2 1.5707963267948966+1.3169578969248166i expect-failure) (vector 2.+0.i 1.5707963267948966+1.3169578969248166i) (vector 2.-0.i 1.5707963267948966-1.3169578969248166i) (vector -2 -1.5707963267948966+1.3169578969248166i) (vector -2.+0.i -1.5707963267948966+1.3169578969248166i) (vector -2.-0.i -1.5707963267948966-1.3169578969248166i) - (vector 1e150 1.5707963267948966+346.0809111296668i 'xfail) - (vector 1e150+0.i 1.5707963267948966+346.0809111296668i 'xfail) + (vector 1e150 1.5707963267948966+346.0809111296668i expect-failure) + (vector 1e150+0.i 1.5707963267948966+346.0809111296668i expect-failure) (vector 1e150-0.i 1.5707963267948966-346.0809111296668i) (vector -1e150 -1.5707963267948966+346.0809111296668i) (vector -1e150+0.i -1.5707963267948966+346.0809111296668i) - (vector -1e150-0.i -1.5707963267948966-346.0809111296668i 'xfail) - (vector 1e300 1.5707963267948966+691.4686750787736i 'xfail) - (vector 1e300+0.i 1.5707963267948966+691.4686750787736i 'xfail) + (vector -1e150-0.i -1.5707963267948966-346.0809111296668i expect-failure) + (vector 1e300 1.5707963267948966+691.4686750787736i expect-failure) + (vector 1e300+0.i 1.5707963267948966+691.4686750787736i expect-failure) (vector 1e300-0.i 1.5707963267948966-691.4686750787736i) (vector -1e300 -1.5707963267948966+691.4686750787736i) (vector -1e300+0.i -1.5707963267948966+691.4686750787736i) - (vector -1e300-0.i -1.5707963267948966-691.4686750787736i 'xfail)) + (vector -1e300-0.i -1.5707963267948966-691.4686750787736i expect-failure)) (lambda (v) (let ((x (vector-ref v 0)) (t (vector-ref v 1)) - (xfail? (if (<= 3 (vector-length v)) (vector-ref v 2) #f))) - (with-expected-failure xfail? + (xfail (if (<= 3 (vector-length v)) (vector-ref v 2) #!default))) + (with-expected-failure xfail (lambda () (assert-<= (relerr t (asin x)) 1e-14)))))) @@ -584,7 +583,7 @@ USA. (vector -1+i 2.2370357592874117-1.0612750619050357i) (vector -1-i 2.2370357592874117+1.0612750619050355i) (vector 1-i .9045568943023814+1.0612750619050355i) - (vector 2 (* +i (log (- 2 (sqrt 3)))) 'xfail) + (vector 2 (* +i (log (- 2 (sqrt 3)))) expect-failure) (vector 2.+0.i (* +i (log (- 2 (sqrt 3))))) (vector 2.-0.i (* -i (log (- 2 (sqrt 3))))) (vector -2 (+ pi (* +i (log (- 2 (sqrt 3)))))) @@ -594,23 +593,23 @@ USA. ;; \approx -i log(z + sqrt(z^2)) ;; = -i log(z + z) ;; = -i log(2 z) - (vector 1e150 (* +i (log (* 2 1e150))) 'xfail) - (vector 1e150+0.i (* +i (log (* 2 1e150))) 'xfail) - (vector 1e150-0.i (* -i (log (* 2 1e150))) 'xfail) - (vector -1e150 (+ pi (* +i (log (* 2 1e150)))) 'xfail) - (vector -1e150+0.i (+ pi (* +i (log (* 2 1e150)))) 'xfail) - (vector -1e150-0.i (+ pi (* -i (log (* 2 1e150)))) 'xfail) - (vector 1e300 (* +i (log (* 2 1e300))) 'xfail) - (vector 1e300+0.i (* +i (log (* 2 1e300))) 'xfail) - (vector 1e300-0.i (* -i (log (* 2 1e300))) 'xfail) - (vector -1e300 (+ pi (* +i (log (* 2 1e300)))) 'xfail) - (vector -1e300+0.i (+ pi (* +i (log (* 2 1e300)))) 'xfail) - (vector -1e300-0.i (+ pi (* -i (log (* 2 1e300)))) 'xfail)) + (vector 1e150 (* +i (log (* 2 1e150))) expect-failure) + (vector 1e150+0.i (* +i (log (* 2 1e150))) expect-failure) + (vector 1e150-0.i (* -i (log (* 2 1e150))) expect-failure) + (vector -1e150 (+ pi (* +i (log (* 2 1e150)))) expect-failure) + (vector -1e150+0.i (+ pi (* +i (log (* 2 1e150)))) expect-failure) + (vector -1e150-0.i (+ pi (* -i (log (* 2 1e150)))) expect-failure) + (vector 1e300 (* +i (log (* 2 1e300))) expect-failure) + (vector 1e300+0.i (* +i (log (* 2 1e300))) expect-failure) + (vector 1e300-0.i (* -i (log (* 2 1e300))) expect-failure) + (vector -1e300 (+ pi (* +i (log (* 2 1e300)))) expect-failure) + (vector -1e300+0.i (+ pi (* +i (log (* 2 1e300)))) expect-failure) + (vector -1e300-0.i (+ pi (* -i (log (* 2 1e300)))) expect-failure)) (lambda (v) (let ((x (vector-ref v 0)) (t (vector-ref v 1)) - (xfail? (if (<= 3 (vector-length v)) (vector-ref v 2) #f))) - (with-expected-failure xfail? + (xfail (if (<= 3 (vector-length v)) (vector-ref v 2) #!default))) + (with-expected-failure xfail (lambda () (assert-<= (relerr t (acos x)) 1e-14)))))) @@ -645,8 +644,8 @@ USA. (lambda (v) (let ((x (vector-ref v 0)) (t (vector-ref v 1)) - (xfail? (if (<= 3 (vector-length v)) (vector-ref v 2) #f))) - (with-expected-failure xfail? + (xfail (if (<= 3 (vector-length v)) (vector-ref v 2) #!default))) + (with-expected-failure xfail (lambda () (assert-<= (relerr t (atan x)) 1e-15)))))) diff --git a/tests/runtime/test-numpar.scm b/tests/runtime/test-numpar.scm index c39fd7366..ddaef1b85 100644 --- a/tests/runtime/test-numpar.scm +++ b/tests/runtime/test-numpar.scm @@ -28,23 +28,22 @@ USA. (declare (usual-integrations)) -(define (define-eqv-test s v #!optional xfail?) - (define-eqv-test-1 s v xfail?) +(define (define-eqv-test s v #!optional xfail) + (define-eqv-test-1 s v xfail) (if (not (string=? s (string-upcase s))) - (define-eqv-test-1 (string-upcase s) v xfail?))) + (define-eqv-test-1 (string-upcase s) v xfail))) -(define (define-eqv-test-1 s v #!optional xfail?) +(define (define-eqv-test-1 s v #!optional xfail) (define-test s (lambda () - (with-xfail xfail? + (with-xfail xfail (lambda () (assert-eqv (string->number s) v)))))) -(define (with-xfail xfail? body) - (case xfail? - ((xfail) (expect-failure body)) - ((xerror) (assert-error body)) - (else (body)))) +(define (with-xfail xfail body) + (if (default-object? xfail) + (body) + (xfail body))) (define-eqv-test "#e1e9" (expt 10 9)) (define-eqv-test "#e1f9" (expt 10 9)) diff --git a/tests/runtime/test-readwrite.scm b/tests/runtime/test-readwrite.scm index 1b098e133..691a069b2 100644 --- a/tests/runtime/test-readwrite.scm +++ b/tests/runtime/test-readwrite.scm @@ -36,11 +36,10 @@ USA. 'DESCRIPTION (write-to-string casen)))) cases))) -(define (with-expected-failure xfail? body) - (case xfail? - ((xfail) (expect-failure body)) - ((xerror) (assert-error body)) - (else (body)))) +(define (with-expected-failure xfail body) + (if (default-object? xfail) + (body) + (xfail body))) (define assert-nan (predicate-assertion nan? "NaN")) @@ -122,8 +121,8 @@ USA. ("|\"|" ,assert-symbol) ("|\\\||" ,assert-symbol) ("|\\\\|" ,assert-symbol)) - (lambda (string #!optional assertion xfail?) - (with-expected-failure xfail? + (lambda (string #!optional assertion xfail) + (with-expected-failure xfail (lambda () (let ((object (read-from-string string))) (assertion object) @@ -161,8 +160,8 @@ USA. ("#x-inf.0-inf.0i" ,assert-complex-nonreal) ("#x+inf.0+nan.0i" ,assert-complex-nonreal) ("#x+nan.0+inf.0i" ,assert-complex-nonreal)) - (lambda (string #!optional assertion xfail?) - (with-expected-failure xfail? + (lambda (string #!optional assertion xfail) + (with-expected-failure xfail (lambda () (let ((object (parameterize ((param:reader-radix #x10)) @@ -176,7 +175,7 @@ USA. (define-enumerated-test 'read `(("+nan.0" ,assert-nan) ("-nan.0" ,assert-nan)) - (lambda (string assertion #!optional xfail?) - (with-expected-failure xfail? + (lambda (string assertion #!optional xfail) + (with-expected-failure xfail (lambda () (assertion (read-from-string string)))))) \ No newline at end of file diff --git a/tests/runtime/test-syntax.scm b/tests/runtime/test-syntax.scm index ffa39e411..c216b3591 100644 --- a/tests/runtime/test-syntax.scm +++ b/tests/runtime/test-syntax.scm @@ -33,7 +33,7 @@ USA. (define-test 'local-define-syntax/syntax (lambda () - (assert-error + (expect-error (lambda () (assert-equal (unsyntax @@ -46,7 +46,7 @@ USA. (define-test 'local-define-syntax/eval (lambda () - (assert-error + (expect-error (lambda () (assert-equal (eval '(let () @@ -95,7 +95,7 @@ USA. (define-test 'quoted-macro-name (lambda () - (assert-error + (expect-error (lambda () (assert-equal (unsyntax diff --git a/tests/unit-testing.scm b/tests/unit-testing.scm index 9e06ce15e..05eeac6e3 100644 --- a/tests/unit-testing.scm +++ b/tests/unit-testing.scm @@ -449,6 +449,8 @@ USA. (define-for-tests expect-failure (error-assertion condition-type:failure)) +(define-for-tests expect-error assert-error) + (define-for-tests keep-it-fast!? (let ((v (get-environment-variable "FAST"))) (if (or (eq? v #f) (string-null? v))