Retropikzel
/
scheme-libraries
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

ctrf updates

This commit is contained in:
retropikzel 2026-02-12 06:38:19 +02:00
parent b3b07a0566
commit 9264769c41
2 changed files with 17 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
retropikzel/ctrf.scm
View File

@ -36,7 +36,7 @@
runner
(lambda (runner)
(set! current-test-group-count (+ current-test-group-count 1))
(set! current-test-start-time (time-ms))))
(set! current-test-start-time (time-s))))
(test-runner-on-test-end!
runner
@ -49,7 +49,7 @@
((equal? result 'xfail) "failed")
((equal? result 'skipped) "skipped")
(else "other")))
(duration (exact (floor (- (time-ms) current-test-start-time))))
(duration (- (time-s) current-test-start-time))
(result-ref
(lambda (runner key)
(let ((value (test-result-ref runner key)))
@ -70,9 +70,11 @@
(when (or (equal? result 'fail)
(equal? result 'xfail))
(set! failed-tests
(vector-append failed-tests
(vector (cons `(suite . ,suite) test)))))
(let ((failed (cons `(suite . ,suite) test)))
(display "FAIL " (current-error-port))
(json-write failed (current-error-port))
(newline (current-error-port))
(set! failed-tests (vector-append failed-tests (vector failed)))))
(set! tests (vector-append tests (vector test)))))))
(test-runner-on-final!
@ -116,5 +118,6 @@
(json-write output (current-output-port))))
(json-write short-output (current-output-port))
(newline (current-output-port))
(exit (+ fail xfail)))))
;(exit (+ fail xfail))
)))
runner)))

11
retropikzel/ctrf.sld
View File

@ -36,12 +36,17 @@
(ypsilon (begin (define implementation-name "ypsilon")))
(else (begin (define implementation-name "unknown"))))
(cond-expand
(r6rs
#;(r6rs
(import (srfi :19))
(begin
(define (time-ms)
(define (time-s)
(time-second (current-time)))))
#;(srfi-19
(import (srfi 19))
(begin
(define (time-s)
(time-second (current-time)))))
(else
(begin
(define (time-ms) (/ (/ (current-jiffy) (jiffies-per-second)) 1000)))))
(define (time-s) (current-second)))))
(include "ctrf.scm"))