Chicken/tap-srfi-64
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

In the beginning there was darkness

Browse source
This commit is contained in:
Daniel Ziltener 2022-10-30 15:26:53 +01:00
parent 4eda692f97
commit 58efcf3671
2 changed files with 84 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
tap-srfi-64.egg
View file

@ -7,5 +7,5 @@
(dependencies r7rs srfi-64 srfi-152 srfi-197)
(components
(extension tap-srfi-64
(extension tap.srfi.64
(csc-options "-X" "r7rs" "-R" "r7rs" "-sJ"))))

83
tap.srfi.64.scm Normal file
View file

@ -0,0 +1,83 @@
(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))
))