84 lines
3.3 KiB
Scheme
84 lines
3.3 KiB
Scheme
|
(define-library (tap srfi 64)
|
||
|
|
(import (r7rs)
|
||
|
|
(chicken base)
|
||
|
|
(srfi 1)
|
||
|
|
(srfi 64)
|
||
|
|
(srfi 152)
|
||
|
|
(srfi 197))
|
||
|
|
(export tap-test-runner)
|
||
|
|
(begin
|
||
|
|
|
||
|
|
(define (test-name runner)
|
||
|
|
(string-append
|
||
|
|
(string-join (test-runner-group-path runner) " - ")
|
||
|
|
;; " - " (test-runner-test-name runner)
|
||
|
|
))
|
||
|
|
|
||
|
|
(define (al-ref alist key)
|
||
|
|
(chain (let ((al-var (assq key alist)))
|
||
|
|
(if al-var
|
||
|
|
(cdr al-var)
|
||
|
|
"#f"))
|
||
|
|
(string-split _ "\n")
|
||
|
|
(string-join _ "\n ")))
|
||
|
|
|
||
|
|
(define (tap-test-runner)
|
||
|
|
(let ((runner (test-runner-null))
|
||
|
|
(testcounter 0))
|
||
|
|
(print "TAP version 14\n")
|
||
|
|
(test-runner-on-test-end! runner
|
||
|
|
(lambda (runner)
|
||
|
|
(set! testcounter (+ testcounter 1))
|
||
|
|
(let ((result (test-result-alist runner)))
|
||
|
|
(case (cdr (assq 'result-kind result))
|
||
|
|
('pass (print
|
||
|
|
(string-append
|
||
|
|
"ok " (number->string testcounter) " - "
|
||
|
|
(test-name runner))))
|
||
|
|
('fail (print
|
||
|
|
(string-append
|
||
|
|
"not ok " (number->string testcounter) " - "
|
||
|
|
(test-name runner) "\n"
|
||
|
|
" ---\n"
|
||
|
|
" message: The test failed, but was expected to pass. \n"
|
||
|
|
" severity: fail\n"
|
||
|
|
" data:\n"
|
||
|
|
" got: |\n "
|
||
|
|
(al-ref result 'actual-value) "\n"
|
||
|
|
" expect: |\n "
|
||
|
|
(al-ref result 'expected-value) "\n"
|
||
|
|
" at:\n"
|
||
|
|
" file: " (al-ref result 'source-file) "\n"
|
||
|
|
" line: " (al-ref result 'source-line) "\n"
|
||
|
|
" ...")))
|
||
|
|
('xfail (print
|
||
|
|
(string-append
|
||
|
|
"ok " (number->string testcounter) " - "
|
||
|
|
(test-name runner))))
|
||
|
|
('xpass (print
|
||
|
|
(string-append
|
||
|
|
"not ok " (number->string testcounter) " - "
|
||
|
|
(test-name runner) "\n"
|
||
|
|
" ---\n"
|
||
|
|
" message: The test passed, but was expected to fail. \n"
|
||
|
|
" severity: fail\n"
|
||
|
|
" data:\n"
|
||
|
|
" got: |\n "
|
||
|
|
(al-ref result 'actual-error) "\n"
|
||
|
|
" expect: |\n "
|
||
|
|
(al-ref result 'expected-error) "\n"
|
||
|
|
" at:\n"
|
||
|
|
" file: " (al-ref result 'source-file) "\n"
|
||
|
|
" line: " (al-ref result 'source-line) "\n"
|
||
|
|
" ...\n")))
|
||
|
|
('skip (print
|
||
|
|
(string-append
|
||
|
|
"ok " (number->string testcounter) " - "
|
||
|
|
(test-name runner) " # SKIP")))))))
|
||
|
|
(test-runner-on-final! runner
|
||
|
|
(lambda (runner)
|
||
|
|
(print (string-append "1.." (number->string testcounter) "\n"))))
|
||
|
|
runner))
|
||
|
|
|
||
|
|
))
|