Index: api.scm ================================================================== --- api.scm +++ api.scm @@ -47,10 +47,11 @@ get-runs-by-patt get-steps-data login testmeta-get-record have-incompletes? + synchash-get )) (define api:write-queries '( ;; SERVERS @@ -188,10 +189,11 @@ ((get-testinfo-state-status) (apply db:get-testinfo-state-status dbstruct params)) ((test-get-top-process-pid) (apply db:test-get-top-process-pid dbstruct params)) ((test-get-paths-matching-keynames-target-new) (apply db:test-get-paths-matching-keynames-target-new dbstruct params)) ((get-prereqs-not-met) (apply db:get-prereqs-not-met dbstruct params)) ((get-count-tests-running-for-run-id) (apply db:get-count-tests-running-for-run-id dbstruct params)) + ((synchash-get) (apply synchash:server-get dbstruct params)) ;; RUNS ((get-run-info) (apply db:get-run-info dbstruct params)) ((get-run-status) (apply db:get-run-status dbstruct params)) ((set-run-status) (apply db:set-run-status dbstruct params)) Index: dcommon.scm ================================================================== --- dcommon.scm +++ dcommon.scm @@ -136,21 +136,26 @@ (get-tests-sig (conc (client:get-signature) " get-tests")) (get-details-sig (conc (client:get-signature) " get-test-details")) ;; test-ids to get and display are indexed on window-id in curr-test-ids hash (test-ids (hash-table-values (dboard:data-get-curr-test-ids *data*))) - - (run-changes (synchash:client-get 'db:get-runs get-runs-sig (length keypatts) data runname #f #f keypatts)) + ;; run-id is #f in next line to send the query to server 0 + (run-changes (synchash:client-get 'db:get-runs get-runs-sig (length keypatts) data #f runname #f #f keypatts)) (tests-detail-changes (if (not (null? test-ids)) (synchash:client-get 'db:get-test-info-by-ids get-details-sig 0 data #f test-ids) '())) ;; Now can calculate the run-ids (run-hash (hash-table-ref/default data get-runs-sig #f)) (run-ids (if run-hash (filter number? (hash-table-keys run-hash)) '())) - (test-changes (synchash:client-get 'db:get-tests-for-runs-mindata get-tests-sig 0 data run-ids testpatt states statuses #f)) + (all-test-changes (let ((res (make-hash-table))) + (for-each (lambda (run-id) + (if (> run-id 0) + (hash-table-set! res run-id (synchash:client-get 'db:get-tests-for-run-mindata get-tests-sig 0 data run-id 1 testpatt states statuses #f)))) + run-ids) + res)) (runs-hash (hash-table-ref/default data get-runs-sig #f)) (header (hash-table-ref/default runs-hash "header" #f)) (run-ids (sort (filter number? (hash-table-keys runs-hash)) (lambda (a b) (let* ((record-a (hash-table-ref runs-hash a)) @@ -192,10 +197,11 @@ ;; Scan all tests to be displayed and organise all the test names, respecting what is in the hash table ;; Do this analysis in the order of the run-ids, the most recent run wins (for-each (lambda (run-id) (let* ((run-path (hash-table-ref (dboard:data-get-run-keys *data*) run-id)) + (test-changes (hash-table-ref all-test-changes run-id)) (new-test-dat (car test-changes)) (removed-tests (cadr test-changes)) (tests (sort (map cadr (filter (lambda (testrec) (eq? run-id (db:mintest-get-run_id (cadr testrec)))) new-test-dat)) @@ -269,11 +275,11 @@ (if updater (updater (hash-table-ref/default data get-details-sig #f)))) (iup:attribute-set! (dboard:data-get-runs-matrix *data*) "REDRAW" "ALL") ;; (debug:print 2 "run-changes: " run-changes) ;; (debug:print 2 "test-changes: " test-changes) - (list run-changes test-changes))) + (list run-changes all-test-changes))) ;;====================================================================== ;; TESTS DATA ;;====================================================================== Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -798,11 +798,11 @@ ;; set up the run work area for this test (if (and (args:get-arg "-preclean") ;; user has requested to preclean for this run (not (member (db:test-get-rundir testinfo)(list "n/a" "/tmp/badname")))) ;; n/a is a placeholder and thus not a read dir (begin (debug:print-info 0 "attempting to preclean directory " (db:test-get-rundir testinfo) " for test " test-name "/" item-path) - (runs:remove-test-directory #f testinfo 'remove-data-only))) ;; remove data only, do not perturb the record + (runs:remove-test-directory testinfo 'remove-data-only))) ;; remove data only, do not perturb the record ;; prevent overlapping actions - set to LAUNCHED as early as possible ;; (tests:test-set-status! run-id test-id "LAUNCHED" "n/a" #f #f) ;; (if launch-results launch-results "FAILED")) (rmt:roll-up-pass-fail-counts run-id test-name item-path "LAUNCHED") Index: rmt.scm ================================================================== --- rmt.scm +++ rmt.scm @@ -381,10 +381,14 @@ (begin (debug:print "ERROR: rmt:get-tests-for-run called with bad run-id=" run-id) (print-call-chain (current-error-port)) '()))) +;; get stuff via synchash +(define (rmt:synchash-get run-id proc synckey keynum params) + (rmt:send-receive 'synchash-get run-id (list run-id proc synckey keynum params))) + ;; IDEA: Threadify these - they spend a lot of time waiting ... ;; (define (rmt:get-tests-for-runs-mindata run-ids testpatt states status not-in) (let ((multi-run-mutex (make-mutex)) (run-id-list (if run-ids Index: synchash.scm ================================================================== --- synchash.scm +++ synchash.scm @@ -62,13 +62,12 @@ ;; (cdb:remote-run db:get-num-runs #f "%") ;; (cdb:remote-run db:get-runs #f runnamepatt numruns *start-run-offset* keypatts) ;; ;; keynum => the field to use as the unique key (usually 0 but can be other field) ;; -(define (synchash:client-get proc synckey keynum synchash . params) - (let* ((data ;; (apply cdb:remote-run synchash:server-get #f proc synckey keynum params)) - (apply synchash:server-get #f proc synckey keynum params)) +(define (synchash:client-get proc synckey keynum synchash run-id . params) + (let* ((data (rmt:synchash-get run-id proc synckey keynum params)) (newdat (car data)) (removs (cadr data)) (myhash (hash-table-ref/default synchash synckey #f))) (if (not myhash) (begin @@ -89,17 +88,18 @@ ;; data)) ;; return the changed and deleted list (list newdat removs))) ;; synchash)) (define *synchashes* (make-hash-table)) -(define (synchash:server-get indb proc synckey keynum . params) +(define (synchash:server-get dbstruct run-id proc synckey keynum params) ;; (debug:print-info 2 "synckey: " synckey ", keynum: " keynum ", params: " params) - (let* ((db (if indb indb (db:open-megatest-db))) + (let* ((dbdat (db:get-db dbstruct run-id)) + (db (db:dbdat-get-db dbdat)) (synchash (hash-table-ref/default *synchashes* synckey #f)) (newdat (apply (case proc ((db:get-runs) db:get-runs) - ((db:get-tests-for-runs-mindata) db:get-tests-for-runs-mindata) + ((db:get-tests-for-run-mindata) db:get-tests-for-run-mindata) ((db:get-test-info-by-ids) db:get-test-info-by-ids) (else (print "ERROR: sync for hash " proc " not setup! Edits needed in synchash.scm") print)) db params))