Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -127,5 +127,34 @@ (min (quotient (- secs (* hrs 3600)) 60)) (sec (- secs (* hrs 3600)(* min 60)))) (conc (if (> hrs 0)(conc hrs "hr ") "") (if (> min 0)(conc min "m ") "") sec "s"))) + +;;====================================================================== +;; Colors +;;====================================================================== + +(define (common:name->iup-color name) + (case (string->symbol (string-downcase name)) + ((red) "223 33 49") + ((grey) "192 192 192") + ((orange) "255 172 13") + ((purple) "This is unfinished ..."))) + +(define (common:get-color-for-state-status state status type) + (case (string->symbol state) + ((COMPLETED) + (if (equal? status "PASS") + "70 249 73" + (if (or (equal? status "WARN") + (equal? status "WAIVED")) + "255 172 13" + "223 33 49"))) ;; greenish orangeish redish + ((LAUNCHED) "101 123 142") + ((CHECK) "255 100 50") + ((REMOTEHOSTSTART) "50 130 195") + ((RUNNING) "9 131 232") + ((KILLREQ) "39 82 206") + ((KILLED) "234 101 17") + ((NOT_STARTED) "240 240 240") + (else "192 192 192"))) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -50,11 +50,11 @@ testname TEXT, host TEXT DEFAULT 'n/a', cpuload REAL DEFAULT -1, diskfree INTEGER DEFAULT -1, uname TEXT DEFAULT 'n/a', - rundir TEXT DEFAULT 'n/a', + rundir TEXT DEFAULT 'n/a', item_path TEXT DEFAULT '', state TEXT DEFAULT 'NOT_STARTED', status TEXT DEFAULT 'FAIL', attemptnum INTEGER DEFAULT 0, final_logf TEXT DEFAULT 'logs/final.log', Index: megatest-version.scm ================================================================== --- megatest-version.scm +++ megatest-version.scm @@ -1,1 +1,1 @@ -(define megatest-version 1.18) +(define megatest-version 1.19) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -491,11 +491,12 @@ (thread-start! th1) (thread-start! th2) (thread-join! th2) (mutex-lock! m) (set! db (open-db)) - (let* ((testinfo (db:get-test-info db run-id test-name (item-list->path itemdat)))) + (let* ((item-path (item-list->path itemdat)) + (testinfo (db:get-test-info db run-id test-name item-path))) (if (not (equal? (db:test-get-state testinfo) "COMPLETED")) (begin (debug:print 2 "Test NOT logged as COMPLETED, (state=" (db:test-get-state testinfo) "), updating result") (test-set-status! db run-id test-name (if kill-job? "KILLED" "COMPLETED") @@ -502,11 +503,14 @@ (if (vector-ref exit-info 1) ;; look at the exit-status (if (and (not kill-job?) (eq? (vector-ref exit-info 2) 0)) "PASS" "FAIL") - "FAIL") itemdat (args:get-arg "-m"))))) + "FAIL") itemdat (args:get-arg "-m")))) + ;; for automated creation of the rollup html file this is a good place... + (tests:summarize-items db run-id test-name #f) ;; don't force - just update if no + ) (mutex-unlock! m) ;; (exec-results (cmd-run->list fullrunscript)) ;; (list ">" (conc test-name "-run.log")))) ;; (success exec-results)) ;; (eq? (cadr exec-results) 0))) (debug:print 2 "Output from running " fullrunscript ", pid " (vector-ref exit-info 0) " in work area " work-area ":\n====\n exit code " (vector-ref exit-info 2) "\n" "====\n") @@ -574,11 +578,11 @@ (if (args:get-arg "-setlog") (test-set-log! db run-id test-name itemdat (args:get-arg "-setlog"))) (if (args:get-arg "-set-toplog") (test-set-toplog! db run-id test-name (args:get-arg "-set-toplog"))) (if (args:get-arg "-summarize-items") - (tests:summarize-items db run-id test-name)) + (tests:summarize-items db run-id test-name #t)) ;; do force here (if (args:get-arg "-runstep") (if (null? remargs) (begin (debug:print 0 "ERROR: nothing specified to run!") (sqlite3:finalize! db) Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -128,34 +128,62 @@ (define (test-set-toplog! db run-id test-name logf) (sqlite3:execute db "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path='';" logf run-id test-name)) -(define (tests:summarize-items db run-id test-name) - (obtain-dot-lock "final-results.html" 1 20 30) ;; retry every second for 20 seconds, call it dead after 30 seconds and steal the lock - (let ((oup (open-output-file "final-results.html"))) - (with-output-to-port - oup - (print "Summary: " test-name "") - (sqlite3:for-each-row - (lambda (id itempath state status run_duration logf comment) - (print "" - "" - "" - "" - "" - "") - "SELECT id,item_path,state,status,run_duration,final_logf,comment FROM tests WHERE run_id=? AND testname=? AND item_path != '';")) - (print "") - (close-output-port oup) - (release-dot-lock "final-results.html")) - - ;; ADD UPDATE TO FINAL LOG HERE - -)) - - +(define (tests:summarize-items db run-id test-name force) + ;; if not force then only update the record if one of these is true: + ;; 1. logf is "log/final.log + ;; 2. logf is same as outputfilename + (let ((outputfilename (conc "megatest-rollup-" test-name ".html")) + (orig-dir (current-directory)) + (logf #f)) + (sqlite3:for-each-row + (lambda (path final_logf) + (set! logf final_logf) + (if (directory? path) + (begin + (print "Found path: " path) + (change-directory path)) + ;; (set! outputfilename (conc path "/" outputfilename))) + (print "No such path: " path))) + db + "SELECT rundir,final_logf FROM tests WHERE run_id=? AND testname=? AND item_path='';" + run-id test-name) + (print "summarize-items with logf " logf) + (if (or (equal? logf "logs/final.log") + (equal? logf outputfilename) + 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))) + (with-output-to-port + oup + (lambda () + (print "Summary: " test-name "

Summary for " test-name "

" itempath "" state "" status "" comment "
") + (sqlite3:for-each-row + (lambda (id itempath state status run_duration logf comment) + (print "" + "" + "" + "" + "" + "")) + 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 "") + (release-dot-lock outputfilename))) + (close-output-port oup) + (change-directory orig-dir) + (test-set-toplog! db run-id test-name outputfilename) + ))))) ;; ;; TODO: Converge this with db:get-test-info ;; (define (runs:get-test-info db run-id test-name item-path) ;; (let ((res #f)) ;; (vector #f #f #f #f #f #f))) ;; (sqlite3:for-each-row
" itempath "" state "" status "" comment "