diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-06-23 23:52:12 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-06-23 23:52:12 +0200 |
commit | afce9b3685f9440f02f822c6c1909faf47d7f950 (patch) | |
tree | b14846e75b0d8ae999081f74612a3f647e711e7f | |
parent | Move (date|time)-zero? higher up in datetime. (diff) | |
download | calp-afce9b3685f9440f02f822c6c1909faf47d7f950.tar.gz calp-afce9b3685f9440f02f822c6c1909faf47d7f950.tar.xz |
Update test-runner.
Diffstat (limited to '')
-rwxr-xr-x | tests/run-tests.scm | 37 |
1 files changed, 28 insertions, 9 deletions
diff --git a/tests/run-tests.scm b/tests/run-tests.scm index a3058465..919fc5b5 100755 --- a/tests/run-tests.scm +++ b/tests/run-tests.scm @@ -78,7 +78,17 @@ fi => (lambda (p) (with-output-to-string (lambda () (display (bold "[SOURCE]: ")) (truncated-print p)))))))) (when (eq? 'fail (test-result-kind)) (cond ((test-result-ref runner 'actual-error) - => (lambda (err) (format #t "~aError: ~s~%" (make-indent (1+ depth)) err))) + => (lambda (err) + (if (and (list? err) + (= 5 (length err))) + (let ((err (list-ref err 0)) + (proc (list-ref err 1)) + (fmt (list-ref err 2)) + (args (list-ref err 3))) + (format #t "~a~a in ~a: ~?~%" + (make-indent (1+ depth)) + err proc fmt args)) + (format #t "~aError: ~s~%" (make-indent (1+ depth)) err)))) (else (format #t "~aExpected: ~s~%~aReceived: ~s~%" (make-indent (1+ depth)) (test-result-ref runner 'expected-value "[UNKNOWN]") @@ -207,15 +217,24 @@ fi (lambda (thunk) (thunk)) )) +;;; Catch/print-trace should intercept thrown exceptions, print them prettily with a stack trace, and then continue + +#; +(define (catch/print-trace proc) + (catch #t proc + (case-lambda + ((err from msg args data) + (test-assert (format #f "~a in ~a: ~?" err from msg args) + #f)) + (args + (test-assert (format #f "~a (~s)" f args) + #f))))) + +(define (catch/print-trace proc) + (proc)) + (test-begin "suite") -(finalizer (lambda () (for-each (lambda (f) (catch #t (lambda () (test-group f (load f))) - (case-lambda - ((err from msg args data) - (test-assert (format #f "~a in ~a: ~?" err from msg args) - #f)) - (args - (test-assert (format #f "~a (~s)" f args) - #f))))) +(finalizer (lambda () (for-each (lambda (f) (catch/print-trace (lambda () (test-group f (load f))))) files))) (test-end "suite") |