Index: api.scm ================================================================== --- api.scm +++ api.scm @@ -344,11 +344,11 @@ ((have-incompletes?) (apply db:have-incompletes? dbstruct params)) ((login) (apply db:login dbstruct params)) ((general-call) (let ((stmtname (car params)) (run-id (cadr params)) (realparams (cddr params))) - (db:general-call dbstruct stmtname realparams))) + (db:general-call dbstruct run-id stmtname realparams))) ((sdb-qry) (apply sdb:qry params)) ((ping) (current-process-id)) ((get-changed-record-ids) (apply db:get-changed-record-ids dbstruct params)) ((get-run-record-ids) (apply db:get-run-record-ids dbstruct params)) ;; TESTMETA Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -1220,11 +1220,13 @@ FOR EACH ROW BEGIN UPDATE test_data SET last_update=(strftime('%s','now')) WHERE id=old.id; END;" ))) - +;; +;; ADD run-id SUPPORT +;; (define (db:create-all-triggers dbstruct) (db:with-db dbstruct #f #f (lambda (dbdat db) (db:create-triggers db)))) @@ -1690,11 +1692,11 @@ (deadtime (if (and deadtime-str (string->number deadtime-str)) (string->number deadtime-str) 72000))) ;; twenty hours (db:with-db - dbstruct #f #f + dbstruct run-id #f (lambda (dbdat db) (if (number? ovr-deadtime)(set! deadtime ovr-deadtime)) ;; in RUNNING or REMOTEHOSTSTART for more than 10 minutes ;; @@ -1773,11 +1775,11 @@ ) (debug:print-info 4 *default-log-port* "running-deadtime = " running-deadtime) (debug:print-info 4 *default-log-port* "deadtime-trim = " deadtime-trim) (db:with-db - dbstruct #f #f + dbstruct run-id #f (lambda (dbdat db) (let* ((stmth1 (db:get-cache-stmth dbdat run-id db "SELECT id,rundir,uname,testname,item_path,event_time,run_duration FROM tests WHERE run_id=? AND (strftime('%s','now') - event_time) > (run_duration + ?) @@ -1894,11 +1896,11 @@ ))))))) ;; BUG: Probably broken - does not explicitly use run-id in the query ;; (define (db:top-test-set-per-pf-counts dbstruct run-id test-name) - (db:general-call dbstruct 'top-test-set-per-pf-counts (list test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name))) + (db:general-call dbstruct run-id 'top-test-set-per-pf-counts (list test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name))) ;; Clean out old junk and vacuum the database ;; ;; Ultimately do something like this: ;; @@ -2051,11 +2053,11 @@ ;; also updates *global-delta* ;; (define (db:get-var dbstruct var) (let* ((res #f)) (db:with-db - dbstruct #f #f + dbstruct run-id #f (lambda (dbdat db) (sqlite3:for-each-row (lambda (val) (set! res val)) db @@ -2106,11 +2108,11 @@ ;;====================================================================== ;; no-sync.db - small bits of data to be shared between servers ;;====================================================================== (define (db:open-no-sync-db) - (dbfile:open-no-syncd-db (db:dbfile-path))) + (dbfile:open-no-sync-db (db:dbfile-path))) ;; if we are not a server create a db handle. this is not finalized ;; so watch for problems. I'm still not clear if it is needed to manually ;; finalize sqlite3 dbs with the sqlite3 egg. ;; @@ -3090,14 +3092,14 @@ ;; Convert calling routines to get list of run-ids and loop, do not use the get-tests-for-runs ;; (define (db:delete-test-records dbstruct run-id test-id) - (db:general-call dbstruct 'delete-test-step-records (list test-id)) - (db:general-call dbstruct 'delete-test-data-records (list test-id)) + (db:general-call dbstruct run-id 'delete-test-step-records (list test-id)) + (db:general-call dbstruct run-id 'delete-test-data-records (list test-id)) (db:with-db - dbstruct #f #f + dbstruct run-id #f (lambda (dbdat db) (sqlite3:execute db "UPDATE tests SET state='DELETED',status='n/a',comment='' WHERE id=?;" test-id)))) ;; (define (db:delete-old-deleted-test-records dbstruct) @@ -3157,12 +3159,11 @@ ;; NOTE: run-id is not used ;; ;; (define (db:test-set-state-status dbstruct run-id test-id newstate newstatus newcomment) (db:with-db dbstruct - ;; run-id - #f + run-id #t (lambda (dbdat db) (cond ((and newstate newstatus newcomment) (sqlite3:execute db "UPDATE tests SET state=?,status=?,comment=? WHERE id=?;" newstate newstatus newcomment ;; (sdb:qry 'getid newcomment) @@ -3433,11 +3434,11 @@ ;; Get test data using test_id, run-id is not used ;; (define (db:get-test-info-by-id dbstruct run-id test-id) (db:with-db dbstruct - #f ;; run-id + run-id #f (lambda (dbdat db) (let ((res #f)) (sqlite3:for-each-row ;; attemptnum added to hold pid of top process (not Megatest) controlling a test (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id attemptnum archived last-update) @@ -3617,11 +3618,11 @@ ;; if one or more are fail (any case) then set test status to PASS, non "pass" or "fail" are ignored (define (db:test-data-rollup dbstruct run-id test-id status) (let* ((fail-count 0) (pass-count 0)) (db:with-db - dbstruct #f #f + dbstruct run-id #f (lambda (dbdat db) (sqlite3:for-each-row (lambda (fcount pcount) (set! fail-count fcount) (set! pass-count pcount)) @@ -3628,13 +3629,13 @@ db "SELECT (SELECT count(id) FROM test_data WHERE test_id=? AND status like 'fail') AS fail_count, (SELECT count(id) FROM test_data WHERE test_id=? AND status like 'pass') AS pass_count;" test-id test-id) ;; Now rollup the counts to the central megatest.db - (db:general-call dbstruct 'pass-fail-counts (list pass-count fail-count test-id)) + (db:general-call dbstruct run-id 'pass-fail-counts (list pass-count fail-count test-id)) ;; if the test is not FAIL then set status based on the fail and pass counts. - (db:general-call dbstruct 'test_data-pf-rollup (list test-id test-id test-id test-id)))))) + (db:general-call dbstruct run-id 'test_data-pf-rollup (list test-id test-id test-id test-id)))))) ;; each section is a rule except "final" which is the final result ;; ;; [rule-5] ;; operator in @@ -3935,14 +3936,14 @@ (tl-testdat (db:get-test-info dbstruct run-id test-name "")) (tl-test-id (if tl-testdat (db:test-get-id tl-testdat) #f))) (if (member state '("LAUNCHED" "REMOTEHOSTSTART")) - (db:general-call dbstruct 'set-test-start-time (list test-id))) + (db:general-call dbstruct run-id 'set-test-start-time (list test-id))) (mutex-lock! *db-transaction-mutex*) (db:with-db - dbstruct #f #f + dbstruct run-id #f (lambda (dbdat db) (let ((tr-res (sqlite3:with-transaction db (lambda () @@ -4299,28 +4300,29 @@ (else (hash-table-set! *logged-in-clients* client-signature (current-seconds)) '(#t "successful login")))) -(define (db:general-call dbstruct stmtname params) +(define (db:general-call dbstruct run-id stmtname params) + ;; Why is db:lookup-query above not used here to get the query? (let ((query (let ((q (alist-ref (if (string? stmtname) (string->symbol stmtname) stmtname) db:queries))) (if q (car q) #f)))) (db:with-db - dbstruct #f #f + dbstruct run-id #f (lambda (dbdat db) (apply sqlite3:execute db query params) #t)))) ;; get a summary of state and status counts to calculate a rollup ;; (define (db:get-state-status-summary dbstruct run-id testname) (let ((res '())) (db:with-db - dbstruct #f #f + dbstruct run-id #f (lambda (dbdat db) (sqlite3:for-each-row (lambda (state status count) (set! res (cons (vector state status count) res))) db Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -481,11 +481,11 @@ ;; -mrw- I'm removing KILLREQ from this list so that a test in KILLREQ state is treated as a "do not run" flag. ((member (db:test-get-state test-info) '("INCOMPLETE" "KILLED" "UNKNOWN" "STUCK")) ;; prior run of this test didn't complete, go ahead and try to rerun (debug:print 0 *default-log-port* "INFO: test is INCOMPLETE or KILLED, treat this execute call as a rerun request") ;; (tests:test-force-state-status! run-id test-id "REMOTEHOSTSTART" "n/a") - (rmt:general-call 'set-test-start-time #f test-id) + (rmt:general-call 'set-test-start-time run-id test-id) (rmt:test-set-state-status run-id test-id "REMOTEHOSTSTART" "n/a" #f) ) ;; prime it for running ((member (db:test-get-state test-info) '("RUNNING" "REMOTEHOSTSTART")) (if (process:alive-on-host? test-host test-pid) (debug:print-error 0 *default-log-port* "test state is " (db:test-get-state test-info) " and process " test-pid " is still running on host " test-host ", cannot proceed") @@ -494,11 +494,11 @@ (debug:print 0 *default-log-port* "test state is " (db:test-get-state test-info) ", cannot proceed") (debug:print 0 *default-log-port* "exiting with status 1") (exit 1)) ((not (member (db:test-get-state test-info) '("REMOVING" "REMOTEHOSTSTART" "RUNNING" "KILLREQ"))) ;; (tests:test-force-state-status! run-id test-id "REMOTEHOSTSTART" "n/a") - (rmt:general-call 'set-test-start-time #f test-id) + (rmt:general-call 'set-test-start-time run-id test-id) (rmt:test-set-state-status run-id test-id "REMOTEHOSTSTART" "n/a" #f)) (else ;; (member (db:test-get-state test-info) '("REMOVING" "REMOTEHOSTSTART" "RUNNING" "KILLREQ")) (debug:print 0 *default-log-port* "test state is " (db:test-get-state test-info) ", cannot proceed") (debug:print 0 *default-log-port* "exiting with status 1") (exit 1))))