Index: runs.scm
==================================================================
--- runs.scm
+++ runs.scm
@@ -155,30 +155,60 @@
force)
(begin
(if (obtain-dot-lock outputfilename 1 20 30) ;; retry every second for 20 seconds, call it dead after 30 seconds and steal the lock
(print "Obtained lock for " outputfilename)
(print "Failed to obtain lock for " outputfilename))
- (let ((oup (open-output-file outputfilename)))
+ (let ((oup (open-output-file outputfilename))
+ (counts (make-hash-table))
+ (statecounts (make-hash-table))
+ (outtxt "")
+ (tot 0))
(with-output-to-port
oup
(lambda ()
- (print "
Summary: " test-name "Summary for " test-name "
")
+ (set! outtxt (conc outtxt "Summary: " test-name
+ "Summary for " test-name "
"))
(sqlite3:for-each-row
(lambda (id itempath state status run_duration logf comment)
- (print ""
- "" itempath " | "
- "" state " | "
- "" status " | "
- "" comment " | "
- "
"))
+ (hash-table-set! counts status (+ 1 (hash-table-ref/default counts status 0)))
+ (hash-table-set! statecounts state (+ 1 (hash-table-ref/default statecounts state 0)))
+ (set! outtxt (conc outtxt ""
+ " " itempath " | "
+ "" state " | "
+ "" status " | "
+ "" (if (equal? comment "")
+ " "
+ comment) " | "
+ "
")))
db
"SELECT id,item_path,state,status,run_duration,final_logf,comment FROM tests WHERE run_id=? AND testname=? AND item_path != '';"
run-id test-name)
- (print "")
+
+ ;; Print out stats for status
+ (set! tot 0)
+ (print "State stats
")
+ (for-each (lambda (state)
+ (set! tot (+ tot (hash-table-ref statecounts state)))
+ (print "" state " | " (hash-table-ref statecounts state) " |
"))
+ (hash-table-keys statecounts))
+ (print "Total | " tot " |
")
+
+ ;; Print out stats for state
+ (set! tot 0)
+ (print "Status stats
")
+ (for-each (lambda (status)
+ (set! tot (+ tot (hash-table-ref counts status)))
+ (print "" status " | " (hash-table-ref counts status) " |
"))
+ (hash-table-keys counts))
+ (print "Total | " tot " |
")
+
+ (print ""
+ "Item | State | Status | Comment | "
+ outtxt "
")
(release-dot-lock outputfilename)))
(close-output-port oup)
(change-directory orig-dir)
(test-set-toplog! db run-id test-name outputfilename)
)))))