Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -1077,11 +1077,11 @@ db qrystr) res)) ;;====================================================================== -;; QUEUE UP META, TEST STATUS AND STEPS +;; QUEUE UP META, TEST STATUS AND STEPS REMOTE ACCESS ;;====================================================================== ;; db:updater is run in a thread to write out the cached data periodically ;; (define (db:updater) ;; (debug:print-info 4 "Starting cache processing") @@ -1199,10 +1199,24 @@ (cdb:client-call zmqsocket 'immediate #f open-run-close db:get-test-info-by-id #f test-id)) ;; db should be db open proc or #f (define (cdb:remote-run proc db . params) (apply cdb:client-call *runremote* 'immediate #f open-run-close proc #f params)) + +(define (db:test-get-logfile-info db run-id test-name) + (let ((res #f)) + (sqlite3:for-each-row + (lambda (path final_logf) + (set! logf final_logf) + (set! res (list path final_logf)) + (if (directory? path) + (print "Found path: " path) + (print "No such path: " path))) + db + "SELECT rundir,final_logf FROM tests WHERE run_id=? AND testname=? AND item_path='';" + run-id test-name) + res)) (define db:queries (list '(register-test "INSERT OR IGNORE INTO tests (run_id,testname,event_time,item_path,state,status) VALUES (?,?,strftime('%s','now'),?,'NOT_STARTED','n/a');") '(state-status "UPDATE tests SET state=?,status=? WHERE id=?;") '(state-status-msg "UPDATE tests SET state=?,status=?,comment=? WHERE id=?;") @@ -1218,10 +1232,11 @@ END WHERE id=?;") '(test-set-log "UPDATE tests SET final_logf=? WHERE id=?;") '(test-set-rundir-by-test-id "UPDATE tests SET rundir=? WHERE id=?") '(test-set-rundir "UPDATE tests SET rundir=? WHERE run_id=? AND testname=? AND item_path=?;") '(delete-tests-in-state "DELETE FROM tests WHERE state=? AND run_id=?;") + '(tests:test-set-toplog "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path='';") )) ;; do not run these as part of the transaction (define db:special-queries '(rollup-tests-pass-fail db:roll-up-pass-fail-counts)) @@ -1309,10 +1324,20 @@ (let ((cache-size (length data))) (if (> cache-size *max-cache-size*) (set! *max-cache-size* cache-size))) )) #f)) + +(define (db:test-get-records-for-index-file db run-id test-name) + (let ((res '())) + (sqlite3:for-each-row + (lambda (id itempath state status run_duration logf comment) + (set! res (cons (vector id itempath state status run_duration logf comment) res))) + 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) + res)) ;; Rollup the pass/fail counts from itemized tests into fail_count and pass_count (define (db:roll-up-pass-fail-counts db run-id test-name item-path status) ;; (cdb:flush-queue *runremote*) (if (and (not (equal? item-path "")) Index: tests.scm ================================================================== --- tests.scm +++ tests.scm @@ -303,33 +303,38 @@ (print "Failed to obtain lock for " outputfilename)) (let ((oup (open-output-file outputfilename)) (counts (make-hash-table)) (statecounts (make-hash-table)) (outtxt "") - (tot 0)) + (tot 0) + (testdat (cdb:remote-run db:test-get-records-for-index-file run-id test-name))) (with-output-to-port oup (lambda () (set! outtxt (conc outtxt "Summary: " test-name "

Summary for " test-name "

")) - (sqlite3:for-each-row - (lambda (id itempath state status run_duration logf 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) - + (for-each + (lambda (testrecord) + (let ((id (vector-ref testrecord 0)) + (itempath (vector-ref testrecord 1)) + (state (vector-ref testrecord 2)) + (status (vector-ref testrecord 3)) + (run_duration (vector-ref testrecord 4)) + (logf (vector-ref testrecord 5)) + (comment (vector-ref testrecord 6))) + (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) "" + "")))) + testdat) (print "
") ;; Print out stats for status (set! tot 0) (print "") (for-each (lambda (state)

State stats