diff --git a/testing.scm b/testing.scm index aa3f0c5..1950789 100644 --- a/testing.scm +++ b/testing.scm @@ -22,9 +22,10 @@ ;; (module testing - (test-eq? test-equal? test-exn) + (test-eq? test-equal? test-exn run-tests) - (import scheme) + (import scheme + (chicken condition)) ;; Evaluates body ... expressions with exception handler installed. (define-syntax with-handler @@ -40,21 +41,23 @@ ;; is eq? to expected-result. (define-syntax test-eq? (syntax-rules () - ((_ name the-test expected-result) - (if (with-handler (lambda (x) #f) - (eq? the-test expected-result)) - (display ".") - (error 'unit-test name))))) + ((_ name expression expected-result) + (let ((result expression)) + (if (equal? result expected-result) + (display ".") + (error 'test-eq? (sprintf "~A expression=~S expected-result=~S result=~S" + 'name 'expression expected-result result))))))) ;; Test passes if the-test does not raise an exception and the result ;; is equal? to expected-result. (define-syntax test-equal? (syntax-rules () - ((_ name the-test expected-result) - (if (with-handler (lambda (x) #f) - (eq? the-test expected-result)) - (display ".") - (error 'unit-test name))))) + ((_ name expression expected-result) + (let ((result expression)) + (if (equal? result expected-result) + (display ".") + (error 'test-equal? (sprintf "~A expression=~S expected-result=~S result=~S" + 'name 'expression expected-result result))))))) ;; Passes if the-test raises an exception (define-syntax test-exn @@ -65,4 +68,14 @@ (display ".") (error 'unit-test name))))) + ;; Displays test specification, evaluates all body ... expressions + ;; and prints "ok." at the and of the line if all succeed. + (define-syntax run-tests + (syntax-rules () + ((_ name body ...) + (let () + (display (sprintf "[test] ~A " 'name)) + body ... + (print " ok."))))) + )