From afce9b3685f9440f02f822c6c1909faf47d7f950 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 23 Jun 2022 23:52:12 +0200 Subject: Update test-runner. --- tests/run-tests.scm | 37 ++++++++++++++++++++++++++++--------- 1 file 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") -- cgit v1.2.3