diff --git a/Makefile b/Makefile
index 7bf904b..7684298 100644
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-.SILENT: build install test test-docker clean ${TMPDIR}
+#.SILENT: build install test test-docker clean ${TMPDIR}
SCHEME=chibi
LIBRARY=cgi
AUTHOR=retropikzel
diff --git a/retropikzel/ctrf.sld b/retropikzel/ctrf.sld
new file mode 100644
index 0000000..84bad73
--- /dev/null
+++ b/retropikzel/ctrf.sld
@@ -0,0 +1,249 @@
+(define-library
+ (retropikzel ctrf)
+ (cond-expand
+ (chezscheme
+ (import (rnrs)
+ (srfi 64)
+ (srfi 69)
+ (srfi 180)))
+ (else
+ (import (scheme base)
+ (scheme write)
+ (scheme time)
+ (scheme process-context)
+ (srfi 64)
+ (srfi 69)
+ (srfi 180))))
+ (export test-begin
+ test-end
+ test-group
+ test-group-with-cleanup
+ test-skip
+ test-expect-fail
+ test-match-name
+ test-match-nth
+ test-match-all
+ test-match-any
+ test-assert
+ test-eqv
+ test-eq
+ test-equal
+ test-approximate
+ test-error
+ test-read-eval-string
+ test-apply test-with-runner
+ test-exit
+ test-runner-null
+ test-runner?
+ test-runner-reset
+ test-result-alist
+ test-result-alist!
+ test-result-ref
+ test-result-set!
+ test-result-remove
+ test-result-clear
+ test-runner-pass-count
+ test-runner-fail-count
+ test-runner-xpass-count
+ test-runner-xfail-count
+ test-runner-skip-count
+ test-runner-test-name
+ test-runner-group-path
+ test-runner-group-stack
+ test-runner-aux-value
+ test-runner-aux-value!
+ test-result-kind test-passed?
+ test-runner-on-test-begin
+ test-runner-on-test-begin!
+ test-runner-on-test-end
+ test-runner-on-test-end!
+ test-runner-on-group-begin
+ test-runner-on-group-begin!
+ test-runner-on-group-end
+ test-runner-on-group-end!
+ test-runner-on-final
+ test-runner-on-final!
+ test-runner-on-bad-count
+ test-runner-on-bad-count!
+ test-runner-on-bad-end-name
+ test-runner-on-bad-end-name!
+ test-runner-factory
+ test-runner-create
+ test-runner-current
+ test-runner-get
+ test-runner-simple
+ test-on-group-begin-simple
+ test-on-group-end-simple
+ test-on-final-simple
+ test-on-test-begin-simple
+ test-on-test-end-simple
+ test-on-bad-count-simple
+ test-on-bad-end-name-simple)
+ (cond-expand
+ ;; Guile has both r6rs and r7rs on (features)
+ (guile
+ (begin (define operation-system
+ (cond-expand
+ (windows "windows")
+ (else "unix")))))
+ (r6rs
+ (begin (define operation-system "unknown")))
+ (else
+ (begin (define operation-system
+ (cond-expand
+ (windows "windows")
+ (linux "linux")
+ (else "other"))))))
+ (cond-expand
+ (chezscheme (begin (define implementation-name "chezscheme")))
+ (chibi (begin (define implementation-name "chibi")))
+ (chicken (begin (define implementation-name "chicken")))
+ (cyclone (begin (define implementation-name "cyclone")))
+ (gambit (begin (define implementation-name "gambit")))
+ (gauche (begin (define implementation-name "gauche")))
+ (guile (begin (define implementation-name "guile")))
+ (ikarus (begin (define implementation-name "ikarus")))
+ (ironscheme (begin (define implementation-name "ironscheme")))
+ (kawa (begin (define implementation-name "kawa")))
+ (mit-scheme (begin (define implementation-name "mit-scheme")))
+ (mosh (begin (define implementation-name "mosh")))
+ (racket (begin (define implementation-name "racket")))
+ (sagittarius (begin (define implementation-name "sagittarius")))
+ (stklos (begin (define implementation-name "stklos")))
+ (tr7 (begin (define implementation-name "tr7")))
+ (ypsilon (begin (define implementation-name "ypsilon")))
+ (else (begin (define implementation-name "unknown"))))
+ (cond-expand
+ (r6rs
+ (begin
+ (define (time-ms)
+ ;; FIXME
+ 0)))
+ (else
+ (begin
+ (define (time-ms) (/ (/ (current-jiffy) (jiffies-per-second)) 1000)))))
+ (begin
+ (define (any->string any)
+ (parameterize
+ ((current-output-port (open-output-string)))
+ (display any)
+ (get-output-string (current-output-port))))
+
+ (define runner
+ (lambda ()
+ (let ((runner (test-runner-null))
+ (tests (list))
+ (current-test-start-time 0)
+ (current-test-groups '()))
+
+ (test-runner-on-group-begin!
+ runner
+ (lambda (runner suite-name count)
+ (set! current-test-groups (append current-test-groups (list suite-name)))))
+
+ (test-runner-on-group-end!
+ runner
+ (lambda (runner)
+ (set! current-test-groups
+ (reverse (list-tail (reverse current-test-groups) 1)))))
+
+ (test-runner-on-test-begin!
+ runner
+ (lambda (runner)
+ (set! current-test-start-time (time-ms))))
+
+ (test-runner-on-test-end!
+ runner
+ (lambda (runner)
+ (let* ((name (test-runner-test-name runner))
+ (result (test-result-kind runner))
+ (status (cond ((equal? result 'pass) "passed")
+ ((equal? result 'xpass) "passed")
+ ((equal? result 'fail) "failed")
+ ((equal? result 'xfail) "failed")
+ ((equal? result 'skipped) "skipped")
+ (else "other")))
+ (duration (exact (floor (- (time-ms) current-test-start-time))))
+ (extra (make-hash-table)))
+
+ (when (test-result-ref runner 'expected-value)
+ (hash-table-set! extra
+ 'expected-value
+ (test-result-ref runner 'expected-value)))
+
+ (when (test-result-ref runner 'actual-value)
+ (hash-table-set! extra
+ 'actual-value
+ (test-result-ref runner 'actual-value)))
+
+ (when (test-result-ref runner 'expected-error)
+ (hash-table-set! extra
+ 'expected-error
+ (test-result-ref runner 'expected-error)))
+
+ (when (test-result-ref runner 'actual-error)
+ (hash-table-set! extra
+ 'actual-error
+ (test-result-ref runner 'actual-error)))
+
+ (when (test-result-ref runner 'source-form)
+ (hash-table-set! extra
+ 'source-form
+ (any->string (test-result-ref runner 'source-form))))
+
+ (let ((test (alist->hash-table
+ `((name . ,name)
+ (status . ,status)
+ (duration . ,duration)
+ (suite . ,current-test-groups)
+ (extra . ,extra)))))
+
+ (when (test-result-ref runner 'source-file)
+ (hash-table-set! extra
+ 'filePath
+ (test-result-ref runner 'source-file)))
+
+ (when (test-result-ref runner 'source-line)
+ (hash-table-set! extra
+ 'line
+ (test-result-ref runner 'source-line)))
+
+ (set! tests (append tests (list test)))))))
+
+ (test-runner-on-final!
+ runner
+ (lambda (runner)
+ (let*
+ ((pass (test-runner-pass-count runner))
+ (xpass (test-runner-xpass-count runner))
+ (fail (test-runner-fail-count runner))
+ (xfail (test-runner-xfail-count runner))
+ (skipped (test-runner-skip-count runner))
+ (tool (alist->hash-table
+ `((name . "srfi-64-retropikzel-ctrf"))))
+ (summary (alist->hash-table
+ `((tests . ,(+ pass xpass fail xfail))
+ (passed . ,(+ pass xpass))
+ (failed . ,(+ fail xfail))
+ (pending . 0)
+ (skipped . ,skipped)
+ (other . 0))))
+ (results (alist->hash-table
+ `((tool . ,tool)
+ (summary . ,summary)
+ (tests . ,tests))))
+ (env (alist->hash-table
+ `((appName . ,implementation-name)
+ (osPlatform . ,operation-system))))
+ (output (alist->hash-table
+ `((reportFormat . "CTRF")
+ (specVersion . "0.0.0")
+ (results . ,results)
+ (generatedBy . "(retropikzel ctrf)")
+ (environment . ,env)))))
+
+ (display (json-write-string output #t))
+ (newline)
+ (exit (+ fail xfail)))))
+ runner)))
+ (test-runner-factory runner)))
diff --git a/retropikzel/ctrf/LICENSE b/retropikzel/ctrf/LICENSE
new file mode 100644
index 0000000..0a04128
--- /dev/null
+++ b/retropikzel/ctrf/LICENSE
@@ -0,0 +1,165 @@
+ GNU LESSER GENERAL PUBLIC LICENSE
+ Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc.
Uses SRFI-64 underneath, giving output as [Common Test Report Format](https://ctrf.io/). + +Features + +- Exports exactly same things as SRFI-64, it only alters the output +- Exists with exit code of count of failed tests +- Measures time spent running individual tests +- Adds implementation name and operation system onto the reportdiff --git a/retropikzel/ctrf/README.md b/retropikzel/ctrf/README.md new file mode 100644 index 0000000..2a6d6f4 --- /dev/null +++ b/retropikzel/ctrf/README.md @@ -0,0 +1,10 @@ +Uses SRFI-64 underneath, giving output as [Common Test Report Format](https://ctrf.io/). + +Features + +- Exports exactly same things as SRFI-64, it only alters the output +- Exists with exit code of count of failed tests +- Measures time spent running individual tests +- Adds implementation name and operation system onto the report + + diff --git a/retropikzel/ctrf/VERSION b/retropikzel/ctrf/VERSION new file mode 100644 index 0000000..3eefcb9 --- /dev/null +++ b/retropikzel/ctrf/VERSION @@ -0,0 +1 @@ +1.0.0