From c90eb25e9c5d4143801f72827109c1e6919e5d32 Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Mon, 19 Jul 2021 15:07:26 +0530
Subject: build-aux: Improve test driver output.

The test driver output is now much cleaner, and actually logs expected
and actual values of failing tests.

* build-aux/test-driver.scm.in (my-gnu-runner): Inherit from
test-runner-null, and improve output.
---
 build-aux/test-driver.scm.in | 32 ++++++++++++++++++++------------
 1 file changed, 20 insertions(+), 12 deletions(-)

(limited to 'build-aux')

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)))
-- 
cgit v1.2.3