Overview
| SHA1 Hash: | b71bf641927970bac3c5636c895fad9bdfbb4336 |
|---|---|
| Date: | 2011-11-02 18:09:28 |
| User: | mrwellan |
| Comment: | envvar handling is not reentrant. Need a better solution. Putting this stuff on a branch for now |
| Timelines: | family | ancestors | descendants | both | envhandling |
| Diffs: | root of this branch |
| Downloads: | Tarball | ZIP archive |
| Other Links: | files | file ages | manifest |
Tags And Properties
- branch=envhandling propagates to descendants
- sym-envhandling propagates to descendants
- sym-trunk cancelled
Changes
Modified configf.scm from [4a3f07b3f32ca937] to [4590f7c8750e57bb].
36 (define (config:assoc-safe-add alist key val) 36 (define (config:assoc-safe-add alist key val) 37 (let ((newalist (filter (lambda (x)(not (equal? key (car x)))) alist))) 37 (let ((newalist (filter (lambda (x)(not (equal? key (car x)))) alist))) 38 (append newalist (list (list key val))))) 38 (append newalist (list (list key val))))) 39 39 40 (define (config:eval-string-in-environment str) 40 (define (config:eval-string-in-environment str) 41 (let ((cmdres (cmd-run->list (conc "echo " str)))) 41 (let ((cmdres (cmd-run->list (conc "echo " str)))) 42 (if (null? cmdres) "" 42 (if (null? cmdres) "" 43 (car cmdres)))) | 43 (caar cmdres)))) 44 44 45 ;; read a config file, returns hash table of alists 45 ;; read a config file, returns hash table of alists 46 ;; adds to ht if given (must be #f otherwise) 46 ;; adds to ht if given (must be #f otherwise) 47 ;; envion-patt is a regex spec that identifies sections that will be eval'd 47 ;; envion-patt is a regex spec that identifies sections that will be eval'd 48 ;; in the environment on the fly 48 ;; in the environment on the fly 49 49 50 (define (read-config path ht allow-system #!key (environ-patt #f)) 50 (define (read-config path ht allow-system #!key (environ-patt #f)) > 51 (debug:print 4 "INFO: read-config " path " allow-system " allow-system " envir 51 (if (not (file-exists? path)) 52 (if (not (file-exists? path)) 52 (if (not ht)(make-hash-table) ht) 53 (if (not ht)(make-hash-table) ht) 53 (let ((inp (open-input-file path)) 54 (let ((inp (open-input-file path)) 54 (res (if (not ht)(make-hash-table) ht)) 55 (res (if (not ht)(make-hash-table) ht)) 55 (include-rx (regexp "^\\[include\\s+(.*)\\]\\s*$")) 56 (include-rx (regexp "^\\[include\\s+(.*)\\]\\s*$")) 56 (section-rx (regexp "^\\[(.*)\\]\\s*$")) 57 (section-rx (regexp "^\\[(.*)\\]\\s*$")) 57 (blank-l-rx (regexp "^\\s*$")) 58 (blank-l-rx (regexp "^\\s*$")) ................................................................................................................................................................................ 91 (config:ass 92 (config:ass 92 (loop (read-line inp) curr-s 93 (loop (read-line inp) curr-s 93 (loop (read-line inp) curr-sec 94 (loop (read-line inp) curr-sec 94 (key-val-pr ( x key val ) (let ((alist (hash-table-ref/def 95 (key-val-pr ( x key val ) (let ((alist (hash-table-ref/def 95 (realval (if (and environ-pa 96 (realval (if (and environ-pa 96 (config:eval-st 97 (config:eval-st 97 val))) 98 val))) > 99 (setenv key realval) 98 (hash-table-set! res curr-sectio 100 (hash-table-set! res curr-sectio 99 (config:assoc-s 101 (config:assoc-s 100 (loop (read-line inp) curr-secti 102 (loop (read-line inp) curr-secti 101 ;; if a continued line 103 ;; if a continued line 102 (cont-ln-rx ( x whsp val ) (let ((alist (hash-table-ref/defau 104 (cont-ln-rx ( x whsp val ) (let ((alist (hash-table-ref/defau 103 (if var-flag ;; if s 105 (if var-flag ;; if s 104 (let ((newval (conc 106 (let ((newval (conc
Modified launch.scm from [ce1a0162c818ee30] to [7996f32f5955b2bd].
285 ;; (success exec-results)) ;; (eq? (cadr exec-results) 0))) 285 ;; (success exec-results)) ;; (eq? (cadr exec-results) 0))) 286 (debug:print 2 "Output from running " fullrunscript ", pid " (vector 286 (debug:print 2 "Output from running " fullrunscript ", pid " (vector 287 work-area ":\n====\n exit code " (vector-ref exit-info 287 work-area ":\n====\n exit code " (vector-ref exit-info 288 (sqlite3:finalize! db) 288 (sqlite3:finalize! db) 289 (if (not (vector-ref exit-info 1)) 289 (if (not (vector-ref exit-info 1)) 290 (exit 4))))))) 290 (exit 4))))))) 291 291 > 292 ;; set up the very basics needed for doing anything here. 292 (define (setup-for-run) 293 (define (setup-for-run) 293 (set! *configinfo* (find-and-read-config (if (args:get-arg "-config")(args:get | 294 (set! *configinfo* (find-and-read-config (if (args:get-arg "-config")(args:get 294 (set! *configdat* (if (car *configinfo*)(car *configinfo*) #f)) 295 (set! *configdat* (if (car *configinfo*)(car *configinfo*) #f)) 295 (set! *toppath* (if (car *configinfo*)(cadr *configinfo*) #f)) 296 (set! *toppath* (if (car *configinfo*)(cadr *configinfo*) #f)) 296 (if *toppath* 297 (if *toppath* 297 (setenv "MT_RUN_AREA_HOME" *toppath*) ;; to be deprecated 298 (setenv "MT_RUN_AREA_HOME" *toppath*) ;; to be deprecated 298 (debug:print 0 "ERROR: failed to find the top path to your run setup.")) 299 (debug:print 0 "ERROR: failed to find the top path to your run setup.")) 299 *toppath*) 300 *toppath*) 300 301
Modified megatest-version.scm from [826d6a379e773523] to [b46b5a7d779dd474].
1 ;; Always use two digit decimal 1 ;; Always use two digit decimal 2 ;; 1.01, 1.02...1.10,1.11 ... 1.99,2.00.. 2 ;; 1.01, 1.02...1.10,1.11 ... 1.99,2.00.. 3 3 4 (declare (unit megatest-version)) 4 (declare (unit megatest-version)) 5 5 6 (define megatest-version 1.31) | 6 (define megatest-version 1.32) 7 7
Modified runconfig.scm from [d7b27c058fc61731] to [ddff02cb0f4415c2].
6 (use format) 6 (use format) 7 7 8 (declare (unit runconfig)) 8 (declare (unit runconfig)) 9 (declare (uses common)) 9 (declare (uses common)) 10 10 11 (include "common_records.scm") 11 (include "common_records.scm") 12 12 13 (define (setup-env-defaults db fname run-id . already-seen) | 13 (define (setup-env-defaults db fname run-id already-seen #!key (environ-patt #f) 14 (let* ((keys (get-keys db)) 14 (let* ((keys (get-keys db)) 15 (keyvals (get-key-vals db run-id)) 15 (keyvals (get-key-vals db run-id)) > 16 (keyval 16 (thekey (string-intersperse (map (lambda (x)(if x x "-na-")) keyvals) 17 (thekey (string-intersperse (map (lambda (x)(if x x "-na-")) keyvals) 17 (confdat (read-config fname #f #f)) | 18 (confdat (read-config fname #f #f environ-patt: environ-patt)) 18 (whatfound (make-hash-table)) 19 (whatfound (make-hash-table)) 19 (sections (list "default" thekey))) 20 (sections (list "default" thekey))) 20 (debug:print 4 "Using key=\"" thekey "\"") 21 (debug:print 4 "Using key=\"" thekey "\"") > 22 21 (for-each 23 (for-each 22 (lambda (section) 24 (lambda (section) 23 (let ((section-dat (hash-table-ref/default confdat section #f))) 25 (let ((section-dat (hash-table-ref/default confdat section #f))) 24 (if section-dat 26 (if section-dat 25 (for-each 27 (for-each 26 (lambda (envvar) 28 (lambda (envvar) 27 (hash-table-set! whatfound section (+ (hash-table-ref/default wh 29 (hash-table-set! whatfound section (+ (hash-table-ref/default wh 28 (setenv envvar (cadr (assoc envvar section-dat)))) 30 (setenv envvar (cadr (assoc envvar section-dat)))) 29 (map car section-dat))))) 31 (map car section-dat))))) 30 sections) 32 sections) 31 (if (and (not (null? already-seen)) < 32 (not (car already-seen))) | 33 (if already-seen 33 (begin 34 (begin 34 (debug:print 2 "Key settings found in runconfig.config:") 35 (debug:print 2 "Key settings found in runconfig.config:") 35 (for-each (lambda (fullkey) 36 (for-each (lambda (fullkey) 36 (debug:print 2 (format #f "~20a ~a\n" fullkey (hash-table- 37 (debug:print 2 (format #f "~20a ~a\n" fullkey (hash-table- 37 sections) 38 sections) 38 (debug:print 2 "---") 39 (debug:print 2 "---") 39 (set! *already-seen-runconfig-info* #t))))) 40 (set! *already-seen-runconfig-info* #t))))) 40 41 41 (define (set-run-config-vars db run-id) 42 (define (set-run-config-vars db run-id) 42 (let ((runconfigf (conc *toppath* "/runconfigs.config"))) 43 (let ((runconfigf (conc *toppath* "/runconfigs.config"))) 43 (if (file-exists? runconfigf) 44 (if (file-exists? runconfigf) 44 (setup-env-defaults db runconfigf run-id) | 45 (setup-env-defaults db runconfigf run-id #f environ-patt: ".*") 45 (debug:print 0 "WARNING: You do not have a run config file: " runconfigf 46 (debug:print 0 "WARNING: You do not have a run config file: " runconfigf 46 47
Modified runs.scm from [b12c8bbbfa887e4e] to [cf599e04232aae62].
549 (run-id (register-run db keys)) ;; test-name))) 549 (run-id (register-run db keys)) ;; test-name))) 550 (deferred '()) ;; delay running these since they have a waiton claus 550 (deferred '()) ;; delay running these since they have a waiton claus 551 (runconfigf (conc *toppath* "/runconfigs.config"))) 551 (runconfigf (conc *toppath* "/runconfigs.config"))) 552 ;; on the first pass or call to run-tests set FAILS to NOT_STARTED if 552 ;; on the first pass or call to run-tests set FAILS to NOT_STARTED if 553 ;; -keepgoing is specified 553 ;; -keepgoing is specified 554 554 555 (if (file-exists? runconfigf) 555 (if (file-exists? runconfigf) 556 (setup-env-defaults db runconfigf run-id *already-seen-runconfig-info*) | 556 (setup-env-defaults db runconfigf run-id *already-seen-runconfig-info* e 557 (debug:print 0 "WARNING: You do not have a run config file: " runconfigf 557 (debug:print 0 "WARNING: You do not have a run config file: " runconfigf 558 558 559 (if (and (eq? *passnum* 0) 559 (if (and (eq? *passnum* 0) 560 (args:get-arg "-keepgoing")) 560 (args:get-arg "-keepgoing")) 561 (begin 561 (begin 562 ;; have to delete test records where NOT_STARTED since they can cause 562 ;; have to delete test records where NOT_STARTED since they can cause 563 ;; get stuck due to becoming inaccessible from a failed test. I.e. if 563 ;; get stuck due to becoming inaccessible from a failed test. I.e. if ................................................................................................................................................................................ 830 (deferred '()) ;; delay running these since they have a waiton claus 830 (deferred '()) ;; delay running these since they have a waiton claus 831 (keepgoing (hash-table-ref/default flags "-keepgoing" #f)) 831 (keepgoing (hash-table-ref/default flags "-keepgoing" #f)) 832 (test-names '()) 832 (test-names '()) 833 (runconfigf (conc *toppath* "/runconfigs.config")) 833 (runconfigf (conc *toppath* "/runconfigs.config")) 834 (required-tests '())) 834 (required-tests '())) 835 835 836 (if (file-exists? runconfigf) 836 (if (file-exists? runconfigf) 837 (setup-env-defaults db runconfigf run-id *already-seen-runconfig-info*) | 837 (setup-env-defaults db runconfigf run-id *already-seen-runconfig-info* " 838 (debug:print 0 "WARNING: You do not have a run config file: " runconfigf 838 (debug:print 0 "WARNING: You do not have a run config file: " runconfigf 839 839 840 ;; look up all tests matching the comma separated list of globs in 840 ;; look up all tests matching the comma separated list of globs in 841 ;; test-patts (using % as wildcard) 841 ;; test-patts (using % as wildcard) 842 (for-each 842 (for-each 843 (lambda (patt) 843 (lambda (patt) 844 (let ((tests (glob (conc *toppath* "/tests/" (string-translate patt "%" " 844 (let ((tests (glob (conc *toppath* "/tests/" (string-translate patt "%" " ................................................................................................................................................................................ 1193 (begin 1193 (begin 1194 (debug:print 0 "Failed to setup, exiting") 1194 (debug:print 0 "Failed to setup, exiting") 1195 (exit 1))) 1195 (exit 1))) 1196 (set! db (open-db)) 1196 (set! db (open-db)) 1197 (set! keys (db-get-keys db)) 1197 (set! keys (db-get-keys db)) 1198 ;; have enough to process -target or -reqtarg here 1198 ;; have enough to process -target or -reqtarg here 1199 (if (args:get-arg "-reqtarg") 1199 (if (args:get-arg "-reqtarg") 1200 (let* ((runconfigf (conc *toppath* "/runconfigs.config")) ;; evalua | 1200 (let* ((runconfigf (conc *toppath* "/runconfigs.config")) ;; DO NOT 1201 (runconfig (read-config runconfigf #f #f environ-patt: ".*") | 1201 (runconfig (read-config runconfigf #f #f environ-patt: #f))) 1202 (if (hash-table-ref/default runconfig (args:get-arg "-reqtarg") #f 1202 (if (hash-table-ref/default runconfig (args:get-arg "-reqtarg") #f 1203 (keys:target-set-args keys (args:get-arg "-reqtarg") args:arg- 1203 (keys:target-set-args keys (args:get-arg "-reqtarg") args:arg- 1204 (begin 1204 (begin 1205 (debug:print 0 "ERROR: [" (args:get-arg "-reqtarg") "] not f 1205 (debug:print 0 "ERROR: [" (args:get-arg "-reqtarg") "] not f 1206 (sqlite3:finalize! db) 1206 (sqlite3:finalize! db) 1207 (exit 1)))) 1207 (exit 1)))) 1208 (if (args:get-arg "-target") 1208 (if (args:get-arg "-target")
Modified tests/runconfigs.config from [bf935869e9a48e6b] to [5386d0e9a546a23c].