aboutsummaryrefslogtreecommitdiff
path: root/bin
diff options
context:
space:
mode:
Diffstat (limited to 'bin')
-rwxr-xr-xbin/run64112
1 files 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))