Megatest

Check-in [71d89918c0]
Login
Overview
Comment:fixed color of steps matrix when val is -
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-testpanel-execenv
Files: files | file ages | folders
SHA1: 71d89918c0e5efb435591a5e25dd67b157540146
User & Date: bjbarcla on 2018-12-05 15:21:10
Other Links: branch diff | manifest | tags
Context
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
15:21
fixed color of steps matrix when val is - Leaf check-in: 71d89918c0 user: bjbarcla tags: v1.65-testpanel-execenv
13:33
added serialize-env.scm check-in: 934132ed7c user: bjbarcla tags: v1.65-testpanel-execenv
Changes

Modified Makefile from [85eff08023] to [09076a6975].

276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
$(PREFIX)/bin/.$(ARCHSTR)/dboard : dboard $(FILES) utils/mk_wrapper
	utils/mk_wrapper $(PREFIX) dboard $(PREFIX)/bin/dashboard
	chmod a+x $(PREFIX)/bin/dashboard
	$(INSTALL) dboard $(PREFIX)/bin/.$(ARCHSTR)/dboard

install : $(PREFIX)/bin/.$(ARCHSTR) $(PREFIX)/bin/.$(ARCHSTR)/mtest $(PREFIX)/bin/megatest \
          $(PREFIX)/bin/.$(ARCHSTR)/dboard $(PREFIX)/bin/dashboard $(HELPERS) $(PREFIX)/bin/nbfake \
          $(PREFIX)/bin/serialize-env
	  $(PREFIX)/bin/nbfind $(PREFIX)/bin/loadrunner $(PREFIX)/bin/viewscreen $(PREFIX)/bin/mt_xterm \
	  $(PREFIX)/share/docs/megatest_manual.html $(PREFIX)/bin/remrun \
	  $(PREFIX)/share/docs/megatest_manual.html $(PREFIX)/bin/remrun $(PREFIX)/bin/mtutil \
	  $(PREFIX)/bin/tcmt $(PREFIX)/share/db/mt-pg.sql \
          $(PREFIX)/share/js/jquery-3.1.0.slim.min.js 
#         $(PREFIX)/bin/.$(ARCHSTR)/ndboard








|







276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
$(PREFIX)/bin/.$(ARCHSTR)/dboard : dboard $(FILES) utils/mk_wrapper
	utils/mk_wrapper $(PREFIX) dboard $(PREFIX)/bin/dashboard
	chmod a+x $(PREFIX)/bin/dashboard
	$(INSTALL) dboard $(PREFIX)/bin/.$(ARCHSTR)/dboard

install : $(PREFIX)/bin/.$(ARCHSTR) $(PREFIX)/bin/.$(ARCHSTR)/mtest $(PREFIX)/bin/megatest \
          $(PREFIX)/bin/.$(ARCHSTR)/dboard $(PREFIX)/bin/dashboard $(HELPERS) $(PREFIX)/bin/nbfake \
          $(PREFIX)/bin/serialize-env \
	  $(PREFIX)/bin/nbfind $(PREFIX)/bin/loadrunner $(PREFIX)/bin/viewscreen $(PREFIX)/bin/mt_xterm \
	  $(PREFIX)/share/docs/megatest_manual.html $(PREFIX)/bin/remrun \
	  $(PREFIX)/share/docs/megatest_manual.html $(PREFIX)/bin/remrun $(PREFIX)/bin/mtutil \
	  $(PREFIX)/bin/tcmt $(PREFIX)/share/db/mt-pg.sql \
          $(PREFIX)/share/js/jquery-3.1.0.slim.min.js 
#         $(PREFIX)/bin/.$(ARCHSTR)/ndboard

Modified common.scm from [7425393881] to [a09b98476d].

2079
2080
2081
2082
2083
2084
2085
2086


2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
      '()))


;; 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* (if (get-environment-variable "MT_ORIG_ENV")


                              (with-input-from-string
                                  (z3:decode-buffer (base64:base64-decode (get-environment-variable "MT_ORIG_ENV")))
                                read)
                              (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))







|
>
>







|







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


;; 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*
  (let ((envvars (get-environment-variables)))
    (if (get-environment-variable "MT_ORIG_ENV")
                              (with-input-from-string
                                  (z3:decode-buffer (base64:base64-decode (get-environment-variable "MT_ORIG_ENV")))
                                read)
                              (filter-map (lambda (x)
                                            (if (string-match "^MT_.*" (car x))
                                                #f
                                                x))
                    envvars))))

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

Modified dcommon.scm from [bd3c15a49b] to [fc7423a843].

1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
		   (colnum 1))
	  (if (> rownum max-row)(set! max-row rownum))
	  (let* ((status  (vector-ref hed 3))
                 (val     (vector-ref hed (- colnum 1)))
                 (bgcolor (cond
                           ((member (conc status) '("" "#<unspecified>"))
                            running-color)
                           ((member (conc status) '("0" 0))
                            white)
                           (else failcolor)))
		 (mtrx-rc (conc rownum ":" colnum)))
            ;;(print "BB> status=>"status"< bgcolor="bgcolor)
	    (iup:attribute-set! steps-matrix  mtrx-rc (if val (conc val) ""))
            (if (< colnum 5)
                (iup:attribute-set! steps-matrix  (conc "BGCOLOR" mtrx-rc) bgcolor))







|







1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
		   (colnum 1))
	  (if (> rownum max-row)(set! max-row rownum))
	  (let* ((status  (vector-ref hed 3))
                 (val     (vector-ref hed (- colnum 1)))
                 (bgcolor (cond
                           ((member (conc status) '("" "#<unspecified>"))
                            running-color)
                           ((member (conc status) '("0" 0 "-"))
                            white)
                           (else failcolor)))
		 (mtrx-rc (conc rownum ":" colnum)))
            ;;(print "BB> status=>"status"< bgcolor="bgcolor)
	    (iup:attribute-set! steps-matrix  mtrx-rc (if val (conc val) ""))
            (if (< colnum 5)
                (iup:attribute-set! steps-matrix  (conc "BGCOLOR" mtrx-rc) bgcolor))