Streamline testing framework.

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.")))))
+
  )