Overview
Comment: | restored launch functionality using subrun under updated subrun architecture |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | 1.65-subrun-ancilliary-usecases |
Files: | files | file ages | folders |
SHA1: |
b1363320bf3e08d36c351fc39719b50a |
User & Date: | bjbarcla on 2017-12-26 16:14:24 |
Other Links: | branch diff | manifest | tags |
Context
2017-12-26
| ||
18:07 | wip; added hooks for subrun remove-run handling check-in: 05b23944bc user: bjbarcla tags: 1.65-subrun-ancilliary-usecases | |
16:14 | restored launch functionality using subrun under updated subrun architecture check-in: b1363320bf user: bjbarcla tags: 1.65-subrun-ancilliary-usecases | |
12:22 | factored out subrun code in launch to subrun.scm check-in: ec63f32f93 user: bjbarcla tags: 1.65-subrun-ancilliary-usecases | |
Changes
Modified common.scm from [e4fb4b51ea] to [bd48028047].
︙ | ︙ | |||
1786 1787 1788 1789 1790 1791 1792 | (define (common:get-param-mapping #!key (flavor #f)) "returns alist mapping string keys in testconfig/subrun to megatest command line switches; if flavor is switch-symbol, maps tcmt symbolic switches to megatest switches" (let ((default '(("tag-expr" . "-tagexpr") ("mode-patt" . "-modepatt") ("run-name" . "-runname") ("contour" . "-contour") ("mode-patt" . "-mode-patt") | | > > | | 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 | (define (common:get-param-mapping #!key (flavor #f)) "returns alist mapping string keys in testconfig/subrun to megatest command line switches; if flavor is switch-symbol, maps tcmt symbolic switches to megatest switches" (let ((default '(("tag-expr" . "-tagexpr") ("mode-patt" . "-modepatt") ("run-name" . "-runname") ("contour" . "-contour") ("mode-patt" . "-mode-patt") ("target" . "-target") ("test-patt" . "-testpatt") ("msg" . "-m") ("log" . "-log") ("start-dir" . "-start-dir") ("new" . "-set-state-status")))) (if (eq? flavor 'switch-symbol) (map (lambda (x) (cons (string->symbol (conc "-" (car x))) (cdr x))) default) default))) ;; set some env vars from an alist, return an alist with original values ;; (("VAR" "value") ...) |
︙ | ︙ |
Modified dashboard-tests.scm from [c114ec0352] to [1155a25cab].
︙ | ︙ | |||
247 248 249 250 251 252 253 | (define (submegatest-panel dbstruct keydat testdat runname testconfig) (let* ((test-run-dir (db:test-get-rundir testdat)) (subrun-tconf-file (conc test-run-dir "/testconfig.subrun")) (subrun-tconf (if (file-exists? subrun-tconf-file) (configf:read-alist subrun-tconf-file) (make-hash-table))) (subarea (or (configf:lookup testconfig "setup" "submegatest") | | | 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 | (define (submegatest-panel dbstruct keydat testdat runname testconfig) (let* ((test-run-dir (db:test-get-rundir testdat)) (subrun-tconf-file (conc test-run-dir "/testconfig.subrun")) (subrun-tconf (if (file-exists? subrun-tconf-file) (configf:read-alist subrun-tconf-file) (make-hash-table))) (subarea (or (configf:lookup testconfig "setup" "submegatest") (configf:lookup subrun-tconf "subrun" "run-area"))) (area-exists (and subarea (common:file-exists? subarea)))) ;; (debug:print-info 0 *default-log-port* "Megatest subarea=" subarea ", area-exists=" area-exists) (if subarea (iup:frame #:title "Megatest Run Info" ; #:expand "YES" (iup:button "Launch Dashboard" |
︙ | ︙ |
Modified launch.scm from [0c59c66c55] to [37186dba18].
︙ | ︙ | |||
320 321 322 323 324 325 326 | ;; 1. get section [runarun] ;; 2. unset MT_* vars ;; 3. fix target ;; 4. fix runname ;; 5. fix testpatt or calculate it from contour ;; 6. launch the run ;; 7. roll up the run result and or roll up the logpro processed result | | | 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 | ;; 1. get section [runarun] ;; 2. unset MT_* vars ;; 3. fix target ;; 4. fix runname ;; 5. fix testpatt or calculate it from contour ;; 6. launch the run ;; 7. roll up the run result and or roll up the logpro processed result (when (configf:lookup testconfig "subrun" "runwait") ;; we use runwait as the flag that a subrun is requested (subrun:initialize-toprun-test testconfig test-run-dir) (let* ((mt-cmd (subrun:launch-cmd test-run-dir))) (debug:print-info 0 *default-log-port* "Subrun command is \"" mt-cmd "\"") (set! ezsteps #t) ;; set the needed flag (set! ezstepslst (append (or ezstepslst '()) (list (list "subrun" (conc "{subrun=true} " mt-cmd))))))) |
︙ | ︙ |
Modified mtut.scm from [381ac4c5d5] to [9183a72ed5].
︙ | ︙ | |||
251 252 253 254 255 256 257 | ;;====================================================================== ;; U T I L S ;;====================================================================== ;; given a mtutil param, return the old megatest equivalent ;; | | < | > | | 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 | ;;====================================================================== ;; U T I L S ;;====================================================================== ;; given a mtutil param, return the old megatest equivalent ;; (define (megatest-param->mtutil-param param) (let* ((mapping-alist (common:get-param-mapping flavor: 'switch-symbol))) (alist-ref (string->symbol param) mapping-alist eq? param) param)) (define (val->alist val) (let ((val-list (string-split-fields ";\\s*" val #:infix))) (if val-list (map (lambda (x) (let ((f (string-split-fields "\\s*=\\s*" x #:infix))) (case (length f) |
︙ | ︙ | |||
956 957 958 959 960 961 962 | runkeydats))) (let ((res (configf:get-section torun contour))) ;; each contour / target ;; (print "res=" res) res)))) (hash-table-keys torun))))))) (define (pkt->cmdline pkta) | > | | | | | | 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 | runkeydats))) (let ((res (configf:get-section torun contour))) ;; each contour / target ;; (print "res=" res) res)))) (hash-table-keys torun))))))) (define (pkt->cmdline pkta) (let* ((param-mapping-alist (common:get-param-mapping flavor: 'switch-symbol)) (action (or (lookup-action-by-key (alist-ref 'A pkta)) "noaction")) (action-param (case (string->symbol action) ((-set-state-status) (conc (alist-ref 'l pkta) " ")) (else "")))) (fold (lambda (a res) (let* ((key (car a)) ;; get the key name (val (cdr a)) (par (or (lookup-param-by-key key) ;; need to check also if it is a switch (lookup-param-by-key key inlst: *switch-keys*)))) ;; (print "key: " key " val: " val " par: " par) (if par (conc res " " (alist-ref (string->symbol par) param-mapping-alist eq? par) " " val) (if (alist-ref key *additional-cards*) ;; these cards do not translate to parameters or switches res (begin (print "ERROR: Unknown key in packet \"" key "\" with value \"" val "\"") res))))) (conc "megatest " (if (not (member action '("sync"))) (conc action " " action-param) |
︙ | ︙ |
Modified subrun.scm from [7767e7bac6] to [5fbd7e058e].
︙ | ︙ | |||
20 21 22 23 24 25 26 | ;;(declare (uses runconfig)) ;;(declare (uses tests)) ;;(declare (uses server)) ;;(declare (uses mt)) ;;(declare (uses archive)) ;; (declare (uses filedb)) | | | > > > > > > > > | | | | | > | > > | < < | | | | | | | | | | | < < < | | | > > > > > > > > > | > > > > > > > > | < < < < < < < < | | > > > | > | | | 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 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 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 | ;;(declare (uses runconfig)) ;;(declare (uses tests)) ;;(declare (uses server)) ;;(declare (uses mt)) ;;(declare (uses archive)) ;; (declare (uses filedb)) ;(include "common_records.scm") ;;(include "key_records.scm") ;;(include "db_records.scm") ;;(include "run_records.scm") ;;(include "test_records.scm") (define (subrun:initialize-toprun-test testconfig test-run-dir) (let ((ra (configf:lookup testconfig "subrun" "run-area")) (logpro (configf:lookup testconfig "subrun" "logpro")) (symlink-target (conc test-run-dir "/subrun-area")) ) (when (not ra) ;; when runarea is not set we default to *toppath*. However ;; we need to force the setting in the testconfig so it will ;; be preserved in the testconfig.subrun file (configf:set-section-var testconfig "subrun" "runarea" *toppath*)) (configf:set-section-var testconfig "logpro" "subrun" logpro) ;; append the logpro rules to the logpro section as stepname subrun (if (common:file-exists? symlink-target) (delete-file symlink-target)) (create-symbolic-link ra symlink-target) (configf:write-alist testconfig "testconfig.subrun"))) (define (subrun:launch-cmd test-run-dir) (let* ((log-prefix "run") (switches (subrun:selector+log-switches test-run-dir log-prefix)) (run-wait #t) (cmd (conc "megatest -run "switches" " (if run-wait "-run-wait " "")))) cmd)) ;; set state/status of test item ;; fork off megatest ;; set state/status of test item ;; (define (subrun:selector+log-switches test-run-dir log-prefix) (let* ((switch-def-alist (common:get-param-mapping flavor: 'config)) (subrunfile (conc test-run-dir "/testconfig.subrun" )) (subrundata (with-input-from-file subrunfile read)) (subrunconfig (configf:alist->config subrundata)) (run-area (configf:lookup subrunconfig "subrun" "run-area")) (defvals `(("start-dir" . ,(or run-area ;; default values if not specified in subrun section of tconf (get-environment-variable "MT_RUN_AREA_HOME") "/no/rundir/found")) ("run-name" . ,(or (get-environment-variable "MT_RUNNAME") "NO-RUNNAME")) ("target" . ,(or (get-environment-variable "MT_TARGET") "NO-TARGET")))) (switch-alist-pre (filter-map (lambda (item) (let* ((config-key (car item)) (switch (cdr item)) (defval (alist-ref config-key defvals equal? #f)) (val (or (configf:lookup subrunconfig "subrun" config-key) defval))) (if val (cons switch val) #f))) switch-def-alist)) ;; testpatt may be modified if all three of mode-patt, tag-expr, and testpatt are null (mode-patt (alist-ref "-modepatt" switch-alist-pre equal? #f)) (tag-expr (alist-ref "-tagexpr" switch-alist-pre equal? #f)) (testpatt (alist-ref "-testpatt" switch-alist-pre equal? (if (not (or mode-patt tag-expr)) "%" #f))) ;; testpatt is % if not ;; otherwise specified ;; define compact-stem for logfile (target (alist-ref "-target" switch-alist-pre equal? #f)) ;; want data-structures alist-ref, not alist-lib alist-ref (runname (alist-ref "-runname" switch-alist-pre equal? #f)) (compact-stem (string-substitute "[/*]" "_" (conc target "-" runname "-" (or testpatt mode-patt tag-expr "NO-TESTPATT")))) (logfile (conc test-run-dir "/" (or log-prefix "") (if log-prefix "-" "") compact-stem ".log")) ;; swap out testpatt with modified test-patt and add -log (switch-alist (cons (cons "-log" logfile) (map (lambda (item) (if (equal? (car item) "-testpatt") (cons "-testpatt" testpatt) item)) switch-alist-pre)))) ;; note - get precmd from subrun section ;; apply to submegatest commands (let* ((res (string-intersperse (apply append (map (lambda (x) (list (car x) (cdr x))) switch-alist)) " "))) res))) (define (subrun:exec-sub-megatest test-run-dir switches #!key (logfile #f)) (let* ((real-logfile (or logfile (conc (test-run-dir) "/subrun-" (string-substitute "[/*]" "_" (string-intersperse switches "^"))"-" (number->string (current-seconds)) ".log"))) (selector-switches (common:sub-megatest-selector-switches test-run-dir)) |
︙ | ︙ |