Index: dashboard-tests.scm ================================================================== --- dashboard-tests.scm +++ dashboard-tests.scm @@ -384,11 +384,11 @@ (cond ((and need-update newtestdat) (set! testdat newtestdat) (set! teststeps (db:get-compressed-steps test-id work-area: rundir)) (set! logfile (conc (db:test-get-rundir testdat) "/" (db:test-get-final_logf testdat))) - (set! rundir (db:test-get-rundir testdat)) + (set! rundir (sdb:qry 'getstr (db:test-get-rundir testdat))) (set! testfullname (db:test-get-fullname testdat)) ;; (debug:print 0 "INFO: teststeps=" (intersperse teststeps "\n ")) (if (eq? curr-mod-time db-mod-time) ;; do only once if same (set! db-mod-time (+ curr-mod-time 1)) (set! db-mod-time curr-mod-time)) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -292,11 +292,11 @@ ;; find and open the testdat.db file for an existing test (define (db:open-test-db-by-test-id db test-id #!key (work-area #f)) (let* ((test-path (if work-area work-area - (cdb:remote-run db:test-get-rundir-from-test-id db test-id)))) + (sdb:qry 'getstr (cdb:remote-run db:test-get-rundir-from-test-id db test-id))))) (debug:print 3 "TEST PATH: " test-path) (open-test-db test-path))) (define (db:testdb-initialize db) (debug:print 11 "db:testdb-initialize START") @@ -1347,15 +1347,15 @@ (sqlite3:execute db "UPDATE tests SET comment=? WHERE id=?;" (sdb:qry 'getid comment) test-id)) -(define (cdb:test-set-rundir! serverdat run-id test-name item-path rundir) - (cdb:client-call serverdat 'test-set-rundir #t *default-numtries* rundir run-id test-name item-path)) +(define (cdb:test-set-rundir! serverdat run-id test-name item-path rundir-id) + (cdb:client-call serverdat 'test-set-rundir #t *default-numtries* rundir-id run-id test-name item-path)) -(define (cdb:test-set-rundir-by-test-id serverdat test-id rundir) - (cdb:client-call serverdat 'test-set-rundir-by-test-id #t *default-numtries* rundir test-id)) +(define (cdb:test-set-rundir-by-test-id serverdat test-id rundir-id) + (cdb:client-call serverdat 'test-set-rundir-by-test-id #t *default-numtries* rundir-id test-id)) (define (db:test-get-rundir-from-test-id db test-id) (let ((res #f)) ;; (hash-table-ref/default *test-paths* test-id #f))) ;; (if res ;; res Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -19,10 +19,11 @@ (declare (unit launch)) (declare (uses common)) (declare (uses configf)) (declare (uses db)) +(declare (uses sdb)) (include "common_records.scm") (include "key_records.scm") (include "db_records.scm") @@ -494,11 +495,11 @@ (lnkbase (conc linktree "/" target "/" runname)) (lnkpath (conc lnkbase "/" testname)) (lnkpathf (conc lnkpath (if not-iterated "" "/") item-path))) ;; Update the rundir path in the test record for all - (cdb:test-set-rundir-by-test-id *runremote* test-id lnkpathf) + (cdb:test-set-rundir-by-test-id *runremote* test-id (sdb:qry 'getid lnkpathf)) (debug:print 2 "INFO:\n lnkbase=" lnkbase "\n lnkpath=" lnkpath "\n toptest-path=" toptest-path "\n test-path=" test-path) (if (not (file-exists? linktree)) (begin (debug:print 0 "WARNING: linktree did not exist! Creating it now at " linktree) @@ -515,14 +516,14 @@ ;; 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 (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))) + (curr-test-path (if testinfo (sdb:qry 'getstr (db:test-get-rundir testinfo)) #f))) (hash-table-set! *toptest-paths* testname curr-test-path) ;; NB// Was this for the test or for the parent in an iterated test? - (cdb:test-set-rundir! *runremote* run-id testname "" lnkpath) ;; toptest-path) + (cdb:test-set-rundir! *runremote* run-id testname "" (sdb:qry 'getid 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) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -624,12 +624,12 @@ (equal? (db:test-get-status test) "WARN") (equal? (db:test-get-state test) "NOT_STARTED"))) (begin (print " cpuload: " (db:test-get-cpuload test) "\n diskfree: " (db:test-get-diskfree test) - "\n uname: " (db:test-get-uname test) - "\n rundir: " (db:test-get-rundir test) + "\n uname: " (sdb:qry 'getstr (db:test-get-uname test)) + "\n rundir: " (sdb:qry 'getstr (db:test-get-rundir test)) ) ;; Each test ;; DO NOT remote run (let ((steps (db:get-steps-for-test #f (db:test-get-id test)))) (for-each Index: mt.scm ================================================================== --- mt.scm +++ mt.scm @@ -112,11 +112,11 @@ ;; T R I G G E R S ;;====================================================================== (define (mt:process-triggers test-id newstate newstatus) (let* ((test-dat (mt:lazy-get-test-info-by-id test-id)) - (test-rundir (db:test-get-rundir test-dat)) + (test-rundir (sdb:qry 'getstr (db:test-get-rundir test-dat))) (test-name (db:test-get-testname test-dat)) (tconfig #f) (state (if newstate newstate (db:test-get-state test-dat))) (status (if newstatus newstatus (db:test-get-status test-dat)))) (if (and (file-exists? test-rundir) Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -1211,12 +1211,12 @@ action) ((run-wait) (debug:print 1 "Waiting for run " runkey ", run=" runnamepatt " to complete")) (else (debug:print-info 0 "action not recognised " action))) - (let ((sorted-tests (sort tests (lambda (a b)(let ((dira (db:test-get-rundir a)) - (dirb (db:test-get-rundir b))) + (let ((sorted-tests (sort tests (lambda (a b)(let ((dira (sdb:qry 'getstr (db:test-get-rundir a))) + (dirb (sdb:qry 'getstr (db:test-get-rundir b)))) (if (and (string? dira)(string? dirb)) (> (string-length dira)(string-length dirb)) #f))))) (test-retry-time (make-hash-table)) (allow-run-time 10)) ;; seconds to allow for killing tests before just brutally killing 'em @@ -1229,11 +1229,11 @@ (debug:print 0 "ERROR: We have a test-id of " test-id " but no record was found. NOTE: No locking of records is done between processes, do not simultaneously remove the same run from two processes!") (if (not (null? tal)) (loop (car tal)(cdr tal)))) (let* ((item-path (db:test-get-item-path new-test-dat)) (test-name (db:test-get-testname new-test-dat)) - (run-dir (db:test-get-rundir new-test-dat)) ;; run dir is from the link tree + (run-dir (sdb:qry 'getstr (db:test-get-rundir new-test-dat))) ;; run dir is from the link tree (real-dir (if (file-exists? run-dir) (resolve-pathname run-dir) #f)) (test-state (db:test-get-state new-test-dat)) (test-fulln (db:test-get-fullname new-test-dat))) Index: tests.scm ================================================================== --- tests.scm +++ tests.scm @@ -20,10 +20,11 @@ (declare (uses lock-queue)) (declare (uses db)) (declare (uses common)) (declare (uses items)) (declare (uses runconfig)) +(declare (uses sdb)) (include "common_records.scm") (include "key_records.scm") (include "db_records.scm") (include "run_records.scm") @@ -221,12 +222,12 @@ ;; Check for waiver eligibility ;; (define (tests:check-waiver-eligibility testdat prev-testdat) (let* ((test-registry (make-hash-table)) (testconfig (tests:get-testconfig (db:test-get-testname testdat) test-registry #f)) - (test-rundir (db:test-get-rundir testdat)) - (prev-rundir (db:test-get-rundir prev-testdat)) + (test-rundir (sdb:qry 'getstr (db:test-get-rundir testdat))) + (prev-rundir (sdb:qry 'getstr (db:test-get-rundir prev-testdat))) (waivers (configf:section-vars testconfig "waivers")) (waiver-rx (regexp "^(\\S+)\\s+(.*)$")) (diff-rule "diff %file1% %file2%") (logpro-rule "diff %file1% %file2% | logpro %waivername%.logpro %waivername%.html")) (if (not (file-exists? test-rundir))