Overview
| Comment: | implemented first level of env var squelching for execute; megatest.config and runconfig.config vars remain to be squelched |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.65-testpanel-execenv |
| Files: | files | file ages | folders |
| SHA1: |
a647090d9409d12c72248d6b4a20ad38 |
| User & Date: | bjbarcla on 2018-12-04 17:47:46 |
| Other Links: | branch diff | manifest | tags |
Context
|
2018-12-04
| ||
| 18:19 | implemented second level of env var squelching by capturing orig env in variable MT_ORIG_ENV in cfg.sh wrapper so it is inherited by nested dashboard call for test control panel. check-in: edcc532c16 user: bjbarcla tags: v1.65-testpanel-execenv | |
| 17:47 | implemented first level of env var squelching for execute; megatest.config and runconfig.config vars remain to be squelched check-in: a647090d94 user: bjbarcla tags: v1.65-testpanel-execenv | |
|
2018-11-30
| ||
| 17:46 | added color cues for steps matrix in test control panel check-in: eb63661bd1 user: bjbarcla tags: v1.65 | |
Changes
Modified common.scm from [8b5ebebcbe] to [c3a2a3cc7d].
| ︙ | ︙ | |||
2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 |
'()))
;; 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))
| > > > > > > > > > > > > > > > > > | 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 |
'()))
;; clear vars matching pattern, run proc, set vars back
;; if proc is a string run that string as a command with
;; system.
;;
(define *common:orig-env* (filter-map (lambda (x)
(if (string-match "^MT_.*" (car x))
#f
x))
(get-environment-variables)))
(define (common:with-orig-env proc)
(let ((current-env (get-environment-variables)))
(for-each (lambda (x) (unsetenv (car x))) current-env)
(for-each (lambda (x) (setenv (car x) (cdr x))) *common:orig-env*)
(let ((rv (cond
((string? proc)(system proc))
(proc (proc)))))
(for-each (lambda (x) (unsetenv (car x))) *common:orig-env*)
(for-each (lambda (x) (setenv (car x) (cdr x))) current-env)
rv)))
(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))
|
| ︙ | ︙ | |||
2102 2103 2104 2105 2106 2107 2108 |
(hash-table-for-each
vars
(lambda (var val)
(setenv var val)))
vars))
| | | | > | | 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 |
(hash-table-for-each
vars
(lambda (var val)
(setenv var val)))
vars))
(define (common:run-a-command cmd #!key (with-vars #f) (with-orig-env #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))))
(debug:print-info 02 *default-log-port* "Running command: " fullcmd)
(cond
(with-vars (common:without-vars cmd))
(with-orig-env (common:with-orig-env cmd))
(else (common:without-vars fullcmd "MT_.*")))))
;;======================================================================
;; T I M E A N D D A T E
;;======================================================================
;; Convert strings like "5s 2h 3m" => 60x60x2 + 3x60 + 5
(define (common:hms-string->seconds tstr)
|
| ︙ | ︙ |
Modified dashboard-tests.scm from [1243e2b2aa] to [cce03f6734].
| ︙ | ︙ | |||
619 620 621 622 623 624 625 | (iup:attribute-set! lbl "TITLE" newval) ;(mutex-unlock! mx1) ))))) lbl)) (store-button store-label) (command-proc (lambda (command-text-box) (let* ((cmd (iup:attribute command-text-box "VALUE"))) | | | 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 | (iup:attribute-set! lbl "TITLE" newval) ;(mutex-unlock! mx1) ))))) lbl)) (store-button store-label) (command-proc (lambda (command-text-box) (let* ((cmd (iup:attribute command-text-box "VALUE"))) (common:run-a-command cmd with-orig-env: #t)))) (command-text-box (iup:textbox #:expand "HORIZONTAL" #:font "Courier New, -10" #:action (lambda (obj cnum val) ;; (print "cnum=" cnum) (if (eq? cnum 13) (command-prox obj))) |
| ︙ | ︙ |