Changes In Branch envhandling Excluding Merge-Ins
This is equivalent to a diff from ff05a10939 to 0f355e8087
2011-11-02
| ||
21:59 | Merged from envhandling branch check-in: da715ac6ab user: matt tags: trunk, v1.32 | |
21:58 | Hacked to get vars working ok. NOT REENTRANT. Must rework :( Closed-Leaf check-in: 0f355e8087 user: matt tags: envhandling | |
18:09 | envvar handling is not reentrant. Need a better solution. Putting this stuff on a branch for now check-in: b71bf64192 user: mrwellan tags: envhandling | |
15:32 | Checking in partial fix for envvar handling check-in: ff05a10939 user: mrwellan tags: trunk, v1.31 | |
11:10 | Bumped version check-in: 26ce838a3c user: mrwellan tags: trunk | |
Modified configf.scm from [4a3f07b3f3] to [ef264b880e].
︙ | ︙ | |||
36 37 38 39 40 41 42 | (define (config:assoc-safe-add alist key val) (let ((newalist (filter (lambda (x)(not (equal? key (car x)))) alist))) (append newalist (list (list key val))))) (define (config:eval-string-in-environment str) (let ((cmdres (cmd-run->list (conc "echo " str)))) (if (null? cmdres) "" | | > | 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 | (define (config:assoc-safe-add alist key val) (let ((newalist (filter (lambda (x)(not (equal? key (car x)))) alist))) (append newalist (list (list key val))))) (define (config:eval-string-in-environment str) (let ((cmdres (cmd-run->list (conc "echo " str)))) (if (null? 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*$")) (section-rx (regexp "^\\[(.*)\\]\\s*$")) (blank-l-rx (regexp "^\\s*$")) |
︙ | ︙ | |||
87 88 89 90 91 92 93 | (if (null? res) "" (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))) | | | > > > > > | 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 | (if (null? res) "" (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 '())) (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 '()))) (if var-flag ;; if set to a string then we have a continued var (let ((newval (conc |
︙ | ︙ |
Modified launch.scm from [ce1a0162c8] to [b3346272f9].
︙ | ︙ | |||
58 59 60 61 62 63 64 65 66 67 68 69 70 71 | (env-ovrd (assoc/default 'env-ovrd cmdinfo)) (set-vars (assoc/default 'set-vars cmdinfo)) ;; pre-overrides from -setvar (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) (let ((varpairs (string-split set-vars ","))) (debug:print 4 "varpairs: " varpairs) | > | 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 | (env-ovrd (assoc/default 'env-ovrd cmdinfo)) (set-vars (assoc/default 'set-vars cmdinfo)) ;; pre-overrides from -setvar (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) (let ((varpairs (string-split set-vars ","))) (debug:print 4 "varpairs: " varpairs) |
︙ | ︙ | |||
86 87 88 89 90 91 92 93 94 95 96 97 98 99 | (if (not (setup-for-run)) (begin (debug:print 0 "Failed to setup, exiting") (exit 1))) ;; now can find our db (set! db (open-db)) (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) (set-item-env-vars itemdat) (save-environment-as-files "megatest") | > | 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 | (if (not (setup-for-run)) (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) (set-item-env-vars itemdat) (save-environment-as-files "megatest") |
︙ | ︙ | |||
285 286 287 288 289 290 291 292 | ;; (success exec-results)) ;; (eq? (cadr exec-results) 0))) (debug:print 2 "Output from running " fullrunscript ", pid " (vector-ref exit-info 0) " in work area " 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))))))) (define (setup-for-run) | > | | 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 | ;; (success exec-results)) ;; (eq? (cadr exec-results) 0))) (debug:print 2 "Output from running " fullrunscript ", pid " (vector-ref exit-info 0) " in work area " 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") 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.")) *toppath*) |
︙ | ︙ |
Modified megatest-version.scm from [826d6a379e] to [b46b5a7d77].
1 2 3 4 5 | ;; Always use two digit decimal ;; 1.01, 1.02...1.10,1.11 ... 1.99,2.00.. (declare (unit megatest-version)) | | | 1 2 3 4 5 6 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.32) |
Modified runconfig.scm from [d7b27c058f] to [12d1c1602d].
1 2 3 4 5 6 7 8 9 10 11 12 | ;;====================================================================== ;; read a config file, loading only the section pertinent ;; to this run field1val/field2val/field3val ... ;;====================================================================== (use format) (declare (unit runconfig)) (declare (uses common)) (include "common_records.scm") | | | > > > > > > < | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 | ;;====================================================================== ;; read a config file, loading only the section pertinent ;; to this run field1val/field2val/field3val ... ;;====================================================================== (use format) (declare (unit runconfig)) (declare (uses common)) (include "common_records.scm") (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 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 (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 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) (debug:print 2 "---") (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 #f environ-patt: ".*") (debug:print 0 "WARNING: You do not have a run config file: " runconfigf)))) |
Modified runs.scm from [b12c8bbbfa] to [5e902b8e73].
︙ | ︙ | |||
548 549 550 551 552 553 554 555 | (keyvallst (keys->vallist keys #t)) (run-id (register-run db keys)) ;; test-name))) (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 (if (file-exists? runconfigf) | > > | | 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 | (keyvallst (keys->vallist keys #t)) (run-id (register-run db keys)) ;; test-name))) (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* 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 ;; have to delete test records where NOT_STARTED since they can cause -keepgoing to ;; get stuck due to becoming inaccessible from a failed test. I.e. if test B depends |
︙ | ︙ | |||
588 589 590 591 592 593 594 | ;; VERY INEFFICIENT! Move stuff that should be done once up to calling proc (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")) | > | > | 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 | ;; VERY INEFFICIENT! Move stuff that should be done once up to calling proc (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 (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))) (waiton (let ((w (config-lookup test-conf "requirements" "waiton"))) (if (string? w)(string-split w)'()))) |
︙ | ︙ | |||
829 830 831 832 833 834 835 836 | (run-id (runs:register-run db keys keyvallst runname "new" "n/a" user)) ;; test-name))) (deferred '()) ;; delay running these since they have a waiton clause (keepgoing (hash-table-ref/default flags "-keepgoing" #f)) (test-names '()) (runconfigf (conc *toppath* "/runconfigs.config")) (required-tests '())) (if (file-exists? runconfigf) | > > | | 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 | (run-id (runs:register-run db keys keyvallst runname "new" "n/a" user)) ;; test-name))) (deferred '()) ;; delay running these since they have a waiton clause (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* "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 (lambda (patt) (let ((tests (glob (conc *toppath* "/tests/" (string-translate patt "%" "*"))))) |
︙ | ︙ | |||
1193 1194 1195 1196 1197 1198 1199 | (begin (debug:print 0 "Failed to setup, exiting") (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") | | | | 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 | (begin (debug:print 0 "Failed to setup, exiting") (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")) ;; 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) (exit 1)))) (if (args:get-arg "-target") |
︙ | ︙ |
Modified tests/runconfigs.config from [bf935869e9] to [5386d0e9a5].
1 2 3 4 5 6 7 8 9 10 11 12 | [/tmp/mrwellan/env/ubuntu/afs] BOGOUS Bob [default/ubuntu/nfs] CURRENT /blah [ubuntu/nfs/none] CURRENT /tmp/nada [default] FOOBARBAZZZZ not a useful value | | > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | [/tmp/mrwellan/env/ubuntu/afs] BOGOUS Bob [default/ubuntu/nfs] CURRENT /blah [ubuntu/nfs/none] CURRENT /tmp/nada [default] FOOBARBAZZZZ not a useful value BIGBOB $FOOBARBAZZZZ/bobby FREDDY $sysname/$fsname TOMMY [system pwd] |