mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 22:10:21 +02:00
Code Activity

slight cleanup to run-test

Browse source 
* test-suite/lib.scm (run-test): Slight cleanup.
This commit is contained in:
Andy Wingo 2012-02-24 19:58:45 +01:00
parent a2e946f1ef
commit 006163e02f
1 changed files with 27 additions and 28 deletions
Download patch file Download diff file Expand all files Collapse all files

9
test-suite/lib.scm
View file

@ -314,11 +314,11 @@
;;; The central testing routine. ;;; The central testing routine.
;;; The idea is taken from Greg, the GNUstep regression test environment. ;;; The idea is taken from Greg, the GNUstep regression test environment.
(define run-test #f) (define run-test
(let ((test-running #f)) (let ((test-running #f))
(define (local-run-test name expect-pass thunk) (lambda (name expect-pass thunk)
(if test-running (if test-running
(error "Nested calls to run-test are not permitted.") (error "Nested calls to run-test are not permitted."))
(let ((test-name (full-name name))) (let ((test-name (full-name name)))
(set! test-running #t) (set! test-running #t)
(catch #t (catch #t
@ -340,8 +340,7 @@
(quit)) (quit))
(else (else
(report 'error test-name (cons key args)))))) (report 'error test-name (cons key args))))))
(set! test-running #f)))) (set! test-running #f)))))
(set! run-test local-run-test))
;;; A short form for tests that are expected to pass, taken from Greg. ;;; A short form for tests that are expected to pass, taken from Greg.
(define-syntax pass-if (define-syntax pass-if