@@ -402,11 +402,13 @@ (debug:print 1 "INFO: Skipping " (tests:testqueue-get-testname test-record) " " item-path " as it doesn't match " item-patts) (thread-sleep! *global-delta*) (if (not (null? tal)) (loop (car tal)(cdr tal) reruns))) ((not (hash-table-ref/default test-registery (runs:make-full-test-name test-name item-path) #f)) - (open-run-close db:tests-register-test #f run-id test-name item-path) + ;; (open-run-close db:tests-register-test #f run-id test-name item-path) + (rdb:tests-register-test run-id test-name item-path) + (rdb:flush-queue) (hash-table-set! test-registery (runs:make-full-test-name test-name item-path) #t) (thread-sleep! *global-delta*) (loop (car newtal)(cdr newtal) reruns)) ((not have-resources) ;; simply try again after waiting a second (thread-sleep! (+ 1 *global-delta*)) @@ -614,11 +616,13 @@ ;; (set! test-id (open-run-close db:get-test-id db run-id test-name item-path)) (if (not test-id) (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) + ;; (open-run-close db:tests-register-test #f run-id test-name item-path) + (rdb:tests-register-test run-id test-name item-path) + (rdb:flush-queue) (set! test-id (open-run-close db:get-test-id db run-id test-name item-path)))) (debug:print 4 "INFO: 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! test-id (db:test-get-id testdat)) (change-directory test-path) @@ -679,11 +683,13 @@ (if (> (- (current-seconds)(+ (db:test-get-event_time testdat) (db:test-get-run_duration testdat))) 600) ;; i.e. no update for more than 600 seconds (begin (debug:print 0 "WARNING: Test " test-name " appears to be dead. Forcing it to state INCOMPLETE and status STUCK/DEAD") - (tests:test-set-status! test-id "INCOMPLETE" "STUCK/DEAD" "Test is stuck or dead" #f)) + (tests:test-set-status! test-id "INCOMPLETE" "STUCK/DEAD" "Test is stuck or dead" #f) + ;; (rdb:flush-queue) + ) (debug:print 2 "NOTE: " test-name " is already running"))) (else (debug:print 0 "ERROR: Failed to launch test " new-test-name ". Unrecognised state " (test:get-state testdat))))))) ;;====================================================================== ;; END OF NEW STUFF @@ -823,13 +829,14 @@ (begin (debug:print 0 "Failed to setup, exiting") (exit 1))) (if (args:get-arg "-server") (open-run-close server:start db (args:get-arg "-server")) - (if (not (or (args:get-arg "-runall") ;; runall and runtests are allowed to be servers - (args:get-arg "-runtests"))) - (server:client-setup))) + ;;(if (not (or (args:get-arg "-runall") ;; runall and runtests are allowed to be servers + ;; (args:get-arg "-runtests"))) + (server:client-setup)) + ;; ) (set! keys (open-run-close db:get-keys db)) ;; have enough to process -target or -reqtarg here (if (args:get-arg "-reqtarg") (let* ((runconfigf (conc *toppath* "/runconfigs.config")) ;; DO NOT EVALUATE ALL (runconfig (read-config runconfigf #f #f environ-patt: #f)))