diff options
| -rwxr-xr-x | bin/run64 | 112 |
1 files changed, 74 insertions, 38 deletions
@@ -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)) |