conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

r7rs-test: print all failed tests in the end

This commit is contained in:
Yuichi Nishiwaki 2014-07-15 18:04:53 +09:00
parent d85801e396
commit 64d757d46a
1 changed files with 20 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
t/r7rs-tests.scm
View File

@ -47,6 +47,8 @@
(define counter 0) (define counter 0)
(define failure-counter 0) (define failure-counter 0)
(define fails '())
(define (print-statistics) (define (print-statistics)
(newline) (newline)
(display "Test Result: ") (display "Test Result: ")
@ -58,7 +60,11 @@
(display "%)") (display "%)")
(display " [PASS/TOTAL]") (display " [PASS/TOTAL]")
(display "") (display "")
(newline)) (newline)
(for-each
(lambda (fail)
(display fail))
fails))
(define (test-begin . o) (define (test-begin . o)
(set! test-counter (+ test-counter 1))) (set! test-counter (+ test-counter 1)))
@ -85,15 +91,19 @@
) )
((not (equal? res expected)) ((not (equal? res expected))
(set! failure-counter (+ failure-counter 1)) (set! failure-counter (+ failure-counter 1))
(display " FAIL: ") (let ((out (open-output-string)))
(write 'expr) (display " FAIL: " out)
(newline) (write 'expr out)
(display " expected ") (newline out)
(write expected) (display " expected " out)
(display " but got ") (write expected out)
(write res) (display " but got " out)
(display "") (write res out)
(newline))) (display "" out)
(newline out)
(let ((str (get-output-string out)))
(set! fails (cons str fails))
(display str)))))
(set! counter (+ counter 1)))))) (set! counter (+ counter 1))))))
(newline) (newline)