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 8bf8502feeb455969760c9b958ad7be4e8c90e6a..40bb648259e9c79a115f5b8f2ef664e9776b72f0 100644 (file)
--- 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 8c7fbbb75ffb9ee32b68780a2b98ee80b2ee15eb..eefe322e5351772eeadea2b969c351fee8b81eff 100644 (file)
--- 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 c39fd73664d0f2dd2c300a865804d94c1a28c142..ddaef1b85b7e8715603e4aedf5055e3bf9e7b943 100644 (file)
--- a/tests/runtime/test-numpar.scm
+++ b/tests/runtime/test-numpar.scm
@@ -28,23 +28,22 @@ USA.
 
 (declare (usual-integrations))
 \f
-(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 1b098e133ca3faff602b025b6cd2d56177dd0d30..691a069b2778e460ac809da7b0fec601d45e177d 100644 (file)
--- 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 ffa39e4114c93c9cfc4769a5ca406b9c1f34a8bb..c216b359166f17b62f036eb9156532e14555db65 100644 (file)
--- 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 9e06ce15e58ff0db56780bb1640aec7fc1043026..05eeac6e3547fc98fac861741df59adda0a94ab6 100644 (file)
--- 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))