Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -254,11 +254,11 @@ (current-seconds) start-seconds))))) (kill-tries 0)) (let loop ((minutes (calc-minutes))) (begin - (set! kill-job? (open-run-close test-get-kill-request #f test-id)) ;; run-id test-name itemdat)) + (set! kill-job? (test-get-kill-request test-id)) ;; run-id test-name itemdat)) (open-run-close test-set-meta-info #f test-id run-id test-name itemdat minutes) (if kill-job? (begin (mutex-lock! m) (let* ((pid (vector-ref exit-info 0))) @@ -540,11 +540,11 @@ (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 (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)) + (testinfo (cdb:get-test-info-by-id *runremote* 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 Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -554,11 +554,11 @@ ;; this case should not happen, added to help catch any bugs ((and (list? items) itemdat) (debug:print 0 "ERROR: Should not have a list of items in a test and the itemspath set - please report this") (exit 1)) ((not (null? reruns)) - (let* ((newlst (open-run-close tests:filter-non-runnable #f run-id tal test-records)) ;; i.e. not FAIL, WAIVED, INCOMPLETE, PASS, KILLED, + (let* ((newlst (tests:filter-non-runnable run-id tal test-records)) ;; i.e. not FAIL, WAIVED, INCOMPLETE, PASS, KILLED, (junked (lset-difference equal? tal newlst))) (debug:print-info 4 "full drop through, if reruns is less than 100 we will force retry them, reruns=" reruns ", tal=" tal) (if (< num-retries max-retries) (set! newlst (append reruns newlst))) (set! num-retries (+ num-retries 1)) @@ -619,11 +619,11 @@ ;; (lambda (itemdat) ;;; ((ripeness "overripe") (temperature "cool") (season "summer")) (let* ((new-test-path (string-intersperse (cons test-path (map cadr itemdat)) "/")) (new-test-name (if (equal? item-path "") test-name (conc test-name "/" item-path))) ;; just need it to be unique (test-id (cdb:remote-run db:get-test-id #f run-id test-name item-path)) - (testdat (cdb:remote-run db:get-test-info-by-id #f test-id))) + (testdat (cdb:get-test-info-by-id *runremote* test-id))) (if (not testdat) (begin ;; ensure that the path exists before registering the test ;; NOPE: Cannot! Don't know yet which disk area will be assigned.... ;; (system (conc "mkdir -p " new-test-path)) @@ -637,11 +637,11 @@ (begin (debug:print 2 "WARN: Test not pre-created? test-name=" test-name ", item-path=" item-path ", run-id=" run-id) (open-run-close db:tests-register-test #f run-id test-name item-path) (set! test-id (open-run-close db:get-test-id db run-id test-name item-path)))) (debug:print-info 4 "test-id=" test-id ", run-id=" run-id ", test-name=" test-name ", item-path=\"" item-path "\"") - (set! testdat (open-run-close db:get-test-info-by-id db test-id)))) + (set! testdat (cdb:get-test-info-by-id *runremote* test-id)))) (set! test-id (db:test-get-id testdat)) (change-directory test-path) (case (if force ;; (args:get-arg "-force") 'NOT_STARTED (if testdat Index: tests.scm ================================================================== --- tests.scm +++ tests.scm @@ -194,11 +194,11 @@ (define (tests:test-set-status! test-id state status comment dat) (debug:print-info 4 "tests:test-set-status! test-id=" test-id ", state=" state ", status=" status ", dat=" dat) (let* ((db #f) (real-status status) (otherdat (if dat dat (make-hash-table))) - (testdat (cdb:remote-run db:get-test-info-by-id #f test-id)) + (testdat (cdb:get-test-info-by-id *runremote* test-id)) (run-id (db:test-get-run_id testdat)) (test-name (db:test-get-testname testdat)) (item-path (db:test-get-item-path testdat)) ;; before proceeding we must find out if the previous test (where all keys matched except runname) ;; was WAIVED if this test is FAIL @@ -437,11 +437,11 @@ (itemdat (tests:testqueue-get-itemdat test-record)) (item-path (tests:testqueue-get-item_path test-record)) (waitons (tests:testqueue-get-waitons test-record)) (keep-test #t) (test-id (cdb:remote-run db:get-test-id #f run-id test-name item-path)) - (tdat (cdb:remote-run db:get-test-info-by-id #f test-id))) + (tdat (cdb:get-test-info-by-id *runremote* test-id))) (if tdat (begin ;; Look at the test state and status (if (or (member (db:test-get-status tdat) '("PASS" "WARN" "WAIVED" "CHECK")) @@ -453,11 +453,11 @@ ;; from the runnable list (if keep-test (for-each (lambda (waiton) ;; for now we are waiting only on the parent test (let* ((parent-test-id (cdb:remote-run db:get-test-id #f run-id waiton "")) - (wtdat (cdb:remote-run db:get-test-info-by-id #f test-id))) + (wtdat (cdb:get-test-info-by-id *runremote* test-id))) (if (or (member (db:test-get-status wtdat) '("FAIL" "KILLED")) (member (db:test-get-state wtdat) '("INCOMPETE"))) (set! keep-test #f)))) ;; no point in running this one again @@ -472,11 +472,11 @@ ;; teststep-set-status! used to be here (define (test-get-kill-request test-id) ;; run-id test-name itemdat) (let* (;; (item-path (item-list->path itemdat)) - (testdat (cdb:remote-run db:get-test-info-by-id test-id))) ;; run-id test-name item-path))) + (testdat (cdb:get-test-info-by-id *runremote* test-id))) ;; run-id test-name item-path))) (equal? (test:get-state testdat) "KILLREQ"))) (define (test:tdb-get-rundat-count tdb) (if tdb (let ((res 0))