Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -1788,15 +1788,17 @@ (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) + (if (eq? flavor 'switch-symbol) (map (lambda (x) (cons (string->symbol (conc "-" (car x))) (cdr x))) default) default))) Index: dashboard-tests.scm ================================================================== --- dashboard-tests.scm +++ dashboard-tests.scm @@ -249,11 +249,11 @@ (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" "runarea"))) + (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" Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -322,11 +322,11 @@ ;; 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 - (if (configf:lookup testconfig "subrun" "runwait") ;; we use runwait as the flag that a subrun is requested + (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 Index: mtut.scm ================================================================== --- mtut.scm +++ mtut.scm @@ -253,14 +253,14 @@ ;; U T I L S ;;====================================================================== ;; given a mtutil param, return the old megatest equivalent ;; -(define (param-translate param) - (or (alist-ref (string->symbol param) - (common:get-param-mapping flavor: 'switch-symbol)) - param)) +(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) @@ -958,22 +958,23 @@ ;; (print "res=" res) res)))) (hash-table-keys torun))))))) (define (pkt->cmdline pkta) - (let* ((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 "")))) + (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 " " (param-translate par) " " val) + (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))))) Index: subrun.scm ================================================================== --- subrun.scm +++ subrun.scm @@ -22,35 +22,43 @@ ;;(declare (uses server)) ;;(declare (uses mt)) ;;(declare (uses archive)) ;; (declare (uses filedb)) -(include "common_records.scm") +;(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"))) + (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 runwait "-run-wait " "")))) + (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 @@ -61,31 +69,38 @@ (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 `(("-runname" . ,(get-environment-variable "MT_RUNNAME")) - ("-target" . ,(get-environment-variable "MT_TARGET")))) - (switch-alist (apply - append - (filter-map (lambda (item) - (let ((config-key (car item)) - (switch (cdr item)) - (defval (alist-ref defvals switch equal?)) - (val (or (configf:lookup subrunconfig switch) - defval))) - (if val - (list switch val) - #f))) - switch-def-alist))) - (target (or (alist-ref "-target" switch-alist equal? #f) ;; want data-structures alist-ref, not alist-lib alist-ref - "NO-TARGET")) - (runname (or (alist-ref "-runname" switch-alist equal? #f) - "NO-RUNNAME")) - (testpatt (alist-ref "-testpatt" switch-alist equal? #f)) - (mode-patt (alist-ref "-modepatt" switch-alist equal? #f)) - (tag-expr (alist-ref "-tagexpr" switch-alist equal? #f)) + (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 @@ -93,27 +108,31 @@ (logfile (conc test-run-dir "/" (or log-prefix "") (if log-prefix "-" "") compact-stem - ".log"))) + ".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 - - (conc - " -start-dir " run-area " " - " -runname " runname " " - " -target " target " " - (if testpatt (conc "-testpatt " testpatt" ") "") - (if modepatt (conc "-modepatt " modepatt" ") "") - (if tag-expr (conc "-tag-expr " tag-expr" ") "") - - (string-intersperse - (apply append - (map (lambda (x) (list (car x) (cdr x))) switch-def-alist)) - " ") - "-log " logfile))) + (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 "^"))"-"