Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -951,27 +951,16 @@ (sqlite3:execute db "UPDATE tests SET comment=? WHERE id=?;" comment test-id)) -;; -(define (db:test-set-rundir! db run-id test-name item-path rundir) - (sqlite3:execute - db - "UPDATE tests SET rundir=? WHERE run_id=? AND testname=? AND item_path=?;" - rundir run-id test-name item-path)) +(define (cdb:test-set-rundir! zmqsocket run-id test-name item-path rundir) + (cdb:client-call zmqsocket 'test-set-rundir #t rundir run-id test-name item-path)) (define (cdb:test-set-rundir-by-test-id zmqsocket test-id rundir) (cdb:client-call zmqsocket 'test-set-rundir-by-test-id #t test-id rundir)) -;; (define (db:test-set-rundir-by-test-id! db test-id rundir) -;; (sqlite3:execute -;; db -;; "UPDATE tests SET rundir=? WHERE id=?" -;; rundir test-id)) - -;; (define (db:test-get-rundir-from-test-id db test-id) (let ((res (hash-table-ref/default *test-paths* test-id #f))) (if res res (begin @@ -1203,10 +1192,13 @@ (cdb:client-call zmqsocket 'immediate #f open-run-close db:roll-up-pass-fail-counts #f run-id test-name item-path status)) (define (cdb:get-test-info zmqsocket run-id test-name item-path) (cdb:client-call zmqsocket 'immediate #f open-run-close db:get-test-info #f run-id test-name item-path)) +(define (cdb:get-test-info-by-id zmqsocket test-id) + (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:queries @@ -1223,10 +1215,11 @@ THEN 'PASS' ELSE status 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=?;") )) ;; do not run these as part of the transaction (define db:special-queries '(rollup-tests-pass-fail db:roll-up-pass-fail-counts)) Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -188,11 +188,11 @@ ;; call the command using mt_ezstep (set! script (conc "mt_ezstep " stepname " " (if prevstep prevstep "-") " " stepcmd)) (debug:print 4 "script: " script) - (open-run-close db:teststep-set-status! #f test-id stepname "start" "-" #f #f) + (cdb:remote-run db:teststep-set-status! #f test-id stepname "start" "-" #f #f) ;; now launch (let ((pid (process-run script))) (let processloop ((i 0)) (let-values (((pid-val exit-status exit-code)(process-wait pid #t))) (mutex-lock! m) @@ -206,11 +206,11 @@ (processloop (+ i 1)))) )) (let ((exinfo (vector-ref exit-info 2)) (logfna (if logpro-used (conc stepname ".html") ""))) ;; testing if procedures called in a remote call cause problems (ans: no or so I suspect) - (open-run-close db:teststep-set-status! #f test-id stepname "end" exinfo #f logfna)) + (cdb:remote-run db:teststep-set-status! #f test-id stepname "end" exinfo #f logfna)) (if logpro-used (cdb:test-set-log! *runremote* test-id (conc stepname ".html"))) ;; set the test final status (let* ((this-step-status (cond ((and (eq? (vector-ref exit-info 2) 2) logpro-used) 'warn) @@ -295,11 +295,11 @@ (thread-start! th1) (thread-start! th2) (thread-join! th2) (mutex-lock! m) (let* ((item-path (item-list->path itemdat)) - (testinfo (open-run-close db:get-test-info-by-id #f test-id))) ;; )) ;; run-id test-name item-path))) + (testinfo (cdb:get-test-info-by-id *runremote* test-id))) ;; )) ;; run-id test-name item-path))) ;; Am I completed? (if (not (equal? (db:test-get-state testinfo) "COMPLETED")) (begin (debug:print 2 "Test NOT logged as COMPLETED, (state=" (db:test-get-state testinfo) "), updating result, rollup-status is " rollup-status) (tests:test-set-status! test-id @@ -386,17 +386,17 @@ ;; All log file links should be stored relative to the top of link path ;; ;; - [ - ] ;; (define (create-work-area db run-id test-id test-src-path disk-path testname itemdat) - (let* ((run-info (db:get-run-info db run-id)) + (let* ((run-info (cdb:remote-run db:get-run-info #f run-id)) (item-path (item-list->path itemdat)) (runname (db:get-value-by-header (db:get-row run-info) (db:get-header run-info) "runname")) ;; convert back to db: from rdb: - this is always run at server end - (key-vals (db:get-key-vals db run-id)) + (key-vals (cdb:remote-run db:get-key-vals #f run-id)) (target (string-intersperse key-vals "/")) (not-iterated (equal? "" item-path)) ;; all tests are found at /test-base or /test-base @@ -433,14 +433,15 @@ ;; again. ;; NB - This is not working right - some top tests are not getting the path set!!! (if (not (hash-table-ref/default *toptest-paths* testname #f)) - (let* ((testinfo (db:get-test-info-by-id db test-id)) ;; run-id testname item-path)) + (let* ((testinfo (cdb:get-test-info-by-id *runremote* test-id)) ;; run-id testname item-path)) (curr-test-path (if testinfo (db:test-get-rundir testinfo) #f))) (hash-table-set! *toptest-paths* testname curr-test-path) - (db:test-set-rundir! db run-id testname "" lnkpath) ;; toptest-path) + ;; NB// Was this for the test or for the parent in an iterated test? + (cdb:test-set-rundir! *runremote* run-id testname item-path lnkpath) ;; toptest-path) (if (or (not curr-test-path) (not (directory-exists? toptest-path))) (begin (debug:print-info 2 "Creating " toptest-path " and link " lnkpath) (create-directory toptest-path #t) @@ -538,12 +539,12 @@ (diskpath #f) (cmdparms #f) (fullcmd #f) ;; (define a (with-output-to-string (lambda ()(write x)))) (mt-bindir-path #f) (item-path (item-list->path itemdat)) - (test-id (open-run-close db:get-test-id db run-id test-name item-path)) - (testinfo (open-run-close db:get-test-info-by-id db test-id)) + (test-id (cdb:remote-run db:get-test-id #f run-id test-name item-path)) + (testinfo (cdb:remote-run db:get-test-info-by-id #f test-id)) (mt_target (string-intersperse (map cadr keyvallst) "/")) (debug-param (append (if (args:get-arg "-debug") (list "-debug" (args:get-arg "-debug")) '()) (if (args:get-arg "-logging")(list "-logging") '())))) (if hosts (set! hosts (string-split hosts))) ;; set the megatest to be called on the remote host @@ -577,12 +578,12 @@ (list 'env-ovrd (hash-table-ref/default *configdat* "env-override" '())) (list 'set-vars (if params (hash-table-ref/default params "-setvars" #f))) (list 'runname runname) (list 'mt-bindir-path mt-bindir-path))))))) ;; (string-intersperse keyvallst " ")))) ;; clean out step records from previous run if they exist - (debug:print-info 4 "FIXMEEEEE!!!! This can be removed some day, perhaps move all test records to the test db?") - (open-run-close db:delete-test-step-records db test-id) + ;; (debug:print-info 4 "FIXMEEEEE!!!! This can be removed some day, perhaps move all test records to the test db?") + ;; (open-run-close db:delete-test-step-records db test-id) (change-directory work-area) ;; so that log files from the launch process don't clutter the test dir (tests:test-set-status! test-id "LAUNCHED" "n/a" #f #f) ;; (if launch-results launch-results "FAILED")) (cond ((and launcher hosts) ;; must be using ssh hostname (set! fullcmd (append launcher (car hosts)(list remote-megatest test-sig "-execute" cmdparms) debug-param)))