Overview
Comment: | Sync up with v1.63 |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | run-mgr |
Files: | files | file ages | folders |
SHA1: |
16863935cea4fc9e1cc442415f1dfee7 |
User & Date: | matt on 2017-02-10 21:24:47 |
Other Links: | branch diff | manifest | tags |
Context
2017-02-10
| ||
21:52 | Clean up command-line interface check-in: bc460650a2 user: matt tags: run-mgr | |
21:24 | Sync up with v1.63 check-in: 16863935ce user: matt tags: run-mgr | |
15:16 | Added some brief info on wildcards in runconfigs to the user manual check-in: 39f84a3f86 user: mrwellan tags: v1.63 | |
2017-02-09
| ||
18:58 | margs idea comment check-in: 57f82b54ec user: matt tags: run-mgr | |
Changes
Modified common.scm from [fb7f04018e] to [ef963426c3].
︙ | ︙ | |||
748 749 750 751 752 753 754 | (string-split patts ",")) res) #t)) ;; (map print (map car (hash-table->alist (read-config "runconfigs.config" #f #t)))) (define (common:get-runconfig-targets #!key (configf #f)) (let ((targs (sort (map car (hash-table->alist | | | 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 | (string-split patts ",")) res) #t)) ;; (map print (map car (hash-table->alist (read-config "runconfigs.config" #f #t)))) (define (common:get-runconfig-targets #!key (configf #f)) (let ((targs (sort (map car (hash-table->alist (or configf ;; NOTE: There is no value in using runconfig:read here. (read-config (conc *toppath* "/runconfigs.config") #f #t) (make-hash-table)))) string<?)) (target-patt (args:get-arg "-target"))) (if target-patt (filter (lambda (x) |
︙ | ︙ |
Modified configf.scm from [ddff2b4e5d] to [7cf9abed09].
︙ | ︙ | |||
175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 | (define (calc-allow-system allow-system section sections) (if sections (and (or (equal? "default" section) (member section sections)) allow-system) ;; account for sections and return allow-system as it might be a symbol such as return-strings allow-system)) ;; read a config file, returns hash table of alists ;; 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 ;; sections: #f => get all, else list of sections to gather ;; post-section-procs alist of section-pattern => proc, where: (proc section-name next-section-name ht curr-path) ;; | > > > > > > > > > > > > > > > > > > > > > > > > > > | | > > > > > > > > > | 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 | (define (calc-allow-system allow-system section sections) (if sections (and (or (equal? "default" section) (member section sections)) allow-system) ;; account for sections and return allow-system as it might be a symbol such as return-strings allow-system)) ;; given a config hash and a section name, apply that section to all matching sections (using wildcard % or regex if /..../) ;; remove the section when done so that there is no downstream clobbering ;; (define (configf:apply-wildcards ht section-name) (if (hash-table-exists? ht section-name) (let ((vars (hash-table-ref ht section-name)) (rx (regexp (if (string-contains section-name "%") (string-substitute section-name "%" ".*") section-name)))) (for-each (lambda (section) (if (and section-name section (not (string=? section-name section)) (string-match rx section)) (for-each (lambda (bundle) (let ((key (car bundle)) (val (cadr bundle)) (meta (if (> (length bundle) 2)(caddr bundle) #f))) (hash-table-set! ht section (config:assoc-safe-add (hash-table-ref ht section) key val metadata: meta)))) vars))) (hash-table-keys ht)))) ht) ;; read a config file, returns hash table of alists ;; 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 ;; sections: #f => get all, else list of sections to gather ;; post-section-procs alist of section-pattern => proc, where: (proc section-name next-section-name ht curr-path) ;; apply-wildcards: #t/#f - apply vars from targets with % wildcards to all matching sections ;; (define (read-config path ht allow-system #!key (environ-patt #f)(curr-section #f)(sections #f)(settings (make-hash-table))(keep-filenames #f)(post-section-procs '())(apply-wildcards #t)) (debug:print-info 5 *default-log-port* "read-config " path " allow-system " allow-system " environ-patt " environ-patt " curr-section: " curr-section " sections: " sections " pwd: " (current-directory)) (debug:print 9 *default-log-port* "START: " path) (if (and (not (port? path)) (not (file-exists? path))) ;; for case where we are handed a port (begin (debug:print-info 1 *default-log-port* "read-config - file not found " path " current path: " (current-directory)) ;; WARNING: This is a risky change but really, we should not return an empty hash table if no file read? #f) ;; (if (not ht)(make-hash-table) ht)) (let ((inp (if (string? path) (open-input-file path) path)) ;; we can be handed a port (res (if (not ht)(make-hash-table) ht)) (metapath (if (or (debug:debug-mode 9) keep-filenames) path #f)) (process-wildcards (lambda (res curr-section-name) (if (and apply-wildcards (or (string-contains curr-section-name "%") ;; wildcard (string-match "/.*/" curr-section-name))) ;; regex (begin (configf:apply-wildcards res curr-section-name) (hash-table-delete! res curr-section-name)))))) ;; NOTE: if the section is a wild card it will be REMOVED from res (let loop ((inl (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings)) ;; (read-line inp)) (curr-section-name (if curr-section curr-section "default")) (var-flag #f);; turn on for key-var-pr and cont-ln-rx, turn off elsewhere (lead #f)) (debug:print-info 8 *default-log-port* "curr-section-name: " curr-section-name " var-flag: " var-flag "\n inl: \"" inl "\"") (if (eof-object? inl) (begin ;; process last section for wildcards (process-wildcards res curr-section-name) (if (string? path) ;; we received a path, not a port, thus we are responsible for closing it. (close-input-port inp)) (hash-table-delete! res "") ;; we are using "" as a dumping ground and must remove it before returning the ht (debug:print 9 *default-log-port* "END: " path) res) (regex-case inl |
︙ | ︙ | |||
263 264 265 266 267 268 269 270 271 272 273 274 275 276 | (for-each (lambda (dat) (let ((patt (car dat)) (proc (cdr dat))) (if (string-match patt curr-section-name) (proc curr-section-name section-name res path)))) post-section-procs) (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) ;; if we have the sections list then force all settings into "" and delete it later? (if (or (not sections) (member section-name sections)) section-name "") ;; stick everything into "" #f #f))) (configf:key-sys-pr ( x key cmd ) (if (calc-allow-system allow-system curr-section-name sections) | > > > | 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 | (for-each (lambda (dat) (let ((patt (car dat)) (proc (cdr dat))) (if (string-match patt curr-section-name) (proc curr-section-name section-name res path)))) post-section-procs) ;; after gathering the vars for a section and if apply-wildcards is true and if there is a wildcard in the section name process wildcards ;; NOTE: we are processing the curr-section-name, NOT section-name. (process-wildcards res curr-section-name) (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) ;; if we have the sections list then force all settings into "" and delete it later? (if (or (not sections) (member section-name sections)) section-name "") ;; stick everything into "" #f #f))) (configf:key-sys-pr ( x key cmd ) (if (calc-allow-system allow-system curr-section-name sections) |
︙ | ︙ |
Modified dashboard-tests.scm from [07aba72013] to [0388c35774].
︙ | ︙ | |||
461 462 463 464 465 466 467 | ;; (conc ":" (car keyval) " " (cadr keyval))) (cadr keyval)) keydat) "/")) (item-path (db:test-get-item-path testdat)) ;; this next block was added to fix a bug where variables were ;; needed. Revisit this. | | | 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 | ;; (conc ":" (car keyval) " " (cadr keyval))) (cadr keyval)) keydat) "/")) (item-path (db:test-get-item-path testdat)) ;; this next block was added to fix a bug where variables were ;; needed. Revisit this. (runconfig (let ((runconfigf (conc *toppath* "/runconfigs.config"))) ;; no rush but it would be good to convert this call to use runconfig:read (if (file-exists? runconfigf) (handle-exceptions exn #f ;; do nothing, just keep on trucking .... (setup-env-defaults runconfigf run-id (make-hash-table) keydat environ-patt: keystring)) (make-hash-table)))) (testconfig (begin |
︙ | ︙ |
Modified docs/api.html from [b7a1558ae4] to [145585f8de].
︙ | ︙ | |||
1013 1014 1015 1016 1017 1018 1019 | </div> </div> </div> <div id="footnotes"><hr></div> <div id="footer"> <div id="footer-text"> Version 1.0<br> | | | 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 | </div> </div> </div> <div id="footnotes"><hr></div> <div id="footer"> <div id="footer-text"> Version 1.0<br> Last updated 2016-12-12 13:03:08 PST </div> </div> </body> </html> |
Modified docs/manual/reference.txt from [a08ca10124] to [45163346ae].
︙ | ︙ | |||
40 41 42 43 44 45 46 | ------------------------- [items] A a b c B d e f ------------------------- Then the config file would effectively appear to contain an items section | | | | | | > > > > > > > > > > > > > > > > > > > > > | 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 | ------------------------- [items] A a b c B d e f ------------------------- Then the config file would effectively appear to contain an items section exactly like the output from the script. This is useful when dynamically creating items, itemstables and other config structures. You can see the expansion of the call by looking in the cached files (look in your linktree for megatest.config and runconfigs.config cache files and in your test run areas for the expanded and cached testconfig). Wildcards and regexes in Targets ------------------------- [a/2/b] VAR1 VAL1 [a/%/b] VAR1 VAL2 ------------------------- Will result in: ------------------------- [a/2/b] VAR1 VAL2 ------------------------- Can use either wildcard of "%" or a regular expression: [/abc.*def/] Disk Space Checks ^^^^^^^^^^^^^^^^^ Some parameters you can put in the [setup] section of megatest.config: ------------------- |
︙ | ︙ |
Modified launch.scm from [13e6c119c2] to [fb952635f4].
︙ | ︙ | |||
771 772 773 774 775 776 777 | mtconfig environ-patt: "env-override" given-toppath: toppath pathenvvar: "MT_RUN_AREA_HOME")) (first-rundat (let ((toppath (if toppath toppath (car first-pass)))) | | | 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 | mtconfig environ-patt: "env-override" given-toppath: toppath pathenvvar: "MT_RUN_AREA_HOME")) (first-rundat (let ((toppath (if toppath toppath (car first-pass)))) (read-config ;; (conc toppath "/runconfigs.config") ;; this should be converted to runconfig:read but it is non-trivial, leaving it for now. (conc (if (string? toppath) toppath (get-environment-variable "MT_RUN_AREA_HOME")) "/runconfigs.config") *runconfigdat* #t sections: sections)))) (set! *runconfigdat* first-rundat) |
︙ | ︙ | |||
804 805 806 807 808 809 810 | environ-patt: "env-override" given-toppath: toppath pathenvvar: "MT_RUN_AREA_HOME")) (runconfigdat (begin ;; this read of the runconfigs will see any adjustments made by re-reading megatest.config (for-each (lambda (kt) (setenv (car kt) (cadr kt))) key-vals) | | | | 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 | environ-patt: "env-override" given-toppath: toppath pathenvvar: "MT_RUN_AREA_HOME")) (runconfigdat (begin ;; this read of the runconfigs will see any adjustments made by re-reading megatest.config (for-each (lambda (kt) (setenv (car kt) (cadr kt))) key-vals) (read-config (conc toppath "/runconfigs.config") *runconfigdat* #t ;; consider using runconfig:read some day ... sections: sections)))) (if cancreate (configf:write-alist runconfigdat rccachef)) (set! *runconfigdat* runconfigdat) (if cancreate (configf:write-alist *configdat* mtcachef)) (if cancreate (set! *configstatus* 'fulldata)))) ;; no configs found? should not happen but let's try to recover gracefully, return an empty hash-table (set! *configdat* (make-hash-table)) ))) ;; else read what you can and set the flag accordingly (else (let* ((cfgdat (find-and-read-config (or (args:get-arg "-config") "megatest.config") environ-patt: "env-override" given-toppath: (get-environment-variable "MT_RUN_AREA_HOME") pathenvvar: "MT_RUN_AREA_HOME"))) (if cfgdat (let* ((toppath (or (get-environment-variable "MT_RUN_AREA_HOME")(cadr cfgdat))) (rdat (read-config (conc toppath ;; convert this to use runconfig:read! "/runconfigs.config") *runconfigdat* #t sections: sections))) (set! *configinfo* cfgdat) (set! *configdat* (car cfgdat)) (set! *runconfigdat* rdat) (set! *toppath* toppath) (set! *configstatus* 'partial)) (begin |
︙ | ︙ |
Modified megatest.scm from [dadb4c2e17] to [328b8da30c].
︙ | ︙ | |||
838 839 840 841 842 843 844 | (sections (if target (list "default" target) #f)) (data (begin (setenv "MT_RUN_AREA_HOME" *toppath*) (if key-vals (for-each (lambda (kt) (setenv (car kt) (cadr kt))) key-vals)) | | > | 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 | (sections (if target (list "default" target) #f)) (data (begin (setenv "MT_RUN_AREA_HOME" *toppath*) (if key-vals (for-each (lambda (kt) (setenv (car kt) (cadr kt))) key-vals)) ;; (read-config (conc *toppath* "/runconfigs.config") #f #t sections: sections)))) (runconfig:read (conc *toppath* "/runconfigs.config") target #f)))) (if (and rundir ;; have all needed variabless (directory-exists? rundir) (file-write-access? rundir)) (begin (configf:write-alist data cfgf) ;; force re-read of megatest.config - this resolves circular references between megatest.config (launch:setup force: #t) |
︙ | ︙ | |||
860 861 862 863 864 865 866 | ;; keep this one local (cond ((and (args:get-arg "-section") (args:get-arg "-var")) (let ((val (or (configf:lookup data (args:get-arg "-section")(args:get-arg "-var")) (configf:lookup data "default" (args:get-arg "-var"))))) (if val (print val)))) | | > > > < < | 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 | ;; keep this one local (cond ((and (args:get-arg "-section") (args:get-arg "-var")) (let ((val (or (configf:lookup data (args:get-arg "-section")(args:get-arg "-var")) (configf:lookup data "default" (args:get-arg "-var"))))) (if val (print val)))) ((or (not (args:get-arg "-dumpmode")) (string=? (args:get-arg "-dumpmode") "ini")) (configf:config->ini data)) ((string=? (args:get-arg "-dumpmode") "sexp") (pp (hash-table->alist data))) ((string=? (args:get-arg "-dumpmode") "json") (json-write data)) (else (debug:print-error 0 *default-log-port* "-dumpmode of " (args:get-arg "-dumpmode") " not recognised"))) (set! *didsomething* #t)) (pop-directory))) (if (args:get-arg "-show-config") (let ((tl (launch:setup)) |
︙ | ︙ |
Modified runconfig.scm from [42efb3636c] to [6cd6ed4572].
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 | ;;====================================================================== ;; read a config file, loading only the section pertinent ;; to this run field1val/field2val/field3val ... ;;====================================================================== (use format directory-utils) (declare (unit runconfig)) (declare (uses common)) (include "common_records.scm") ;; NB// to process a runconfig ensure to use environ-patt with target! ;; (define (setup-env-defaults fname run-id already-seen keyvals #!key (environ-patt #f)(change-env #t)) (let* ((keys (map car keyvals)) (thekey (if keyvals (string-intersperse (map (lambda (x)(if x x "-na-")) (map cadr keyvals)) "/") (or (common:args-get-target) (get-environment-variable "MT_TARGET") (begin (debug:print-error 0 *default-log-port* "setup-env-defaults called with no run-id or -target or -reqtarg") "nothing matches this I hope")))) ;; Why was system disallowed in the reading of the runconfigs file? ;; NOTE: Should be setting env vars based on (target|default) | > > > > > | | 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 | ;;====================================================================== ;; read a config file, loading only the section pertinent ;; to this run field1val/field2val/field3val ... ;;====================================================================== (use format directory-utils) (declare (unit runconfig)) (declare (uses common)) (include "common_records.scm") (define (runconfig:read fname target environ-patt) (let ((ht (make-hash-table))) (hash-table-set! ht target '()) (read-config fname ht #t environ-patt: environ-patt sections: (if target (list "default" target) #f)))) ;; NB// to process a runconfig ensure to use environ-patt with target! ;; (define (setup-env-defaults fname run-id already-seen keyvals #!key (environ-patt #f)(change-env #t)) (let* ((keys (map car keyvals)) (thekey (if keyvals (string-intersperse (map (lambda (x)(if x x "-na-")) (map cadr keyvals)) "/") (or (common:args-get-target) (get-environment-variable "MT_TARGET") (begin (debug:print-error 0 *default-log-port* "setup-env-defaults called with no run-id or -target or -reqtarg") "nothing matches this I hope")))) ;; Why was system disallowed in the reading of the runconfigs file? ;; NOTE: Should be setting env vars based on (target|default) (confdat (runconfig:read fname thekey environ-patt)) (whatfound (make-hash-table)) (finaldat (make-hash-table)) (sections (list "default" thekey))) (if (not *target*)(set! *target* thekey)) ;; may save a db access or two but repeats db:get-target code (debug:print 4 *default-log-port* "Using key=\"" thekey "\"") (if change-env |
︙ | ︙ |