diff --git a/infra/ci.rkt b/infra/ci.rkt index fb0f75b50..dc18f9176 100644 --- a/infra/ci.rkt +++ b/infra/ci.rkt @@ -67,17 +67,15 @@ (define success? (test-successful? test (errors-score start-error) - (if target-error - (errors-score target-error) - #f) + (and target-error (errors-score target-error)) (errors-score end-error))) - (when (not success?) + (unless success? (printf "\nInput (~a bits):\n" (errors-score start-error)) (pretty-print (alt-expr start-alt) (current-output-port) 1) (printf "\nOutput (~a bits):\n" (errors-score end-error)) (pretty-print (alt-expr end-alt) (current-output-port) 1) - + (when target-error (printf "\nTarget (~a bits):\n" (errors-score target-error)) ;; internal tool so okay diff --git a/infra/make-index.rkt b/infra/make-index.rkt index 861def83f..d9d2b09c8 100644 --- a/infra/make-index.rkt +++ b/infra/make-index.rkt @@ -141,9 +141,9 @@ [else (~r x #:precision 2)])) (define (bad-result? info) - (or (> (dict-ref info 'tests-crashed 0) 0) - (> (dict-ref info 'tests-unimproved 0) 0) - (> (dict-ref info 'tests-timeout 0) 0))) + (or (positive? (dict-ref info 'tests-crashed 0)) + (positive? (dict-ref info 'tests-unimproved 0)) + (positive? (dict-ref info 'tests-timeout 0)))) (define (print-rows infos #:name name) `((thead ((id ,(format "reports-~a" name)) (data-branch ,name)) @@ -165,7 +165,7 @@ (time ([data-unix ,(~a (field 'date-unix))]) ,(field 'date-short))) (td (time ([data-ms ,(~a (field 'speed))]) ,(format-time (field 'speed)))) (td ([title ,(field 'commit)]) ,(field 'branch)) - (td ,(if (> (field 'tests-available) 0) + (td ,(if (positive? (field 'tests-available)) (format "~a/~a" (field 'tests-passed) (field 'tests-available)) "")) (td ,(if (field 'bits-improved) @@ -191,7 +191,7 @@ (partition (λ (x) (set-member? '("master" "develop" "main") (dict-ref (first x) 'branch))) branch-infos)) - (define crashes (filter (λ (x) (> (dict-ref x 'tests-crashed) 0)) (apply append mainline-infos))) + (define crashes (filter (λ (x) (positive? (dict-ref x 'tests-crashed))) (apply append mainline-infos))) (define last-crash (if (null? crashes) #f @@ -231,9 +231,9 @@ (script "window.addEventListener('load', function(){draw_results(d3.select('#accuracy-graph'), d3.select('#speed-graph'))})")) (table ((id "reports")) - ,@(apply append - (for/list ([rows (append mainline-infos other-infos)]) - (print-rows rows #:name (dict-ref (first rows) 'branch))))))) + ,@(for*/list ([rows (append mainline-infos other-infos)] + [v (in-list (print-rows rows #:name (dict-ref (first rows) 'branch)))]) + v)))) out)) (define (get-reports file base) diff --git a/infra/merge.rkt b/infra/merge.rkt index 9bb01544f..eb6a38944 100644 --- a/infra/merge.rkt +++ b/infra/merge.rkt @@ -42,11 +42,11 @@ (filter (conjoin (negate eof-object?) identity) (for/list ([dir (in-list dirs)]) (with-handlers ([exn? (const #f)]) - (let ([df (call-with-input-file (build-path outdir dir "results.json") - read-datafile)]) - (if (eof-object? df) - eof - (cons df dir))))))) + (define df + (call-with-input-file (build-path outdir dir "results.json") read-datafile)) + (if (eof-object? df) + eof + (cons df dir)))))) (define dfs (map car rss)) (define joint-rs (merge-datafiles dfs #:dirs dirs)) (write-datafile (build-path outdir "results.json") joint-rs)