Megatest

Check-in [a5c316f836]
Login
Overview
Comment:fixed step colors and first pass attempt to fix ezsteps chaining improperly in test control panel from "run one step"
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-ezsteps-tcp
Files: files | file ages | folders
SHA1: a5c316f8363c6f75018e8cde00f4903aa004ece5
User & Date: bjbarcla on 2019-06-07 17:54:57
Original Comment: fixed step colors and first pass attempt to fix ezsteps chaining improperly
Other Links: branch diff | manifest | tags
Context
2019-06-07
18:11
fixed some problems; some problems remain (eg. item variables missing, steps are repeated for some reason with "restart from here" step button check-in: 2a78655184 user: bjbarcla tags: v1.65-ezsteps-tcp
17:54
fixed step colors and first pass attempt to fix ezsteps chaining improperly in test control panel from "run one step" check-in: a5c316f836 user: bjbarcla tags: v1.65-ezsteps-tcp
2019-05-31
16:08
Updated version tag check-in: e03d5c75f8 user: jmoon18 tags: v1.65, v1.6529
Changes

Modified common.scm from [18d6f81858] to [0531aaf20e].

223
224
225
226
227
228
229








230


231











232




233













234
235
236
237
238
239
240
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278







+
+
+
+
+
+
+
+

+
+

+
+
+
+
+
+
+
+
+
+
+

+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+







           (else (car argv))))
         (fullpath (realpath this-script)))
    fullpath))
(define *common:this-exe-fullpath* (common:get-this-exe-fullpath))
(define *common:this-exe-dir*      (pathname-directory *common:this-exe-fullpath*))
(define *common:this-exe-name*     (pathname-strip-directory *common:this-exe-fullpath*))

(define *common:logpro-exit-code->status-sym-alist*
  '( ( 0 . pass )
     ( 1 . fail )
     ( 2 . warn )
     ( 3 . check )
     ( 4 . waived )
     ( 5 . abort )
     ( 6 . skip )))

(define (common:logpro-exit-code->status-sym exit-code)
  (or (alist-ref exit-code *common:logpro-exit-code->status-sym-alist*) 'fail))

(define (common:worse-status-sym ss1 ss2)
  (let loop ((status-syms-remaining '(abort fail check warn waived pass)))
    (cond
     ((null? status-syms-remaining)
      'fail)
     ((eq? (car status-syms-remaining) ss1)
      ss1)
     ((eq? (car status-syms-remaining) ss2)
      ss2)
     (else
      (loop (cdr status-syms-remaining))))))

(define (common:steps-can-proceed-given-status-sym status-sym)
  (if (member status-sym '(warn waived pass))
      #t
      #f))

(define (status-sym->string status-sym)
  (case
      ((pass) "PASS")
    ((fail) "FAIL")
    ((warn) "WARN")
    ((check) "CHECK")
    ((waived) "WAIVED")
    ((abort) "ABORT")
    ((skip) "SKIP")
    (else "FAIL")))

(define (common:logpro-exit-code->test-status exit-code)
  (status-sym->string (common:logpro-exit-code->status-sym exit-code)))

(defstruct remote
  (hh-dat            (common:get-homehost)) ;; homehost record ( addr . hhflag )
  (server-url        (if *toppath* (server:check-if-running *toppath*))) ;; (server:check-if-running *toppath*) #f))
  (last-server-check 0)  ;; last time we checked to see if the server was alive
  (conndat           #f)
  (transport         *transport-type*)

Modified dashboard-tests.scm from [cce03f6734] to [2fbc8e905f].

769
770
771
772
773
774
775
776

777
778
779
780
781
782
783
769
770
771
772
773
774
775

776
777
778
779
780
781
782
783







-
+







                                         (iup:attribute-set! steps-matrix "BGCOLOR0:7" "149 208 252")
                                         (iup:attribute-set! steps-matrix "0:9" "rerun & continue")
					 (iup:attribute-set! steps-matrix "ALIGNMENT1" "ALEFT")
					 ;; (iup:attribute-set! steps-matrix "FIXTOTEXT" "C1")
					 (iup:attribute-set! steps-matrix "RESIZEMATRIX" "YES")
					 (let ((proc
						(lambda (testdat)
						  (dcommon:populate-steps teststeps steps-matrix))))
						  (dcommon:populate-steps teststeps steps-matrix run-id test-id))))
					   (hash-table-set! widgets "StepsMatrix" proc)
					   (proc testdat))
					 steps-matrix)
				       ;; populate the Test Data panel
				       (iup:frame
					#:title "Test Data"
					(let ((test-data

Modified dcommon.scm from [c88297a7d4] to [b308604e85].

1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270











1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282

1283
1284

1285

1286
1287
1288
1289
1290
1291
1292
1258
1259
1260
1261
1262
1263
1264






1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291

1292
1293
1294
1295
1296
1297
1298
1299







-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+












+


+
-
+







						 (hash-table-keys tests-info)))))))
     canvas-obj)))

;;======================================================================
;;  S T E P S
;;======================================================================

(define (dcommon:populate-steps teststeps steps-matrix)
  (let ((max-row       0)
	(max-col       9)
        (white         "255 255 255")
        (running-color (car (gutils:get-color-for-state-status "RUNNING" "STARTED")))
        (failcolor     (car (gutils:get-color-for-state-status "COMPLETED" "FAIL"))))
(define (dcommon:populate-steps teststeps steps-matrix run-id test-id)
  (let* ((max-row       0)
	 (max-col       9)
         (white         "255 255 255")
         
         (testinfo      (rmt:get-testinfo-state-status run-id test-id))
         (state         (db:test-get-state testinfo))
         (status        (db:test-get-status testinfo))
         (test-status-color (car (gutils:get-color-for-state-status state status)))
         (running-color (car (gutils:get-color-for-state-status "RUNNING" "STARTED")))
         (failcolor     (car (gutils:get-color-for-state-status "COMPLETED" "FAIL"))))
    (if (null? teststeps)
	(iup:attribute-set! steps-matrix "CLEARVALUE" "CONTENTS")
	(let loop ((hed    (car teststeps))
		   (tal    (cdr teststeps))
		   (rownum 1)
		   (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 test-status-color)))
                           (else failcolor)))
                          ; (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))
	    (if (< colnum max-col)
		(loop hed tal rownum (+ colnum 1))

Modified ezsteps.scm from [f44a45955c] to [b9a38f6eac].

42
43
44
45
46
47
48

49
50
51
52
53


54
55
56
57
58
59
60
61

62
63
64
65
66

67
68
69
70

71
72




73
74
75
76
77
78
79







80
81
82



83
84
85
86
87
88
89
90
















91
92
93
94
95
96
97
98
99
100

101

102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117

118
119

120
121
122
123
124






125
126
127
128

129
130
131


132
133
134
135
136


137
138
139

140
141
142
143
144
145
146
147
148













149
150
151
152
153




154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175














176
177
178
179
180
181
182
183
184
185
186
187
188
189

190
191
192
193
194
195
196
197
198
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69

70
71
72
73
74
75


76
77
78
79
80






81
82
83
84
85
86
87



88
89
90








91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108






109
110
111

112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133




134
135
136
137
138
139




140



141
142


143


144
145



146









147
148
149
150
151
152
153
154
155
156
157
158
159





160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175










176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202

203
204
205
206
207
208
209
210
211
212







+





+
+








+




-
+




+
-
-
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-


+
-
+
















+


+

-
-
-
-
+
+
+
+
+
+
-
-
-
-
+
-
-
-
+
+
-
-

-
-
+
+
-
-
-
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+












-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+













-
+









(define (ezsteps:run-from testdat start-step-name run-one)
  (let* ((test-run-dir  ;; (filedb:get-path *fdb* 
	  (db:test-get-rundir testdat)) ;; )
	 (testconfig    (read-config (conc test-run-dir "/testconfig") #f #t environ-patt: "pre-launch-env-vars"))
	 (ezstepslst    (hash-table-ref/default testconfig "ezsteps" '()))
	 (run-mutex     (make-mutex))
	 (rollup-status 0)
         (rollup-status-string #f)
	 (exit-info     (vector #t #t #t))
	 (test-id       (db:test-get-id testdat))
	 (run-id        (db:test-get-run_id testdat))
	 (test-name     (db:test-get-testname testdat))
	 (kill-job      #f)) ;; for future use (on re-factoring with launch.scm code

    ;; keep trying till NFS deigns to populate test run dir on this host
    (let loop ((count 5))
      (if (common:file-exists? test-run-dir)
	  (push-directory test-run-dir)
	  (if (> count 0)
	      (begin
		(debug:print 0 *default-log-port* "WARNING: ezsteps attempting to run but test run directory " test-run-dir " is not there. Waiting and trying again " count " more times")
		(sleep 3)
		(loop (- count 1))))))
    
    (debug:print-info 0 *default-log-port* "Running in directory " test-run-dir)
    (if (not (common:file-exists? ".ezsteps"))(create-directory ".ezsteps"))
    ;; if ezsteps was defined then we are sure to have at least one step but check anyway
    
     (if (not (> (length ezstepslst) 0))
    (if (not (> (length ezstepslst) 0))
	(message-window "ERROR: You can only re-run steps defined via ezsteps")
	(begin
	  (let loop ((ezstep   (car ezstepslst))
		     (tal      (cdr ezstepslst))
                     (status-sym-so-far 'pass)
		     (prevstep #f)
		     (runflag  #f)) ;; flag used to skip steps when not starting at the beginning
		     (prevstep "-")
		     ;;(runflag  #f)
                     (saw-start-step-name #f)) ;; flag used to skip steps when not starting at the beginning

	    (if (vector-ref exit-info 1)
		(let* ((stepname  (car ezstep))  ;; do stuff to run the step
		       (stepinfo  (cadr ezstep))
		       (stepparts (string-match (regexp "^(\\{([^\\}]*)\\}\\s*|)(.*)$") stepinfo))
		       (stepparms (list-ref stepparts 2)) ;; for future use, {VAR=1,2,3}, run step for each 
		       (stepcmd   (list-ref stepparts 3))
		       (script    "") ; "#!/bin/bash\n") ;; yep, we depend on bin/bash FIXME!!!
		(let* ((stepname    (car ezstep))  ;; do stuff to run the step
                       (logpro-used (common:file-exists? (conc stepname ".logpro")))
		       (stepinfo    (cadr ezstep))
		       (stepparts   (string-match (regexp "^(\\{([^\\}]*)\\}\\s*|)(.*)$") stepinfo))
		       (stepparms   (list-ref stepparts 2)) ;; for future use, {VAR=1,2,3}, run step for each 
		       (stepcmd     (list-ref stepparts 3))
		       (script      (conc "mt_ezstep " stepname " "  prevstep " " stepcmd)) ;; call the command using mt_ezstep
		       (logpro-used #f))

		  ;; Skip steps until hit start-step-name
                       (saw-start-step-name-next (or saw-start-step-name (equal? stepname start-step-name)))
                       (proceed-with-this-step
                        (or (not start-step-name)
		  ;;
		  (if (and start-step-name
			   (not runflag))
		      (if (equal? stepname start-step-name)
			  (set! runflag #t) ;; and continue
			  (if (not (null? tal))
			      (loop (car tal)(cdr tal) stepname #f))))

                            (equal? stepname start-step-name)
                            (and saw-start-step-name (not run-one))
                            saw-start-step-name-next
                            (and start-step-name (equal? stepname start-step-name)))))
                  
                  (cond
                   ((and (not proceed-with-this-step) (null? tal))
                    'done)
                   ((not proceed-with-this-step)
                      (loop (car tal)
                            (cdr tal)
                            status-sym-so-far
                            stepname
                            ;; #f
                            saw-start-step-name-next)))
                  
		  (debug:print 4 *default-log-port* "ezsteps:\n stepname: " stepname " stepinfo: " stepinfo " stepparts: " stepparts
			       " stepparms: " stepparms " stepcmd: " stepcmd)
		  
		  (if (common:file-exists? (conc stepname ".logpro"))(set! logpro-used #t))
		  
		  ;; call the command using mt_ezstep
		  (set! script (conc "mt_ezstep " stepname " " (if prevstep prevstep "-") " " stepcmd))
		  
		  (debug:print 4 *default-log-port* "script: " script)
		  (rmt:teststep-set-status! run-id test-id stepname "start" "-" #f #f)

		  ;; now launch
		  ;; now launch the script
		  (let ((pid (process-run script)))
		    (let processloop ((i 0))
		      (let-values (((pid-val exit-status exit-code)(process-wait pid #t)))
				  (mutex-lock! run-mutex)
				  (vector-set! exit-info 0 pid)
				  (vector-set! exit-info 1 exit-status)
				  (vector-set! exit-info 2 exit-code)
				  (mutex-unlock! run-mutex)
				  (if (eq? pid-val 0)
				      (begin
					(thread-sleep! 1)
					(processloop (+ i 1))))
				  ))
		    (let ((exinfo (vector-ref exit-info 2))
			  (logfna (if logpro-used (conc stepname ".html") "")))
		      (rmt:teststep-set-status! run-id test-id stepname "end" exinfo #f logfna))
                    
		    (if logpro-used
			(rmt:test-set-log! run-id test-id (conc stepname ".html")))
                    
		    ;; set the test final status
		    (let* ((this-step-status (cond
					      ((and (eq? (vector-ref exit-info 2) 2) logpro-used) 'warn)
					      ((eq? (vector-ref exit-info 2) 0)                   'pass)
					      (else 'fail)))
		    (let* ((this-step-status      (cond
                                                   (logpro-used
                                                    (common:logpro-exit-code->status-sym (vector-ref exit-info 2)))
					           ((eq? (vector-ref exit-info 2) 0)
                                                    'pass)
					           (else
			   (overall-status   (cond
					      ((eq? rollup-status 2) 'warn)
					      ((eq? rollup-status 0) 'pass)
					      (else 'fail)))
                                                    'fail)))
			   (next-status      (cond 
					      ((eq? overall-status 'pass) this-step-status)
					      ((eq? overall-status 'warn)
			   (overall-status-sym    (common:worse-status-sym this-step-status status-sym-so-far))
                           (overall-status-string (status-sym->string overall-status-sym)))
					       (if (eq? this-step-status 'fail) 'fail 'warn))
					      (else 'fail))))
		      (debug:print 4 *default-log-port* "Exit value received: " (vector-ref exit-info 2) " logpro-used: " logpro-used 
				   " this-step-status: " this-step-status " overall-status: " overall-status 
				   " next-status: " next-status " rollup-status: " rollup-status)
				   " this-step-status: " this-step-status " overall-status: " overall-status-sym) 
		      ;;" next-status: " next-status " rollup-status: " rollup-status)
		      (case next-status
			((warn)
			 (set! rollup-status 2)
                      (set! rollup-status-string overall-status-string)
			 ;; NB// test-set-status! does rdb calls under the hood
			 (tests:test-set-status! run-id test-id "RUNNING" "WARN" 
						 (if (eq? this-step-status 'warn) "Logpro warning found" #f)
						 #f))
			((pass)
			 (tests:test-set-status! run-id test-id "RUNNING" "PASS" #f #f))
			(else ;; 'fail
			 (set! rollup-status 1) ;; force fail
			 (tests:test-set-status! run-id test-id "RUNNING" "FAIL" (conc "Failed at step " stepname) #f)
                      (tests:test-set-status! run-id test-id "RUNNING" overall-status-string #f #f)))

                  (if (and
                       (not run-one)
                       (common:steps-can-proceed-given-status-sym overall-status-sym)
                       (not (null? tal)))
                      (loop (car tal)
                            (cdr tal)
                            overall-status-sym
                            stepname
                            ;; #f
                            saw-start-step-name-next)))
                  
			 ))))
		  (if (and (steprun-good? logpro-used (vector-ref exit-info 2))
			   (not (null? tal)))
		      (if (not run-one) ;; if we got here we completed the step, if run-one is true, stop
			  (loop (car tal) (cdr tal) stepname runflag))))
		  ;; (if (and (steprun-good? logpro-used (vector-ref exit-info 2))
		  ;;          (not (null? tal)))
		  ;;     (if (not run-one) ;; if we got here we completed the step, if run-one is true, stop
		  ;;         (loop (car tal) (cdr tal) stepname runflag))))
		(debug:print 4 *default-log-port* "WARNING: a prior step failed, stopping at " ezstep)))
	  
	  ;; Once done with step/steps update the test record
	  ;;
	  (let* ((item-path (db:test-get-item-path testdat)) ;; (item-list->path itemdat))
		 (testinfo  (rmt:get-testinfo-state-status run-id test-id))) ;; refresh the testdat, call it iteminfo in case need prev/curr
	    ;; Am I completed?
	    (if (equal? (db:test-get-state testinfo) "RUNNING") ;; (not (equal? (db:test-get-state testinfo) "COMPLETED"))
		(let ((new-state  (if kill-job "KILLED" "COMPLETED") ;; (if (eq? (vector-ref exit-info 2) 0) ;; exited with "good" status
				  ;; "COMPLETED"
				  ;; (db:test-get-state testinfo)))   ;; else preseve the state as set within the test
				  )
		      (new-status (cond
				   ((not (vector-ref exit-info 1)) "FAIL") ;; job failed to run
				   ((eq? rollup-status 0)
				    ;; if the current status is AUTO the defer to the calculated value (i.e. leave this AUTO)
				    (if (equal? (db:test-get-status testinfo) "AUTO") "AUTO" "PASS"))
				   ((eq? rollup-status 1) "FAIL")
				   ((eq? rollup-status 2)
				    ;; if the current status is AUTO the defer to the calculated value but qualify (i.e. make this AUTO-WARN)
				    (if (equal? (db:test-get-status testinfo) "AUTO") "AUTO-WARN" "WARN"))
				   (else "FAIL")))) ;; (db:test-get-status testinfo)))
                      (new-status rollup-status-string)

		      ;; (new-status (cond ;; bjbarcla -- what is this AUTO business??
		      ;;   	   ((not (vector-ref exit-info 1)) "FAIL") ;; job failed to run
		      ;;   	   ((eq? rollup-status 0)
		      ;;   	    ;; if the current status is AUTO the defer to the calculated value (i.e. leave this AUTO)
		      ;;   	    (if (equal? (db:test-get-status testinfo) "AUTO") "AUTO" "PASS"))
		      ;;   	   ((eq? rollup-status 1) "FAIL")
		      ;;   	   ((eq? rollup-status 2)
		      ;;   	    ;; if the current status is AUTO the defer to the calculated value but qualify (i.e. make this AUTO-WARN)
		      ;;   	    (if (equal? (db:test-get-status testinfo) "AUTO") "AUTO-WARN" "WARN"))
		      ;;   	   (else "FAIL")))

                      ) ;; (db:test-get-status testinfo)))
		  (debug:print-info 2 *default-log-port* "Test NOT logged as COMPLETED, (state=" (db:test-get-state testinfo) "), updating result, rollup-status is " rollup-status)
		  (tests:test-set-status! run-id test-id 
					  new-state
					  new-status
					  (args:get-arg "-m") #f)
		  ;; need to update the top test record if PASS or FAIL and this is a subtest
		  (if (not (equal? item-path ""))
                      (rmt:set-state-status-and-roll-up-items run-id test-name item-path new-state new-status #f))))
	    ;; for automated creation of the rollup html file this is a good place...
	    (if (not (equal? item-path ""))
	      (tests:summarize-items run-id test-id test-name #f)) ;; don't force - just update if no
	    )))
    (pop-directory)
    rollup-status))
    rollup-status-string))

(define (ezsteps:spawn-run-from testdat start-step-name run-one)
  (thread-start! 
   (make-thread
    (lambda ()
      (ezsteps:run-from testdat start-step-name run-one))
    (conc "ezstep run single step " start-step-name " run-one="run-one)))
  )