Overview
| SHA1 Hash: | 40fcb78bd61dae1915ae516dadac9589bac470eb |
|---|---|
| Date: | 2011-08-02 23:27:07 |
| User: | matt |
| Comment: | Added auto-rolling up of item status into an html file |
| Timelines: | family | ancestors | descendants | both | trunk | v1.19 |
| Downloads: | Tarball | ZIP archive |
| Other Links: | files | file ages | manifest |
Tags And Properties
- branch=trunk inherited from [d673a9367e]
- sym-trunk inherited from [d673a9367e]
- sym-v1.19 added by [466ec0011d] on 2011-08-02 23:27:36
Changes
Modified common.scm from [a1016b8cd0537f9c] to [828a92199dce3d4d].
125 (define (seconds->hr-min-sec secs) 125 (define (seconds->hr-min-sec secs) 126 (let* ((hrs (quotient secs 3600)) 126 (let* ((hrs (quotient secs 3600)) 127 (min (quotient (- secs (* hrs 3600)) 60)) 127 (min (quotient (- secs (* hrs 3600)) 60)) 128 (sec (- secs (* hrs 3600)(* min 60)))) 128 (sec (- secs (* hrs 3600)(* min 60)))) 129 (conc (if (> hrs 0)(conc hrs "hr ") "") 129 (conc (if (> hrs 0)(conc hrs "hr ") "") 130 (if (> min 0)(conc min "m ") "") 130 (if (> min 0)(conc min "m ") "") 131 sec "s"))) 131 sec "s"))) > 132 > 133 ;;====================================================================== > 134 ;; Colors > 135 ;;====================================================================== > 136 > 137 (define (common:name->iup-color name) > 138 (case (string->symbol (string-downcase name)) > 139 ((red) "223 33 49") > 140 ((grey) "192 192 192") > 141 ((orange) "255 172 13") > 142 ((purple) "This is unfinished ..."))) > 143 > 144 (define (common:get-color-for-state-status state status type) > 145 (case (string->symbol state) > 146 ((COMPLETED) > 147 (if (equal? status "PASS") > 148 "70 249 73" > 149 (if (or (equal? status "WARN") > 150 (equal? status "WAIVED")) > 151 "255 172 13" > 152 "223 33 49"))) ;; greenish orangeish redish > 153 ((LAUNCHED) "101 123 142") > 154 ((CHECK) "255 100 50") > 155 ((REMOTEHOSTSTART) "50 130 195") > 156 ((RUNNING) "9 131 232") > 157 ((KILLREQ) "39 82 206") > 158 ((KILLED) "234 101 17") > 159 ((NOT_STARTED) "240 240 240") > 160 (else "192 192 192")))
Modified db.scm from [b552412187c5b453] to [7e7088ebc578a6d6].
48 (id INTEGER PRIMARY KEY, 48 (id INTEGER PRIMARY KEY, 49 run_id INTEGER, 49 run_id INTEGER, 50 testname TEXT, 50 testname TEXT, 51 host TEXT DEFAULT 'n/a', 51 host TEXT DEFAULT 'n/a', 52 cpuload REAL DEFAULT -1, 52 cpuload REAL DEFAULT -1, 53 diskfree INTEGER DEFAULT -1, 53 diskfree INTEGER DEFAULT -1, 54 uname TEXT DEFAULT 'n/a', 54 uname TEXT DEFAULT 'n/a', 55 rundir TEXT DEFAULT 'n/a', | 55 rundir TEXT DEFAULT 'n/a', 56 item_path TEXT DEFAULT '', 56 item_path TEXT DEFAULT '', 57 state TEXT DEFAULT 'NOT_STARTED', 57 state TEXT DEFAULT 'NOT_STARTED', 58 status TEXT DEFAULT 'FAIL', 58 status TEXT DEFAULT 'FAIL', 59 attemptnum INTEGER DEFAULT 0, 59 attemptnum INTEGER DEFAULT 0, 60 final_logf TEXT DEFAULT 'logs/final.log', 60 final_logf TEXT DEFAULT 'logs/final.log', 61 logdat BLOB, 61 logdat BLOB, 62 run_duration INTEGER DEFAULT 0, 62 run_duration INTEGER DEFAULT 0,
Modified megatest-version.scm from [d7a309cb03bb8fa4] to [c09e9a5825137ebd].
Modified megatest.scm from [cc849a95d3aac896] to [fdec59eebfaf27dc].
489 (th2 (make-thread runit))) 489 (th2 (make-thread runit))) 490 (set! job-thread th2) 490 (set! job-thread th2) 491 (thread-start! th1) 491 (thread-start! th1) 492 (thread-start! th2) 492 (thread-start! th2) 493 (thread-join! th2) 493 (thread-join! th2) 494 (mutex-lock! m) 494 (mutex-lock! m) 495 (set! db (open-db)) 495 (set! db (open-db)) > 496 (let* ((item-path (item-list->path itemdat)) 496 (let* ((testinfo (db:get-test-info db run-id test-name (item-list- | 497 (testinfo (db:get-test-info db run-id test-name item-path) 497 (if (not (equal? (db:test-get-state testinfo) "COMPLETED")) 498 (if (not (equal? (db:test-get-state testinfo) "COMPLETED")) 498 (begin 499 (begin 499 (debug:print 2 "Test NOT logged as COMPLETED, (state=" (db 500 (debug:print 2 "Test NOT logged as COMPLETED, (state=" (db 500 (test-set-status! db run-id test-name 501 (test-set-status! db run-id test-name 501 (if kill-job? "KILLED" "COMPLETED") 502 (if kill-job? "KILLED" "COMPLETED") 502 (if (vector-ref exit-info 1) ;; look at 503 (if (vector-ref exit-info 1) ;; look at 503 (if (and (not kill-job?) 504 (if (and (not kill-job?) 504 (eq? (vector-ref exit-info 505 (eq? (vector-ref exit-info 505 "PASS" 506 "PASS" 506 "FAIL") 507 "FAIL") 507 "FAIL") itemdat (args:get-arg "-m")) | 508 "FAIL") itemdat (args:get-arg "-m")) > 509 ;; for automated creation of the rollup html file this is a good > 510 (tests:summarize-items db run-id test-name #f) ;; don't force - > 511 ) 508 (mutex-unlock! m) 512 (mutex-unlock! m) 509 ;; (exec-results (cmd-run->list fullrunscript)) ;; (list ">" (con 513 ;; (exec-results (cmd-run->list fullrunscript)) ;; (list ">" (con 510 ;; (success exec-results)) ;; (eq? (cadr exec-results) 0))) 514 ;; (success exec-results)) ;; (eq? (cadr exec-results) 0))) 511 (debug:print 2 "Output from running " fullrunscript ", pid " (vect 515 (debug:print 2 "Output from running " fullrunscript ", pid " (vect 512 work-area ":\n====\n exit code " (vector-ref exit-info 2) " 516 work-area ":\n====\n exit code " (vector-ref exit-info 2) " 513 (sqlite3:finalize! db) 517 (sqlite3:finalize! db) 514 (if (not (vector-ref exit-info 1)) 518 (if (not (vector-ref exit-info 1)) ................................................................................................................................................................................ 572 (exit 1))) 576 (exit 1))) 573 (set! db (open-db)) 577 (set! db (open-db)) 574 (if (args:get-arg "-setlog") 578 (if (args:get-arg "-setlog") 575 (test-set-log! db run-id test-name itemdat (args:get-arg "-setlog" 579 (test-set-log! db run-id test-name itemdat (args:get-arg "-setlog" 576 (if (args:get-arg "-set-toplog") 580 (if (args:get-arg "-set-toplog") 577 (test-set-toplog! db run-id test-name (args:get-arg "-set-toplog") 581 (test-set-toplog! db run-id test-name (args:get-arg "-set-toplog") 578 (if (args:get-arg "-summarize-items") 582 (if (args:get-arg "-summarize-items") 579 (tests:summarize-items db run-id test-name)) | 583 (tests:summarize-items db run-id test-name #t)) ;; do force here 580 (if (args:get-arg "-runstep") 584 (if (args:get-arg "-runstep") 581 (if (null? remargs) 585 (if (null? remargs) 582 (begin 586 (begin 583 (debug:print 0 "ERROR: nothing specified to run!") 587 (debug:print 0 "ERROR: nothing specified to run!") 584 (sqlite3:finalize! db) 588 (sqlite3:finalize! db) 585 (exit 6)) 589 (exit 6)) 586 (let* ((stepname (args:get-arg "-runstep")) 590 (let* ((stepname (args:get-arg "-runstep"))
Modified runs.scm from [07e183ee46d60b91] to [2ce4434f2f6e551e].
126 (sqlite3:execute db "UPDATE tests SET final_logf=? WHERE run_id=? AND testna 126 (sqlite3:execute db "UPDATE tests SET final_logf=? WHERE run_id=? AND testna 127 logf run-id test-name item-path))) 127 logf run-id test-name item-path))) 128 128 129 (define (test-set-toplog! db run-id test-name logf) 129 (define (test-set-toplog! db run-id test-name logf) 130 (sqlite3:execute db "UPDATE tests SET final_logf=? WHERE run_id=? AND testname 130 (sqlite3:execute db "UPDATE tests SET final_logf=? WHERE run_id=? AND testname 131 logf run-id test-name)) 131 logf run-id test-name)) 132 132 133 (define (tests:summarize-items db run-id test-name) | 133 (define (tests:summarize-items db run-id test-name force) > 134 ;; if not force then only update the record if one of these is true: > 135 ;; 1. logf is "log/final.log > 136 ;; 2. logf is same as outputfilename > 137 (let ((outputfilename (conc "megatest-rollup-" test-name ".html")) > 138 (orig-dir (current-directory)) > 139 (logf #f)) > 140 (sqlite3:for-each-row > 141 (lambda (path final_logf) > 142 (set! logf final_logf) > 143 (if (directory? path) > 144 (begin > 145 (print "Found path: " path) > 146 (change-directory path)) > 147 ;; (set! outputfilename (conc path "/" outputfilename))) > 148 (print "No such path: " path))) > 149 db > 150 "SELECT rundir,final_logf FROM tests WHERE run_id=? AND testname=? AND item > 151 run-id test-name) > 152 (print "summarize-items with logf " logf) > 153 (if (or (equal? logf "logs/final.log") > 154 (equal? logf outputfilename) > 155 force) > 156 (begin 134 (obtain-dot-lock "final-results.html" 1 20 30) ;; retry every second for 20 se | 157 (if (obtain-dot-lock outputfilename 1 20 30) ;; retry every second for > 158 (print "Obtained lock for " outputfilename) > 159 (print "Failed to obtain lock for " outputfilename)) 135 (let ((oup (open-output-file "final-results.html"))) | 160 (let ((oup (open-output-file outputfilename))) 136 (with-output-to-port | 161 (with-output-to-port 137 oup | 162 oup > 163 (lambda () 138 (print "<html><title>Summary: " test-name "</title><body><table>") | 164 (print "<html><title>Summary: " test-name "</title><body><h1>Sum 139 (sqlite3:for-each-row | 165 (sqlite3:for-each-row 140 (lambda (id itempath state status run_duration logf comment) | 166 (lambda (id itempath state status run_duration logf comment) 141 (print "<tr>" | 167 (print "<tr>" 142 "<td><href=\"" itempath "/" logf "\"</a>" itempath "</td>" | 168 "<td><a href=\"" itempath "/" logf "\"</a>" itempath " 143 "<td>" state "</td>" | 169 "<td>" state "</td>" > 170 "<td><font color=" (cond > 171 ((equal? status "PASS") "green") > 172 ((equal? status "FAIL") "red") 144 "<td>" status "</td>" | 173 (else "blue")) ">" status "</f 145 "<td>" comment "</td>" | 174 "<td>" comment "</td>" 146 "</tr>") | 175 "</tr>")) > 176 db 147 "SELECT id,item_path,state,status,run_duration,final_logf,comment FROM | 177 "SELECT id,item_path,state,status,run_duration,final_logf,comme > 178 run-id test-name) 148 (print "</body></html>") | 179 (print "</body></html>") > 180 (release-dot-lock outputfilename))) 149 (close-output-port oup) | 181 (close-output-port oup) 150 (release-dot-lock "final-results.html")) < 151 < 152 ;; ADD UPDATE TO FINAL LOG HERE < 153 < > 182 (change-directory orig-dir) > 183 (test-set-toplog! db run-id test-name outputfilename) 154 )) | 184 ))))) 155 < 156 < 157 185 158 ;; ;; TODO: Converge this with db:get-test-info 186 ;; ;; TODO: Converge this with db:get-test-info 159 ;; (define (runs:get-test-info db run-id test-name item-path) 187 ;; (define (runs:get-test-info db run-id test-name item-path) 160 ;; (let ((res #f)) ;; (vector #f #f #f #f #f #f))) 188 ;; (let ((res #f)) ;; (vector #f #f #f #f #f #f))) 161 ;; (sqlite3:for-each-row 189 ;; (sqlite3:for-each-row 162 ;; (lambda (id run-id test-name state status) 190 ;; (lambda (id run-id test-name state status) 163 ;; (set! res (vector id run-id test-name state status item-path))) 191 ;; (set! res (vector id run-id test-name state status item-path)))