Index: api.scm ================================================================== --- api.scm +++ api.scm @@ -397,10 +397,11 @@ ((get-test-state-status-by-id) (apply db:get-test-state-status-by-id dbstruct params)) ((test-get-rundir-from-test-id) (apply db:test-get-rundir-from-test-id dbstruct params)) ((get-count-tests-running-for-testname) (apply db:get-count-tests-running-for-testname dbstruct params)) ((get-count-tests-running) (apply db:get-count-tests-running dbstruct params)) ((get-count-tests-running-in-jobgroup) (apply db:get-count-tests-running-in-jobgroup dbstruct params)) + ((get-all-state-status-counts-for-test) (apply db:get-all-state-status-counts-for-test dbstruct params)) ;; ((delete-test-step-records) (apply db:delete-test-step-records dbstruct params)) ;; ((get-previous-test-run-record) (apply db:get-previous-test-run-record dbstruct params)) ((get-matching-previous-test-run-records)(apply db:get-matching-previous-test-run-records dbstruct params)) ((test-get-logfile-info) (apply db:test-get-logfile-info dbstruct params)) ((test-get-records-for-index-file) (apply db:test-get-records-for-index-file dbstruct params)) Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -170,11 +170,10 @@ ;; (define *db-multi-sync-mutex* (make-mutex)) ;; protect access to *db-sync-in-progress*, *db-last-sync* ;; task db (define *task-db* #f) ;; (vector db path-to-db) (define *db-access-allowed* #t) ;; flag to allow access ;; (define *db-access-mutex* (make-mutex)) ;; moved to dbfile -;; (define *db-transaction-mutex* (make-mutex)) (define *db-cache-path* #f) ;; (define *db-with-db-mutex* (make-mutex)) (define *db-api-call-time* (make-hash-table)) ;; hash of command => (list of times) ;; SERVER Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -2626,11 +2626,11 @@ 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) + (hash-table-set! *db:get-test-info-by-id-cache* hash-key (cons (current-seconds) res)) res)))))) (define *db:get-test-state-status-by-id-cache* (make-hash-table)) ;; Get test state, status using test_id @@ -3150,11 +3150,11 @@ db (lambda () ;; NB// Pass the db so it is part fo the transaction (db:test-set-state-status-db db run-id test-id state status comment) ;; this call sets the item state/status (if (not (equal? item-path "")) ;; only roll up IF incoming test is an item - (let* ((state-status-counts (db:get-all-state-status-counts-for-test db run-id test-name item-path state status)) ;; item-path is used to exclude current state/status of THIS test + (let* ((state-status-counts (db:get-all-state-status-counts-for-test-db db run-id test-name item-path state status)) ;; item-path is used to exclude current state/status of THIS test (state-statuses (db:roll-up-rules state-status-counts state status)) (newstate (car state-statuses)) (newstatus (cadr state-statuses))) (set! new-state-eh newstate) (set! new-status-eh newstatus) @@ -3264,15 +3264,20 @@ (db:with-db dbstruct #f #f (lambda (dbdat db) (db:get-all-state-status-counts-for-run-db dbdat db run-id)))) -;; BBnote: db:get-all-state-status-counts-for-test returns dbr:counts object aggregating state and status of items of a given test, *not including rollup state/status* +(define (db:get-all-state-status-counts-for-test dbstruct run-id test-name item-path item-state-in item-status-in) + (db:with-db + dbstruct run-id #f + (lambda (dbdat db) + (db:get-all-state-status-counts-for-test-db db run-id test-name item-path item-state-in item-status-in)))) + ;; BBnote: db:get-all-state-status-counts-for-test returns dbr:counts object aggregating state and status of items of a given test, *not including rollup state/status* ;; ;; NOTE: This is called within a transaction ;; -(define (db:get-all-state-status-counts-for-test db run-id test-name item-path item-state-in item-status-in) +(define (db:get-all-state-status-counts-for-test-db db run-id test-name item-path item-state-in item-status-in) (let* ((test-info (db:get-test-info-db db run-id test-name item-path)) (item-state (or item-state-in (db:test-get-state test-info))) (item-status (or item-status-in (db:test-get-status test-info))) (other-items-count-recs (sqlite3:map-row (lambda (state status count) Index: mt.scm ================================================================== --- mt.scm +++ mt.scm @@ -303,28 +303,26 @@ (let* ((test-id (if (number? test-name) test-name (db:keep-trying-until-true rmt:get-test-id (list run-id test-name item-path) - 10))) + 10))) ;; (rmt:get-test-id run-id test-name item-path))) (testdat (rmt:get-test-info-by-id run-id test-id)) ;; (test-id (db:test-get-id testdat)) (test-name (if (number? test-name) (db:test-get-testname testdat) test-name)) (item-path (db:test-get-item-path testdat)) - (tl-testdat (rmt:get-test-info run-id test-name "")) - (tl-test-id (if tl-testdat - (db:test-get-id tl-testdat) - #f)) + (tl-test-id (rmt:get-test-id run-id test-name "")) + (tl-testdat (rmt:get-test-info-by-id run-id test-id)) (new-state-eh #f) (new-status-eh #f)) (if (member state '("LAUNCHED" "REMOTEHOSTSTART")) (rmt:general-call run-id 'set-test-start-time (list test-id))) (let* ((res (begin - (rmt:test-set-state-status-db run-id test-id state status comment) ;; this call sets the item state/status + (rmt:test-set-state-status run-id test-id state status comment) ;; this call sets the item state/status (if (not (equal? item-path "")) ;; only roll up IF incoming test is an item (let* ((state-status-counts (rmt:get-all-state-status-counts-for-test run-id test-name item-path state status)) ;; item-path is used to exclude current state/status of THIS test (state-statuses (db:roll-up-rules state-status-counts state status)) (newstate (car state-statuses)) (newstatus (cadr state-statuses))) @@ -338,11 +336,10 @@ (with-output-to-string (lambda () (pp (dbr:counts->alist x)))) " | ")) state-status-counts))); end debug:print (if tl-test-id (rmt:test-set-state-status run-id tl-test-id newstate newstatus #f)) ;; we are still in the transaction - must access the db and not the dbstruct ))))) - (mutex-unlock! *db-transaction-mutex*) (if (and test-id state status (equal? status "AUTO")) (rmt:test-data-rollup run-id test-id status)) (if new-state-eh ;; moved from db:test-set-state-status (mt:process-triggers run-id test-id new-state-eh new-status-eh)) res))) Index: rmt.scm ================================================================== --- rmt.scm +++ rmt.scm @@ -435,10 +435,12 @@ (define (rmt:get-count-tests-running-for-testname run-id testname) (assert (number? run-id) "FATAL: Run id required.") (rmt:send-receive 'get-count-tests-running-for-testname run-id (list run-id testname))) +(define (rmt:get-all-state-status-counts-for-test run-id test-name item-path item-state-in item-status-in) + (rmt:send-receive 'get-all-state-status-counts-for-test run-id (list run-id test-name item-path item-state-in item-status-in))) (define (rmt:get-count-tests-running-in-jobgroup run-id jobgroup) (assert (number? run-id) "FATAL: Run id required.") (rmt:send-receive 'get-count-tests-running-in-jobgroup run-id (list run-id jobgroup))) (define (rmt:set-state-status-and-roll-up-run run-id state status)