Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -72,12 +72,12 @@ ;; Awful. Please FIXME (define *env-vars-by-run-id* (make-hash-table)) (define *current-run-name* #f) ;; Testconfig and runconfig caches. -(define *testconfigs* (make-hash-table)) ;; test-id => testconfig -(define *runconfigs* (make-hash-table)) ;; target => runconfig +(define *testconfigs* (make-hash-table)) ;; test-name => testconfig +(define *runconfigs* (make-hash-table)) ;; target => runconfig (define (common:clear-caches) (set! *target* (make-hash-table)) (set! *keys* (make-hash-table)) (set! *keyvals* (make-hash-table)) Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -178,11 +178,11 @@ ;; then, if runscript ran ok (or did not get called) ;; do all the ezsteps (if any) (if ezsteps (let* ((testconfig (read-config (conc work-area "/testconfig") #f #t environ-patt: "pre-launch-env-vars")) ;; FIXME??? is allow-system ok here? (ezstepslst (hash-table-ref/default testconfig "ezsteps" '()))) - (hash-table-set! *testconfigs* test-id testconfig) ;; cached for lazy reads later ... + (hash-table-set! *testconfigs* test-name testconfig) ;; cached for lazy reads later ... (if (not (file-exists? ".ezsteps"))(create-directory ".ezsteps")) ;; if ezsteps was defined then we are sure to have at least one step but check anyway (if (not (> (length ezstepslst) 0)) (debug:print 0 "ERROR: ezsteps defined but ezstepslst is zero length") (let loop ((ezstep (car ezstepslst)) Index: mt.scm ================================================================== --- mt.scm +++ mt.scm @@ -93,18 +93,19 @@ ;;====================================================================== (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-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) (directory? test-rundir)) (begin (push-directory test-rundir) - (set! tconfig (mt:lazy-read-test-config test-dat)) + (set! tconfig (mt:lazy-read-test-config test-name)) (pop-directory) (for-each (lambda (trigger) (let ((cmd (configf:lookup tconfig "triggers" trigger)) (logf (conc test-rundir "/last-trigger.log"))) (if cmd @@ -151,15 +152,24 @@ (< (current-seconds)(+ (vector-ref tdat 0) 10))) (vector-ref tdat 1) ;; no need to update *test-info* as that is done in cdb:get-test-info-by-id (cdb:get-test-info-by-id *runremote* test-id)))) -(define (mt:lazy-read-test-config test-dat) - (let* ((test-id (db:test-get-id test-dat)) - (test-rundir (db:test-get-rundir test-dat)) - (tconfig (hash-table-ref/default *testconfigs* test-id #f))) - (if tconfig - tconfig - (let ((newtcfg (read-config (conc test-rundir "/testconfig") #f #f))) ;; NOTE: Does NOT run [system ...] - (hash-table-set! *testconfigs* test-id newtcfg) - newtcfg)))) +(define (mt:lazy-read-test-config test-name) + (let ((tconf (hash-table-ref/default *testconfigs* test-name #f))) + (if tconf + tconf + (let ((test-dirs (tests:get-tests-search-path *configdat*))) + (let loop ((hed (car test-dirs)) + (tal (cdr test-dirs))) + (let ((tconfig-file (conc hed "/" test-name "/testconfig"))) + (if (and (file-exists? tconfig-file) + (file-read-access? tconfig-file)) + (let ((newtcfg (read-config tconfig-file #f #f))) ;; NOTE: Does NOT run [system ...] + (hash-table-set! *testconfigs* test-name newtcfg) + newtcfg) + (if (null? tal) + (begin + (debug:print 0 "ERROR: No readable testconfig found for " test-name) + #f) + (loop (car tal)(cdr tal)))))))))) Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -1218,17 +1218,13 @@ ;; Update test_meta for all tests (define (runs:update-all-test_meta db) (let ((test-names (tests:get-valid-tests))) (for-each (lambda (test-name) - (let* ((test-path (conc *toppath* "/tests/" test-name)) - (test-configf (conc test-path "/testconfig")) - (testexists (and (file-exists? test-configf)(file-read-access? test-configf))) - ;; read configs with tricks turned off (i.e. no system) - (test-conf (if testexists (read-config test-configf #f #f)(make-hash-table)))) + (let* ((test-conf (mt:lazy-read-test-config test-name))) ;; use the cdb:remote-run instead of passing in db - (runs:update-test_meta test-name test-conf))) + (if test-conf (runs:update-test_meta test-name test-conf)))) test-names))) ;; This could probably be refactored into one complex query ... (define (runs:rollup-run keys runname user keyvals) (debug:print 4 "runs:rollup-run, keys: " keys " :runname " runname " user: " user) Index: tests.scm ================================================================== --- tests.scm +++ tests.scm @@ -488,16 +488,18 @@ ;; tests))))) (define (tests:get-testconfig test-name test-registry system-allowed) (let* ((test-path (hash-table-ref/default test-registry test-name (conc *toppath* "/tests/" test-name))) (test-configf (conc test-path "/testconfig")) - (testexists (and (file-exists? test-configf)(file-read-access? test-configf)))) - (if testexists - (read-config test-configf #f system-allowed environ-patt: (if system-allowed - "pre-launch-env-vars" - #f)) - #f))) + (testexists (and (file-exists? test-configf)(file-read-access? test-configf))) + (tcfg (if testexists + (read-config test-configf #f system-allowed environ-patt: (if system-allowed + "pre-launch-env-vars" + #f)) + #f))) + (hash-table-set! *testconfigs* test-name tcfg) + tcfg)) ;; sort tests by priority and waiton ;; Move test specific stuff to a test unit FIXME one of these days (define (tests:sort-by-priority-and-waiton test-records) (let ((mungepriority (lambda (priority)