Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -2315,11 +2315,13 @@ ;; ;; NB// Ultimately this will be deprecated in deference to mt:test-set-state-status-by-id ;; ;; NOTE: run-id is not used ;; ;; (define (db:test-set-state-status dbstruct run-id test-id newstate newstatus newcomment) - (hash-table-delete! *db:get-test-info-by-id-cache* (cons run-id test-id)) + (let* ((hash-key (cons run-id test-id))) + (hash-table-delete! *db:get-test-info-by-id-cache* hash-key) + (hash-table-delete! *db:get-test-state-status-by-id-cache*hash-key)) (db:with-db dbstruct run-id #t (lambda (dbdat db) (db:test-set-state-status-db db run-id test-id newstate newstatus newcomment)))) @@ -2451,22 +2453,30 @@ (sqlite3:first-result db "SELECT count(id) FROM tests WHERE state in ('LAUNCHED','NOT_STARTED','REMOTEHOSTSTART','RUNNING','KILLREQ') AND run_id=?;") run-id))) +(define *db:get-test-id-cache* (make-hash-table)) + ;; map run-id, testname item-path to test-id (define (db:get-test-id dbstruct run-id testname item-path) - (db:with-db - dbstruct - run-id - #f - (lambda (dbdat db) - (db:first-result-default - db - "SELECT id FROM tests WHERE testname=? AND item_path=? AND run_id=?;" - #f ;; the default - testname item-path run-id)))) + (let* ((hash-key (list run-id testname item-path)) + (cache-result (hash-table-ref/default *db:get-test-id-cache* hash-key #f))) + (if cache-result + (cdr cache-result) + (let* ((res (db:with-db + dbstruct + run-id + #f + (lambda (dbdat db) + (db:first-result-default + db + "SELECT id FROM tests WHERE testname=? AND item_path=? AND run_id=?;" + #f ;; the default + testname item-path run-id))))) + (if res (hash-table-set! *db:get-test-id-cache* hash-key (cons (current-seconds) res))) + res)))) ;; overload the unused attemptnum field for the process id of the runscript or ;; ezsteps step script in progress ;; (define (db:test-set-top-process-pid dbstruct run-id test-id pid) @@ -2591,37 +2601,44 @@ (lambda (run-id) (let ((testrecs (db:get-all-tests-info-by-run-id mtdb run-id))) (db:prep-megatest.db-adj-test-ids (dbr:dbdat-dbh mtdb) run-id testrecs))) run-ids))) +(define *db:get-test-info-by-id-cache* (make-hash-table)) + ;; Get test data using test_id ;; (define (db:get-test-info-by-id dbstruct run-id test-id) - (db:with-db - dbstruct - 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) - ;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 - (set! res (vector 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))) - db - ;; (db:get-cache-stmth dbdat db - ;; (conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id=? AND run_id=?;")) - (conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id=? AND run_id=?;") - test-id run-id) - res)))) - -(define *db:get-test-info-by-id-cache* (make-hash-table)) + (let* ((hash-key (cons run-id test-id)) + (cache-result (hash-table-ref/default *db:get-test-info-by-id-cache* hash-key #f))) + (if cache-result + (cdr cache-result) + (db:with-db + dbstruct + 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) + ;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 + (set! res (vector 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))) + db + ;; (db:get-cache-stmth dbdat db + ;; (conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id=? AND run_id=?;")) + (conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id=? AND run_id=?;") + test-id run-id) + (hash-table-set! *db:get-test-info-by-id-cache* hash-key res) + res)))))) + +(define *db:get-test-state-status-by-id-cache* (make-hash-table)) ;; Get test state, status using test_id ;; (define (db:get-test-state-status-by-id dbstruct run-id test-id) (let* ((hash-key (cons run-id test-id)) - (cache-result (hash-table-ref/default *db:get-test-info-by-id-cache* hash-key #f))) + (cache-result (hash-table-ref/default *db:get-test-state-status-by-id-cache* hash-key #f))) (if cache-result (cdr cache-result) (db:with-db dbstruct run-id @@ -2633,11 +2650,11 @@ (lambda (state status) (cons state status)) db "SELECT state,status FROM tests WHERE id=? AND run_id=?;" ;; stmth try not compiling this one - yes, this fixed the bind issue test-id run-id) - (hash-table-set! *db:get-test-info-by-id-cache* hash-key (cons (current-seconds) res)) + (hash-table-set! *db:get-test-state-status-by-id-cache* hash-key (cons (current-seconds) res)) res)))))) ;; Use db:test-get* to access ;; Get test data using test_ids. NB// Only works within a single run!! ;; @@ -2671,16 +2688,18 @@ ;; (debug:print-info 0 *default-log-port* "proc never returned true, params="params) (print"db:keep-trying-until-true proc never returned true, proc = " proc " params =" params " tries = " tries) #f))))) (define (db:get-test-info dbstruct run-id test-name item-path) - (db:with-db - dbstruct - run-id - #f - (lambda (dbdat db) - (db:get-test-info-db db run-id test-name item-path)))) + (let* ((test-id (db:get-test-id dbstruct run-id test-name item-path))) + (db:get-test-info-by-id dbstruct run-id test-id))) +;; (db:with-db +;; dbstruct +;; run-id +;; #f +;; (lambda (dbdat db) +;; (db:get-test-info-db db run-id test-name item-path)))) (define (db:get-test-info-db db run-id test-name item-path) (let ((res #f)) (sqlite3:for-each-row (lambda (a . b)