bin: Print detailed info for failing tests.

1 files changed, 59 insertions, 11 deletions

diff --git a/bin/run64 b/bin/run64
index 3e355bf..6565acb 100755
--- a/bin/run64
+++ b/bin/run64
@@ -94,6 +94,12 @@ given string in an ANSI escape code."
   (display (color (string-append "==== " text)))
   (newline))
 
+(define (subheadline text color)
+  "Display subheadline 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)
@@ -103,20 +109,62 @@ given string in an ANSI escape code."
                   ((_ files ...) files))))
     (newline)
     (unless (zero? (test-runner-fail-count runner))
-      (headline "FAILURES" red)
+      (headline "FAILURES" bold)
       (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)))
+                        (line (assq-ref failure 'source-line))
+                        (test-type (chibi:match (assq-ref failure 'source-form)
+                                     (('test-assert _ ...) 'assert)
+                                     (('test-eq _ ...) 'eq)
+                                     (('test-eqv _ ...) 'eqv)
+                                     (('test-equal _ ...) 'equal)
+                                     (('test-approximate _ ...) 'approximate)
+                                     (('test-error _ ...) 'error)
+                                     (_ #f))))
+                    ;; Print file, line number and test name.
+                    (subheadline
+                     (string-append (if file
+                                        (string-append file ":")
+                                        "")
+                                    (if line
+                                        (string-append (number->string line) ":")
+                                        "")
+                                    (if file " " "")
+                                    name)
+                     (compose red bold))
+                    (case test-type
+                      ;; On test-assert, print nothing additional.
+                      ((assert) #t)
+                      ;; On test-error, print the mismatch in expected
+                      ;; and actual errors.
+                      ((error)
+                       (newline)
+                       (display (red "Actual error: "))
+                       (write (assq-ref failure 'actual-error))
+                       (newline)
+                       (display (red "Expected error: "))
+                       (write (assq-ref failure 'expected-error))
+                       (newline))
+                      ((eq eqv equal approximate)
+                       (cond
+                        ;; If an error occurred, report it.
+                        ((assq-ref failure 'actual-error)
+                         (newline)
+                         (display (red "error: "))
+                         (write (assq-ref failure 'actual-error))
+                         (newline))
+                        ;; Else, print the mismatch in expected and
+                        ;; actual values.
+                        (else
+                         (newline)
+                         (display (red "Actual value: "))
+                         (write (assq-ref failure 'actual-value))
+                         (newline)
+                         (display (red "Expected value: "))
+                         (write (assq-ref failure 'expected-value))
+                         (newline)
+                         (newline)))))))
                 (test-runner-aux-value runner))
       (newline))
     (headline