Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -7,11 +7,11 @@ ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. ;;====================================================================== -(use sqlite3 srfi-1 posix regex-case base64 format) +(use sqlite3 srfi-1 posix regex-case base64 format dot-locking) (require-extension sqlite3 regex posix) (import (prefix sqlite3 sqlite3:)) (import (prefix base64 base64:)) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -29,10 +29,11 @@ -step stepname -test-status : set the state and status of a test (use :state and :status) -setlog logfname : set the path/filename to the final log relative to the test directory. may be used with -test-status -set-toplog logfname : set the overall log for a suite of sub-tests + -summarize-items : for an itemized test create a summary html -m comment : insert a comment for this test Run data :runname : required, name for this particular test run :state : required if updating step state; e.g. start, end, completed @@ -94,10 +95,11 @@ (list "-h" "-force" "-xterm" "-showkeys" "-test-status" + "-summarize-items" "-gui" "-runall" ;; run all tests "-remove-runs" "-keepgoing" "-usequeue" @@ -544,11 +546,12 @@ (set! *didsomething* #t)))) (if (or (args:get-arg "-setlog") ;; since setting up is so costly lets piggyback on -test-status (args:get-arg "-set-toplog") (args:get-arg "-test-status") - (args:get-arg "-runstep")) + (args:get-arg "-runstep") + (args:get-arg "-summarize-items")) (if (not (getenv "MT_CMDINFO")) (begin (debug:print 0 "ERROR: MT_CMDINFO env var not set, commands -test-status, -runstep and -setlog must be called *inside* a megatest environment!") (exit 5)) (let* ((startingdir (current-directory)) @@ -570,10 +573,12 @@ (set! db (open-db)) (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)) (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 @@ -127,10 +127,35 @@ logf run-id test-name item-path))) (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 + +)) + + ;; ;; 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 "