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

11
retropikzel/ctrf.sld
View File

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