From fa6fa59edff4b9f148cbed5d56a322714a99933f Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Sun, 23 Jan 2022 17:36:44 +0530
Subject: bin: Move to pytest-like output.

Move to a succinct output format inspired by pytest.

* bin/run64: Import (srfi srfi-1).
(bold, yellow, headline, string-join): New functions.
(make-runner, main): Move to pytest-like output.
---
 bin/run64 | 112 +++++++++++++++++++++++++++++++++++++++++---------------------
 1 file changed, 74 insertions(+), 38 deletions(-)

diff --git a/bin/run64 b/bin/run64
index b9fce65..8091fe1 100755
--- a/bin/run64
+++ b/bin/run64
@@ -19,6 +19,7 @@
 ;;; along with run64.  If not, see <https://www.gnu.org/licenses/>.
 
 (import (rnrs programs)
+        (srfi srfi-1)
         (srfi srfi-64))
 
 (define (color code str)
@@ -30,12 +31,18 @@
                  (string #\esc)
                  "[0m"))
 
+(define (bold str)
+  (color 1 str))
+
 (define (red str)
   (color 31 str))
 
 (define (green str)
   (color 32 str))
 
+(define (yellow str)
+  (color 33 str))
+
 (define (magenta str)
   (color 35 str))
 
@@ -43,8 +50,8 @@
   (let ((runner (test-runner-null)))
     (test-runner-on-group-begin! runner
       (lambda (runner suite-name count)
-        (display (magenta (string-append "%%%% " suite-name)))
-        (newline)))
+        (display suite-name)
+        (display " ")))
     (test-runner-on-group-end! runner
       (lambda _
         (newline)))
@@ -55,46 +62,75 @@
                        (symbol->string (test-result-kind runner))))
               (result-alist (test-result-alist runner)))
           (display (case (test-result-kind runner)
-                     ((pass) (green result))
-                     (else (red result))))
-          (display " ")
-          (display name)
-          (newline)
-          ;; If test did not pass, print details.
-          (unless (eq? (test-result-kind runner)
-                       'pass)
-            (display (assq-ref result-alist 'source-file))
-            (display (assq-ref result-alist 'source-line))
-            (newline)
-            (display "expected: ")
-            (display (assq-ref result-alist 'expected-value))
-            (newline)
-            (display "actual: ")
-            (display (assq-ref result-alist 'actual-value))
-            (newline)))))
+                     ((pass) (green "."))
+                     ((fail) (red "F"))
+                     ((xfail xpass) (yellow "X"))
+                     ((skip) (yellow "S"))))
+          (when (eq? (test-result-kind runner)
+                     'fail)
+            ;; Prepend test failure details to aux value.
+            (test-runner-aux-value! runner
+                                    (cons (cons (cons 'test-name (test-runner-test-name runner))
+                                                (test-result-alist runner))
+                                          (test-runner-aux-value runner)))))))
+    ;; Initialize aux value to the empty list.
+    (test-runner-aux-value! runner '())
     runner))
 
+(define (headline text color)
+  "Display headline TEXT in COLOR. COLOR is a function that wraps a
+given string in an ANSI escape code."
+  (display (color (string-append "==== " text)))
+  (newline))
+
 (define (main args)
   (let ((runner (make-runner)))
+    (headline "test session starts" bold)
     (test-with-runner runner
-      (for-each load (cdr args))
-      (display (magenta "SUMMARY"))
-      (newline)
-      (display "PASS: ")
-      (display (test-runner-pass-count runner))
-      (newline)
-      (display "FAIL: ")
-      (display (test-runner-fail-count runner))
-      (newline)
-      (display "XPASS: ")
-      (display (test-runner-xpass-count runner))
-      (newline)
-      (display "XFAIL: ")
-      (display (test-runner-xfail-count runner))
-      (newline)
-      (display "SKIP: ")
-      (display (test-runner-skip-count runner))
-      (newline)
-      (exit (zero? (test-runner-fail-count runner))))))
+      (for-each load (cdr args)))
+    (newline)
+    (unless (zero? (test-runner-fail-count runner))
+      (headline "FAILURES" red)
+      (for-each (lambda (failure)
+                  (let ((name (assq-ref failure 'test-name))
+                        (file (assq-ref failure 'source-file))
+                        (line (assq-ref failure 'source-line)))
+                    (when file
+                      (display file)
+                      (display ":")
+                      (when line
+                        (display line)
+                        (display ":"))
+                      (display " "))
+                    (display name)
+                    (newline)))
+                (test-runner-aux-value runner))
+      (newline))
+    (headline
+     (string-join
+      (filter-map (lambda (count text color)
+                    (if (zero? count)
+                        #f
+                        (color (string-append (number->string count)
+                                              " " text))))
+                  (list (test-runner-pass-count runner)
+                        (test-runner-fail-count runner)
+                        (test-runner-xpass-count runner)
+                        (test-runner-xfail-count runner)
+                        (test-runner-skip-count runner))
+                  (list "passed" "failed"
+                        "unexpected passes"
+                        "expected failures"
+                        "skipped")
+                  (list green red yellow yellow yellow))
+      ", ")
+     (cond
+      ((not (zero? (test-runner-fail-count runner)))
+       red)
+      ((or (not (zero? (test-runner-xpass-count runner)))
+           (not (zero? (test-runner-xfail-count runner))))
+       yellow)
+      (else green)))
+    (exit (zero? (test-runner-fail-count runner)))))
 
 (main (command-line))
-- 
cgit v1.2.3