Megatest

Changes On Branch a647090d9409d12c
Login

Changes In Branch v1.65-testpanel-execenv Through [a647090d94] Excluding Merge-Ins

This is equivalent to a diff from eb63661bd1 to a647090d94

2018-12-05
16:28
merged feature to preserve environment for test control panel execute button check-in: 74324f583b user: bjbarcla tags: v1.65, v1.6517
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
15:49
completed fix of restart step -- refactored to add active columns to step matrix check-in: dbcb3cf9a9 user: bjbarcla tags: v1.65

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
2109
2110
2111
2112
2113
2114
2115
2116
2117

2118
2119
2120
2121
2122
2123
2124
2125
    (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))))
    (debug:print-info 02 *default-log-port* "Running command: " fullcmd)
    (if with-vars
        (common:without-vars cmd)

        (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)







|






|
|
>
|







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
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))))
	       (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)))







|







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)))