summaryrefslogtreecommitdiff
path: root/build-aux
diff options
context:
space:
mode:
Diffstat (limited to 'build-aux')
-rw-r--r--build-aux/test-driver.scm.in32
1 files changed, 20 insertions, 12 deletions
diff --git a/build-aux/test-driver.scm.in b/build-aux/test-driver.scm.in
index 2994739..9263707 100644
--- a/build-aux/test-driver.scm.in
+++ b/build-aux/test-driver.scm.in
@@ -41,26 +41,34 @@
(enable-hard-errors (value #t))))
(define (my-gnu-runner log-port trs-port)
- (let ((runner (test-runner-simple)))
+ (let ((runner (test-runner-null)))
(test-runner-on-group-begin! runner
(lambda (runner suite-name count)
- (format #t "%%%% Starting test ~a~%" suite-name)
- (format log-port "%%%% Starting test ~a~%" suite-name)
- ;; Set log-port in the aux-value field for use by other parts
- ;; of test-runner-simple
- (test-runner-aux-value! runner log-port)
- (format #t " (Writing full log to \"~a\")~%" (port-filename log-port))))
- (test-runner-on-group-end! runner (const #f))
+ (format #t "%%%% ~a~%" suite-name)))
+ (test-runner-on-group-end! runner
+ (lambda _
+ (newline)))
(test-runner-on-test-end! runner
(lambda (runner)
(let ((name (test-runner-test-name runner))
(result (string-upcase
- (symbol->string (test-result-kind runner)))))
+ (symbol->string (test-result-kind runner))))
+ (result-alist (test-result-alist runner)))
(format trs-port ":test-result: ~a ~a~%" result name)
- (format (current-error-port)
- "\x1b[~:[31~;32~]m~a\x1b[0m ~a~%"
+ (format #t "\x1b[~:[31~;32~]m~a\x1b[0m ~a~%"
(eq? (test-result-kind runner) 'pass)
- result name))))
+ result name)
+ (format log-port "~a ~a~%" result name)
+ ;; If test did not pass, print details.
+ (unless (eq? (test-result-kind runner) 'pass)
+ (let ((log-output
+ (format #f "~a:~a~%expected: ~s~%actual: ~s~%"
+ (assq-ref result-alist 'source-file)
+ (assq-ref result-alist 'source-line)
+ (assq-ref result-alist 'expected-value)
+ (assq-ref result-alist 'actual-value))))
+ (display log-output log-port)
+ (display log-output (current-error-port)))))))
runner))
(let ((opts (getopt-long (command-line) %options)))