diff --git a/report b/report new file mode 100755 index 0000000..248c103 --- /dev/null +++ b/report @@ -0,0 +1,6 @@ +#!/bin/sh + +mkdir -p reports +gosh -r7 -I . -I ./snow report.scm reports/*.log + + diff --git a/report.scm b/report.scm new file mode 100644 index 0000000..24a4abf --- /dev/null +++ b/report.scm @@ -0,0 +1,94 @@ +(import (scheme base) + (scheme write) + (scheme file) + (scheme char) + (scheme process-context) + (scheme file) + (arvyy mustache)) + +(include "util.scm") +(include "implementations.scm") +(include "tests.scm") + +(define report-top (compile (slurp "templates/Report-top"))) +(define report-row (compile (slurp "templates/Report-row"))) +(define report-bottom (compile (slurp "templates/Report-bottom"))) + +(define logfiles (list-tail (command-line) 1)) + + + +(call-with-output-file + "reports/results.html" + (lambda (out) + (execute report-top `() out) + (display "" out) + (newline out) + (display "Test" out) + (for-each + (lambda (implementation) + (display (string-append "" (symbol->string (cdr (assoc 'name implementation))) "") out) + (newline out)) + implementations) + (display "" out) + (newline out) + (newline out) + (for-each + (lambda (test) + (let ((test-name (symbol->string (cdr (assoc 'name test)))) + (name (symbol->string (cdr (assoc 'name implementation))))) + (display (string-append "") out) + (newline out) + (display (string-append "" test-name "") out) + (newline out) + (for-each + (lambda (implementation) + (letrec* ((name (cdr (assoc 'name implementation))) + (command (cdr (assoc 'command implementation))) + (logfile (string-append "reports/" + name + "-" + test-name + ".log")) + (read-results (lambda (line results) + (if (eof-object? line) + results + (read-results (read-line) + (if (string-starts-with? line "# of") + (begin + (append results + (list (number-of-line->number line)))) + results))))) + (results (if (not (file-exists? logfile)) + (list "" "" "" "") + (with-input-from-file + logfile + (lambda () + (read-results (read-line) (list)))))) + (expected-passes (if (> (length results) 0) (list-ref results 0) 0)) + (expected-failures (if (> (length results) 1) (list-ref results 1) 0)) + (unexpected-failures (if (> (length results) 2) (list-ref results 2) 0)) + (skipped-tests (if (> (length results) 3) (list-ref results 3) 0)) + (color (cond ((string? expected-passes) "white") ; No logfile + ((> unexpected-failures 0) "red") + ((> skipped-tests 0) "yellow") + (else "green")))) + (execute report-row + `((name . ,name) + (command . ,command) + (color . ,color) + (library-command . ,(if (assoc 'library-command implementation) + (cdr (assoc 'library-command implementation)) + #f)) + (name . ,name) + (expected-passes . ,expected-passes) + (expected-failures . ,expected-failures) + (unexpected-failures . ,unexpected-failures) + (skipped-tests . ,skipped-tests)) + out) + (newline out))) + implementations) + (display (string-append "") out))) + tests) + (execute report-bottom '() out) + (newline out)))