Megatest

				       (string-search whitesp key)
				       (string-search ":" key)) ;; internal only values to be skipped.
				   "# export "
				   "export ")
			       key "=" delim (mungeval val) delim)))
                    envvars)))))


(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")
                   
                   ("test-patt" . "-testpatt")
                   ("msg"       . "-m")
                   ("new"       . "-set-state-status"))))
    (if (eq? flavor 'switch)
        (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") ...)
;; a value of #f means "unset this var"
;;
(define (alist->env-vars lst)
  (if (list? lst)
      (let ((res '()))
	(for-each (lambda (p)
		    (let* ((var (car  p))
			   (val (cadr p))
			   (prv (get-environment-variable var)))
		      (set! res (cons (list var prv) res))
		      (if val 
			  (safe-setenv var (->string val))
			  (unsetenv var))))
		  lst)
	res)
      '()))


;; clear vars matching pattern, run proc, set vars back
;; if proc is a string run that string as a command with
;; system.
;;



(define (common:without-vars proc . var-patts)
  (let ((vars (make-hash-table)))
    (for-each
     (lambda (vardat) ;; each env var
       (for-each
	(lambda (var-patt)
	  (if (string-match var-patt (car vardat))

     (proc          (proc)))
    (hash-table-for-each
     vars
     (lambda (var val)
       (setenv var val)))
    vars))




















































(define (common:run-a-command cmd #!key (with-vars #f))
  (let* ((pre-cmd  (dtests:get-pre-command))
         (post-cmd (dtests:get-post-command))
         (fullcmd  (if (or pre-cmd post-cmd)
                       (conc pre-cmd cmd post-cmd)
                       (conc "viewscreen " cmd))))

	       (begin
		 (thread-sleep! 2)
		 (loop (+ i 1)))
	       )))))
  ;; then, if runscript ran ok (or did not get called)
  ;; do all the ezsteps (if any)
  (if (or ezsteps subrun)
      (let* ((test-run-dir (tests:get-test-path-from-environment))
             (testconfig ;; (read-config (conc work-area "/testconfig") #f #t environ-patt: "pre-launch-env-vars")) ;; FIXME??? is allow-system ok here?
	      ;; NOTE: it is tempting to turn off force-create of testconfig but dynamic
	      ;;       ezstep names need a full re-eval here.
	      (tests:get-testconfig test-name item-path tconfigreg #t force-create: #t)) ;; 'return-procs)))
	     (ezstepslst (if (hash-table? testconfig)
			     (hash-table-ref/default testconfig "ezsteps" '())
			     #f)))
	(if testconfig

	;; 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
	(if (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* ((runarea   (let ((ra (configf:lookup testconfig "subrun" "run-area")))
				(if ra      ;; when runarea is not set we default to *toppath*. However 
				    ra      ;; we need to force the setting in the testconfig so it will
				    (begin  ;; be preserved in the testconfig.subrun file
				      (configf:set-section-var testconfig "subrun" "runarea" *toppath*)
				      *toppath*))))
                   ;;; BB: TODO - use common:param

(define (subrun:initialize-toprun-test test-run-dir testconfig)
  (let ((ra (configf:lookup testconfig "subrun" "run-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:write-alist testconfig "testconfig.subrun") 
  )


(define (subrun:launch )



  )

;; 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      `(("-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        (alist-ref switch-alist "-target" equal?))
         (runname       (alist-ref switch-alist "-runname" equal?))
         (testpatt      (alist-ref switch-alist "-testpatt" equal?))
         (mode-patt     (alist-ref switch-alist "-modepatt" equal?))
         (tag-expr      (alist-ref switch-alist "-tagexpr" equal?))
         (compact-stem  (string-substitute "[/*]" "_"
                                           (conc
                                            (or target "NO-TARGET")
                                            "-"
                                            (or runname "NO-RUNNAME")
                                            "-" (or testpatt mode-patt tag-expr "NO-TESTPATT"))))
         (logfile       (conc
                         test-run-dir "/"
                         (or log-prefix "")
                         (if log-prefix "-" "")
                         compact-stem
                         ".log")))
    ;; note - get precmd from subrun section
    ;;   apply to submegatest commands
    
    (conc
     " -start-dir " run-area " "
     
     (string-intersperse
      (apply append
           (map (lambda (x) (list (car x) (cdr x))) switch-def-alist))
      " ")
     "-log " logfile)))


(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))
         (cmd-list `("megatest" ,@selector-switches ,@switches "-log" ,real-logfile))
         )
    (call-with-environment-variables 
     (list (cons "PATH" (conc (get-environment-variable "PATH") ":.")))
     (lambda  ()
       (common:without-vars proc "^MT_.*")
       
       ))))