Index: configf.scm ================================================================== --- configf.scm +++ configf.scm @@ -38,18 +38,19 @@ (append newalist (list (list key val))))) (define (config:eval-string-in-environment str) (let ((cmdres (cmd-run->list (conc "echo " str)))) (if (null? cmdres) "" - (car cmdres)))) + (caar cmdres)))) ;; read a config file, returns hash table of alists ;; adds to ht if given (must be #f otherwise) ;; envion-patt is a regex spec that identifies sections that will be eval'd ;; in the environment on the fly (define (read-config path ht allow-system #!key (environ-patt #f)) + (debug:print 4 "INFO: read-config " path " allow-system " allow-system " environ-patt " environ-patt) (if (not (file-exists? path)) (if (not ht)(make-hash-table) ht) (let ((inp (open-input-file path)) (res (if (not ht)(make-hash-table) ht)) (include-rx (regexp "^\\[include\\s+(.*)\\]\\s*$")) @@ -89,14 +90,19 @@ (string-intersperse res " "))))) (hash-table-set! res curr-section-name (config:assoc-safe-add alist key val)) (loop (read-line inp) curr-section-name #f #f)) (loop (read-line inp) curr-section-name #f #f))) - (key-val-pr ( x key val ) (let ((alist (hash-table-ref/default res curr-section-name '())) - (realval (if (and environ-patt (string-match (regexp environ-patt) curr-section-name)) + (key-val-pr ( x key val ) (let* ((alist (hash-table-ref/default res curr-section-name '())) + (envar (and environ-patt (string-match (regexp environ-patt) curr-section-name))) + (realval (if envar (config:eval-string-in-environment val) val))) + (if envar + (begin + (debug:print 4 "INFO: read-config key=" key ", val=" val ", realval=" realval) + (setenv key realval))) (hash-table-set! res curr-section-name (config:assoc-safe-add alist key realval)) (loop (read-line inp) curr-section-name key #f))) ;; if a continued line (cont-ln-rx ( x whsp val ) (let ((alist (hash-table-ref/default res curr-section-name '()))) Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -60,10 +60,11 @@ (runname (assoc/default 'runname cmdinfo)) (megatest (assoc/default 'megatest cmdinfo)) (mt-bindir-path (assoc/default 'mt-bindir-path cmdinfo)) (fullrunscript (if runscript (conc testpath "/" runscript) #f)) (db #f)) + (debug:print 2 "Exectuing " test-name " on " (get-host-name)) (change-directory testpath) ;; apply pre-overrides before other variables. The pre-override vars must not ;; clobbers things from the official sources such as megatest.config and runconfigs.config (if (string? set-vars) @@ -88,10 +89,11 @@ (begin (debug:print 0 "Failed to setup, exiting") (exit 1))) ;; now can find our db (set! db (open-db)) + (set-megatest-env-vars db run-id) ;; these may be needed by the launching process (change-directory work-area) (set-run-config-vars db run-id) ;; environment overrides are done *before* the remaining critical envars. (alist->env-vars env-ovrd) (set-megatest-env-vars db run-id) @@ -287,12 +289,13 @@ work-area ":\n====\n exit code " (vector-ref exit-info 2) "\n" "====\n") (sqlite3:finalize! db) (if (not (vector-ref exit-info 1)) (exit 4))))))) +;; set up the very basics needed for doing anything here. (define (setup-for-run) - (set! *configinfo* (find-and-read-config (if (args:get-arg "-config")(args:get-arg "-config") "megatest.config"))) + (set! *configinfo* (find-and-read-config (if (args:get-arg "-config")(args:get-arg "-config") "megatest.config") environ-patt: "env-override")) (set! *configdat* (if (car *configinfo*)(car *configinfo*) #f)) (set! *toppath* (if (car *configinfo*)(cadr *configinfo*) #f)) (if *toppath* (setenv "MT_RUN_AREA_HOME" *toppath*) ;; to be deprecated (debug:print 0 "ERROR: failed to find the top path to your run setup.")) Index: megatest-version.scm ================================================================== --- megatest-version.scm +++ megatest-version.scm @@ -1,7 +1,7 @@ ;; Always use two digit decimal ;; 1.01, 1.02...1.10,1.11 ... 1.99,2.00.. (declare (unit megatest-version)) -(define megatest-version 1.31) +(define megatest-version 1.32) Index: runconfig.scm ================================================================== --- runconfig.scm +++ runconfig.scm @@ -8,18 +8,24 @@ (declare (unit runconfig)) (declare (uses common)) (include "common_records.scm") -(define (setup-env-defaults db fname run-id . already-seen) +(define (setup-env-defaults db fname run-id already-seen #!key (environ-patt #f)) (let* ((keys (get-keys db)) (keyvals (get-key-vals db run-id)) (thekey (string-intersperse (map (lambda (x)(if x x "-na-")) keyvals) "/")) - (confdat (read-config fname #f #f)) + (confdat (read-config fname #f #f environ-patt: environ-patt)) (whatfound (make-hash-table)) (sections (list "default" thekey))) (debug:print 4 "Using key=\"" thekey "\"") + + (for-each + (lambda (key val) + (setenv (vector-ref key 0) val)) + keys keyvals) + (for-each (lambda (section) (let ((section-dat (hash-table-ref/default confdat section #f))) (if section-dat (for-each @@ -26,12 +32,11 @@ (lambda (envvar) (hash-table-set! whatfound section (+ (hash-table-ref/default whatfound section 0) 1)) (setenv envvar (cadr (assoc envvar section-dat)))) (map car section-dat))))) sections) - (if (and (not (null? already-seen)) - (not (car already-seen))) + (if already-seen (begin (debug:print 2 "Key settings found in runconfig.config:") (for-each (lambda (fullkey) (debug:print 2 (format #f "~20a ~a\n" fullkey (hash-table-ref/default whatfound fullkey 0)))) sections) @@ -39,8 +44,8 @@ (set! *already-seen-runconfig-info* #t))))) (define (set-run-config-vars db run-id) (let ((runconfigf (conc *toppath* "/runconfigs.config"))) (if (file-exists? runconfigf) - (setup-env-defaults db runconfigf run-id) + (setup-env-defaults db runconfigf run-id #f environ-patt: ".*") (debug:print 0 "WARNING: You do not have a run config file: " runconfigf)))) - + Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -550,12 +550,14 @@ (deferred '()) ;; delay running these since they have a waiton clause (runconfigf (conc *toppath* "/runconfigs.config"))) ;; on the first pass or call to run-tests set FAILS to NOT_STARTED if ;; -keepgoing is specified + (set-megatest-env-vars db run-id) ;; these may be needed by the launching process + (if (file-exists? runconfigf) - (setup-env-defaults db runconfigf run-id *already-seen-runconfig-info*) + (setup-env-defaults db runconfigf run-id *already-seen-runconfig-info* environ-patt: ".*") (debug:print 0 "WARNING: You do not have a run config file: " runconfigf)) (if (and (eq? *passnum* 0) (args:get-arg "-keepgoing")) (begin @@ -590,11 +592,13 @@ (define (run-one-test db run-id test-name keyvallst) (debug:print 1 "Launching test " test-name) ;; All these vars might be referenced by the testconfig file reader (setenv "MT_TEST_NAME" test-name) ;; (setenv "MT_RUNNAME" (args:get-arg ":runname")) - (set-megatest-env-vars db run-id) ;; these may be needed by the launching process + + ;; (set-megatest-env-vars db run-id) ;; these may be needed by the launching process + (change-directory *toppath*) (let* ((test-path (conc *toppath* "/tests/" test-name)) ;; could use test:get-testconfig here ... (test-configf (conc test-path "/testconfig")) (testexists (and (file-exists? test-configf)(file-read-access? test-configf))) (test-conf (if testexists (read-config test-configf #f #t) (make-hash-table))) @@ -831,12 +835,14 @@ (keepgoing (hash-table-ref/default flags "-keepgoing" #f)) (test-names '()) (runconfigf (conc *toppath* "/runconfigs.config")) (required-tests '())) + (set-megatest-env-vars db run-id) ;; these may be needed by the launching process + (if (file-exists? runconfigf) - (setup-env-defaults db runconfigf run-id *already-seen-runconfig-info*) + (setup-env-defaults db runconfigf run-id *already-seen-runconfig-info* "pre-launch-env-vars") (debug:print 0 "WARNING: You do not have a run config file: " runconfigf)) ;; look up all tests matching the comma separated list of globs in ;; test-patts (using % as wildcard) (for-each @@ -1195,12 +1201,12 @@ (exit 1))) (set! db (open-db)) (set! keys (db-get-keys db)) ;; have enough to process -target or -reqtarg here (if (args:get-arg "-reqtarg") - (let* ((runconfigf (conc *toppath* "/runconfigs.config")) ;; evaluate all - (runconfig (read-config runconfigf #f #f environ-patt: ".*"))) + (let* ((runconfigf (conc *toppath* "/runconfigs.config")) ;; DO NOT EVALUATE ALL + (runconfig (read-config runconfigf #f #f environ-patt: #f))) (if (hash-table-ref/default runconfig (args:get-arg "-reqtarg") #f) (keys:target-set-args keys (args:get-arg "-reqtarg") args:arg-hash) (begin (debug:print 0 "ERROR: [" (args:get-arg "-reqtarg") "] not found in " runconfigf) (sqlite3:finalize! db) Index: tests/runconfigs.config ================================================================== --- tests/runconfigs.config +++ tests/runconfigs.config @@ -8,6 +8,8 @@ CURRENT /tmp/nada [default] FOOBARBAZZZZ not a useful value -BIGBOB $BOGOUS/bobby +BIGBOB $FOOBARBAZZZZ/bobby +FREDDY $sysname/$fsname +TOMMY [system pwd]