Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-15 00:47:34 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

More compact test output.

Browse source
This commit is contained in:
Alex Shinn 2012-12-22 13:49:21 +09:00
parent cdd337f3aa
commit 38841409ff
1 changed files with 30 additions and 34 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

64
lib/chibi/test.scm
View file

@ -541,7 +541,9 @@
(cond (cond
((and (memq status '(FAIL ERROR)) (current-test-group)) ((and (memq status '(FAIL ERROR)) (current-test-group))
=> (lambda (group) => (lambda (group)
(test-group-push! group 'failures (list indent status info))))))) (test-group-push! group 'failures (list indent status info)))))
(cond ((current-test-group)
=> (lambda (group) (test-group-set! group 'trailing #t))))))
(flush-output-port) (flush-output-port)
status) status)
@ -549,7 +551,8 @@
(define (plural word n) (define (plural word n)
(if (= n 1) word (string-append word "s"))) (if (= n 1) word (string-append word "s")))
(define (percent n d) (define (percent n d)
(string-append " (" (number->string (/ (round (* 1000.0 (/ n d))) 10)) "%)")) (string-append " (" (number->string (/ (round (* 1000.0 (/ n d))) 10))
"%)"))
(let* ((end-time (current-second)) (let* ((end-time (current-second))
(start-time (test-group-ref group 'start-time)) (start-time (test-group-ref group 'start-time))
(duration (- end-time start-time)) (duration (- end-time start-time))
@ -561,44 +564,44 @@
(subgroups-count (or (test-group-ref group 'subgroups-count) 0)) (subgroups-count (or (test-group-ref group 'subgroups-count) 0))
(subgroups-pass (or (test-group-ref group 'subgroups-pass) 0)) (subgroups-pass (or (test-group-ref group 'subgroups-pass) 0))
(indent (make-string (or (test-group-indent-width group) 0) #\space))) (indent (make-string (or (test-group-indent-width group) 0) #\space)))
(if (not (test-group-ref group 'verbose)) (if (and (not (test-group-ref group 'verbose))
(test-group-ref group 'trailing))
(newline)) (newline))
(cond (cond
((or (positive? count) (positive? subgroups-count)) ((or (positive? count) (positive? subgroups-count))
(if (not (= count (+ pass fail err))) (if (not (= count (+ pass fail err)))
(warning "inconsistent count:" count pass fail err)) (warning "inconsistent count:" count pass fail err))
(display indent)
(cond (cond
((positive? count) ((positive? count)
(write count) (display (plural " test" count)))) (display indent)
(if (and (positive? count) (positive? subgroups-count)) (display
(display " and ")) ((if (and (test-ansi?) (= pass count)) green (lambda (x) x))
(cond (string-append
((positive? subgroups-count) (number->string pass) " out of " (number->string count)
(write subgroups-count) (percent pass count))))
(display (plural " subgroup" subgroups-count)))) (display
(display " completed in ") (write duration) (display " seconds") (string-append
(cond (plural " test" pass) " passed in "
((not (zero? skip)) (number->string duration) " seconds"
(display " (") (write skip) (display (plural " test" skip)) (cond
(display " skipped)"))) ((zero? skip) "")
(display ".") (newline) (else (string-append " (" (number->string skip)
(plural " test" skip) " skipped)")))
".\n"))))
(cond ((positive? fail) (cond ((positive? fail)
(display indent) (display indent)
(display (display
((if (test-ansi?) red (lambda (x) x)) ((if (test-ansi?) red (lambda (x) x))
(string-append (string-append
(number->string fail) (plural " failure" fail) (number->string fail) (plural " failure" fail)
(percent fail count) "."))) (percent fail count) ".\n")))))
(newline)))
(cond ((positive? err) (cond ((positive? err)
(display indent) (display indent)
(display (display
((if (test-ansi?) (lambda (x) (underline (red x))) (lambda (x) x)) ((if (test-ansi?) (lambda (x) (underline (red x))) (lambda (x) x))
(string-append (string-append
(number->string err) (plural " error" err) (number->string err) (plural " error" err)
(percent err count) "."))) (percent err count) ".\n")))))
(newline)))
(cond (cond
((not (test-group-ref group 'verbose)) ((not (test-group-ref group 'verbose))
(for-each (for-each
@ -610,15 +613,6 @@
(newline) (newline)
(apply test-print-failure failure)) (apply test-print-failure failure))
(reverse (or (test-group-ref group 'failures) '()))))) (reverse (or (test-group-ref group 'failures) '())))))
(cond
((positive? count)
(display indent)
(display
((if (and (test-ansi?) (= pass count)) green (lambda (x) x))
(string-append
(number->string pass) " out of " (number->string count)
(percent pass count) (plural " test" pass) " passed.")))
(newline)))
(cond (cond
((positive? subgroups-count) ((positive? subgroups-count)
(display indent) (display indent)
@ -628,15 +622,17 @@
(string-append (string-append
(number->string subgroups-pass) " out of " (number->string subgroups-pass) " out of "
(number->string subgroups-count) (number->string subgroups-count)
(percent subgroups-pass subgroups-count) (percent subgroups-pass subgroups-count))))
(plural " subgroup" subgroups-pass) " passed."))) (display (plural " subgroup" subgroups-pass))
(newline))))) (display " passed.\n")))))
(cond (cond
((test-group-ref group 'verbose) ((test-group-ref group 'verbose)
(test-print-header-line (test-print-header-line
(string-append "done testing " (or (test-group-name group) "")) (string-append "done testing " (or (test-group-name group) ""))
(or (test-group-indent-width group) 0)) (or (test-group-indent-width group) 0))
(newline))))) (newline)))
(cond ((test-group-ref group 'parent)
=> (lambda (parent) (test-group-set! parent 'trailing #f))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;