diff options
author | Andy Wingo <wingo@pobox.com> | 2012-02-24 19:58:45 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2012-02-24 19:58:45 +0100 |
commit | 006163e02febaf5569bd42b362957a99c01c4528 (patch) | |
tree | 6d0fd0ee50b209a1449e8583eab0aaf365557767 | |
parent | a2e946f1ef83cd1fd8c87412cc49f6c6d1e0ac61 (diff) | |
download | guile-006163e02febaf5569bd42b362957a99c01c4528.tar.gz |
slight cleanup to run-test
* test-suite/lib.scm (run-test): Slight cleanup.
-rw-r--r-- | test-suite/lib.scm | 55 |
1 files changed, 27 insertions, 28 deletions
diff --git a/test-suite/lib.scm b/test-suite/lib.scm index 681a0d158..5785378ad 100644 --- a/test-suite/lib.scm +++ b/test-suite/lib.scm @@ -314,34 +314,33 @@ ;;; The central testing routine. ;;; The idea is taken from Greg, the GNUstep regression test environment. -(define run-test #f) -(let ((test-running #f)) - (define (local-run-test name expect-pass thunk) - (if test-running - (error "Nested calls to run-test are not permitted.") - (let ((test-name (full-name name))) - (set! test-running #t) - (catch #t - (lambda () - (let ((result (thunk))) - (if (eq? result #t) (throw 'pass)) - (if (eq? result #f) (throw 'fail)) - (throw 'unresolved))) - (lambda (key . args) - (case key - ((pass) - (report (if expect-pass 'pass 'upass) test-name)) - ((fail) - (report (if expect-pass 'fail 'xfail) test-name)) - ((unresolved untested unsupported) - (report key test-name)) - ((quit) - (report 'unresolved test-name) - (quit)) - (else - (report 'error test-name (cons key args)))))) - (set! test-running #f)))) - (set! run-test local-run-test)) +(define run-test + (let ((test-running #f)) + (lambda (name expect-pass thunk) + (if test-running + (error "Nested calls to run-test are not permitted.")) + (let ((test-name (full-name name))) + (set! test-running #t) + (catch #t + (lambda () + (let ((result (thunk))) + (if (eq? result #t) (throw 'pass)) + (if (eq? result #f) (throw 'fail)) + (throw 'unresolved))) + (lambda (key . args) + (case key + ((pass) + (report (if expect-pass 'pass 'upass) test-name)) + ((fail) + (report (if expect-pass 'fail 'xfail) test-name)) + ((unresolved untested unsupported) + (report key test-name)) + ((quit) + (report 'unresolved test-name) + (quit)) + (else + (report 'error test-name (cons key args)))))) + (set! test-running #f))))) ;;; A short form for tests that are expected to pass, taken from Greg. (define-syntax pass-if |