Megatest

Check-in [44b91abd1f]
Login
Overview
Comment:Merged ezsteps-tcp updates. Passes all tests
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65 | v1.6530
Files: files | file ages | folders
SHA1: 44b91abd1f8477a45c7e257a51f5053e1fa207e1
User & Date: mrwellan on 2019-06-12 13:17:25
Other Links: branch diff | manifest | tags
Context
2019-06-13
15:48
Updated megatest version check-in: 2cf2b7b144 user: jmoon18 tags: v1.65
2019-06-12
13:17
Merged ezsteps-tcp updates. Passes all tests check-in: 44b91abd1f user: mrwellan tags: v1.65, v1.6530
10:41
cleared steps matrix on rerun and clean-run-execute Closed-Leaf check-in: 1b5d412efb user: bjbarcla tags: v1.65-ezsteps-tcp
2019-06-11
16:31
Added proper use of testpatt to rerun-clean and rerun-all check-in: ca9da88e3e user: mrwellan tags: v1.65
Changes

Modified api.scm from [1958ec5960] to [e7f077996e].

110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
    delete-run
    lock/unlock-run
    update-run-event_time
    mark-incomplete
    set-state-status-and-roll-up-run
    ;; STEPS
    teststep-set-status!

    ;; TEST DATA
    test-data-rollup
    csv->test-data

    ;; MISC
    sync-inmem->db








|







110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
    delete-run
    lock/unlock-run
    update-run-event_time
    mark-incomplete
    set-state-status-and-roll-up-run
    ;; STEPS
    teststep-set-status!
    delete-steps-for-test
    ;; TEST DATA
    test-data-rollup
    csv->test-data

    ;; MISC
    sync-inmem->db

214
215
216
217
218
219
220

221
222
223
224
225
226
227
228
                   ((update-run-event_time)        (apply db:update-run-event_time dbstruct params))
                   ((update-run-stats)             (apply db:update-run-stats dbstruct params))
                   ((set-var)                      (apply db:set-var dbstruct params))
                   ((del-var)                      (apply db:del-var dbstruct params))

                   ;; STEPS
                   ((teststep-set-status!)         (apply db:teststep-set-status! dbstruct params))


                   ;; TEST DATA
                   ((test-data-rollup)             (apply db:test-data-rollup dbstruct params))
                   ((csv->test-data)               (apply db:csv->test-data dbstruct params))

                   ;; MISC
                   ((sync-inmem->db)               (let ((run-id (car params)))
                                                     (db:sync-touched dbstruct run-id force-sync: #t)))







>
|







214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
                   ((update-run-event_time)        (apply db:update-run-event_time dbstruct params))
                   ((update-run-stats)             (apply db:update-run-stats dbstruct params))
                   ((set-var)                      (apply db:set-var dbstruct params))
                   ((del-var)                      (apply db:del-var dbstruct params))

                   ;; STEPS
                   ((teststep-set-status!)         (apply db:teststep-set-status! dbstruct params))
                   ((delete-steps-for-test!)        (apply db:delete-steps-for-test! dbstruct params))
                   
                   ;; TEST DATA
                   ((test-data-rollup)             (apply db:test-data-rollup dbstruct params))
                   ((csv->test-data)               (apply db:csv->test-data dbstruct params))

                   ;; MISC
                   ((sync-inmem->db)               (let ((run-id (car params)))
                                                     (db:sync-touched dbstruct run-id force-sync: #t)))

Modified common.scm from [18d6f81858] to [424526ac90].

223
224
225
226
227
228
229








230


231











232




233













234
235
236
237
238
239
240
           (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*))












































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







>
>
>
>
>
>
>
>

>
>

>
>
>
>
>
>
>
>
>
>
>

>
>
>
>

>
>
>
>
>
>
>
>
>
>
>
>
>







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 skip 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 status-sym
      ((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
                                         (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))))
					   (hash-table-set! widgets "StepsMatrix" proc)
					   (proc testdat))
					 steps-matrix)
				       ;; populate the Test Data panel
				       (iup:frame
					#:title "Test Data"
					(let ((test-data







|







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 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 db.scm from [b676e109a8] to [7a0a4d3aa1].

3321
3322
3323
3324
3325
3326
3327
3328















3329
3330
3331
3332
3333
3334
3335
   (lambda (db)
     (sqlite3:execute 
      db
      "INSERT OR REPLACE into test_steps (test_id,stepname,state,status,event_time,comment,logfile) VALUES(?,?,?,?,?,?,?);"
      test-id teststep-name state-in status-in (current-seconds)
      (if comment comment "")
      (if logfile logfile "")))))
   















;; db-get-test-steps-for-run
(define (db:get-steps-for-test dbstruct run-id test-id)
  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (db)







|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
   (lambda (db)
     (sqlite3:execute 
      db
      "INSERT OR REPLACE into test_steps (test_id,stepname,state,status,event_time,comment,logfile) VALUES(?,?,?,?,?,?,?);"
      test-id teststep-name state-in status-in (current-seconds)
      (if comment comment "")
      (if logfile logfile "")))))



(define (db:delete-steps-for-test! dbstruct run-id test-id)
  ;; TODO: figure out why status is the key field rather than state (note:  CONSTRAINT test_steps_constraint UNIQUE (test_id,stepname,state) )
  (db:with-db
   dbstruct
   run-id
   #t
   (lambda (db)
     (sqlite3:execute 
      db
      "UPDATE test_steps set status='DELETED' where test_id=?" ;;  and run_id=? !! - run_id not in table (bummer) TODO: get run_id into schema for test_steps
      test-id))))


;; db-get-test-steps-for-run
(define (db:get-steps-for-test dbstruct run-id test-id)
  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (db)

Modified dcommon.scm from [c88297a7d4] to [83db082a27].

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







|
|
|
|
>
>
>
>
>
|
|

>
>
|










>


>
|







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
1300
1301
						 (hash-table-keys tests-info)))))))
     canvas-obj)))

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

(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)
	(begin
          (iup:attribute-set! steps-matrix "CLEARATTRIB" "CONTENTS")
          (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)))
		 (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 [b166d59095].

36
37
38
39
40
41
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


;;(rmt:get-test-info-by-id run-id test-id) -> testdat



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


	 (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


    (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))
	(message-window "ERROR: You can only re-run steps defined via ezsteps")
	(begin
	  (let loop ((ezstep   (car ezstepslst))
		     (tal      (cdr ezstepslst))

		     (prevstep #f)
		     (runflag  #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!!!
		       (logpro-used #f))


		  ;; Skip steps until hit 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))))




		  (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
		  (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)))
			   (overall-status   (cond
					      ((eq? rollup-status 2) 'warn)
					      ((eq? rollup-status 0) 'pass)
					      (else 'fail)))
			   (next-status      (cond 
					      ((eq? overall-status 'pass) this-step-status)
					      ((eq? overall-status 'warn)
					       (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)
		      (case next-status
			((warn)
			 (set! rollup-status 2)
			 ;; 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)
			 ))))
		  (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)))
		  (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))

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







>
>
|





>
>

|
|
|
>
>

>
>

|
|





>




|




>
|
|

|
>
|
|
|
|
|
<
|
>
|
<
|
|
>
|
>
>
>
|
|
>
>
|
|
>
>
>
|
|
<
<
<
<
<
<
|
|
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
|
|
>
|
|
>
|
|
>
|
<
<
<
|
<
|
|
<
<
|
|
|
<
<
|
<
<
<
<
<
<
<
|
|
|
|
>
>
|
<
|
>
>
>












|
<
<
<
<
<
<
<
<
|


|
|


|





|
|







36
37
38
39
40
41
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


;;(rmt:get-test-info-by-id run-id test-id) -> testdat



(define (ezsteps:run-from testdat start-step-name run-one)
  ;;# TODO - recapture item variables, debug repeated step eval; regen logpro from test
  (let* ((do-update-test-state-status #f)
         (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)
         (rollup-status-sym #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))
         (orig-test-state (db:test-get-state   testdat))
         (orig-test-status (db:test-get-status 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 (not (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))
	(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)
		     ;;(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
                       (logpro-used (common:file-exists? (conc test-run-dir "/" 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 '"test-run-dir"' '"stepname"' '"stepcmd"'")) ;; call the command using mt_ezstep

                       (saw-start-step-name-next (or saw-start-step-name (equal? stepname start-step-name)))
                       (proceed-with-this-step
                        (or (not start-step-name)

                            (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))))
                       )
                  (set! do-update-test-state-status (and proceed-with-this-step (null? tal)))
                  ;;(BB> "stepname="stepname" proceed-with-this-step="proceed-with-this-step " do-update-test-state-status="do-update-test-state-status " orig-test-state="orig-test-state" orig-test-status="orig-test-status)
                  (cond
                   ((and (not proceed-with-this-step) (null? tal))
                    'done)
                   ((not proceed-with-this-step)
                      (loop (car tal)
                            (cdr tal)
                            status-sym-so-far
                            saw-start-step-name-next))
                   (else
		    (debug:print 4 *default-log-port* "ezsteps:\n stepname: " stepname " stepinfo: " stepinfo " stepparts: " stepparts
			         " stepparms: " stepparms " stepcmd: " stepcmd)






		    (debug:print 4 *default-log-port* "script: " script)
		    (rmt:teststep-set-status! run-id test-id stepname "start" "-" #f #f)

		    ;; 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
                                                     (logpro-used
                                                      (common:logpro-exit-code->status-sym (vector-ref exit-info 2)))
					             ((eq? (vector-ref exit-info 2) 0)
                                                      'pass)
					             (else



                                                      'fail)))

			     (overall-status-sym    (common:worse-status-sym this-step-status status-sym-so-far))
                             (overall-status-string (status-sym->string overall-status-sym)))


		        (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-sym) 
		        ;;" next-status: " next-status " rollup-status: " rollup-status)


                        (set! rollup-status-string overall-status-string)







                        (set! rollup-status-sym overall-status-sym)
                        (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 rollup-status-sym)
                         (not (null? tal)))

                        (loop (car tal)
                              (cdr tal)
                              rollup-status-sym
                              saw-start-step-name-next)))))
		(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 rollup-status-string)








                      ) ;; (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 
					  (if do-update-test-state-status new-state orig-test-state)
					  (if do-update-test-state-status new-status orig-test-status)
					  (args:get-arg "-m") #f)
		  ;; need to update the top test record if PASS or FAIL and this is a subtest
		  (if (and (not (equal? item-path "")) do-update-test-state-status)
                      (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-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)))

Modified launch.scm from [bd83b25556] to [ddbd5933a3].

83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
	  ;;  )
	  (cond
	   ((equal? status "PASS") "PASS") ;; skip the message part if status is pass
	   (status (conc (configf:lookup dat "final" "exit-status") ": " (if msg msg "no message")))
	   (else #f)))
	#f)))

(define (launch:runstep ezstep run-id test-id exit-info m tal testconfig)
  (let* ((stepname       (car ezstep))  ;; do stuff to run the step
	 (stepinfo       (cadr ezstep))
	;; (let ((info (cadr ezstep)))
	;; 		   (if (proc? info) "" info)))
	;; (stepproc       (let ((info (cadr ezstep)))
	;; 		   (if (proc? info) info #f)))
	 (stepparts      (string-match (regexp "^(\\{([^\\}\\{]*)\\}\\s*|)(.*)$") stepinfo))







|







83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
	  ;;  )
	  (cond
	   ((equal? status "PASS") "PASS") ;; skip the message part if status is pass
	   (status (conc (configf:lookup dat "final" "exit-status") ": " (if msg msg "no message")))
	   (else #f)))
	#f)))

(define (launch:runstep ezstep run-id test-id exit-info m tal testconfig) ;;; TODO: deprecate me in favor of ezsteps.scm
  (let* ((stepname       (car ezstep))  ;; do stuff to run the step
	 (stepinfo       (cadr ezstep))
	;; (let ((info (cadr ezstep)))
	;; 		   (if (proc? info) "" info)))
	;; (stepproc       (let ((info (cadr ezstep)))
	;; 		   (if (proc? info) info #f)))
	 (stepparts      (string-match (regexp "^(\\{([^\\}\\{]*)\\}\\s*|)(.*)$") stepinfo))
643
644
645
646
647
648
649
650



651
652
653
654
655
656
657
	      ;; (tests:test-force-state-status! run-id test-id "REMOTEHOSTSTART" "n/a")
              (rmt:general-call 'set-test-start-time #f test-id)
	      (rmt:test-set-state-status run-id test-id "REMOTEHOSTSTART" "n/a" #f)
	      )
	     (else ;; (member (db:test-get-state test-info) '("REMOVING" "REMOTEHOSTSTART" "RUNNING" "KILLREQ"))
	      (debug:print-error 0 *default-log-port* "test state is " (db:test-get-state test-info) ", cannot proceed")
	      (exit))))
	  



	  (debug:print 2 *default-log-port* "Executing " test-name " (id: " test-id ") on " (get-host-name))
	  (set! keys       (rmt:get-keys))
	  ;; (runs:set-megatest-env-vars run-id inkeys: keys inkeyvals: keyvals) ;; these may be needed by the launching process
	  ;; one of these is defunct/redundant ...
	  (if (not (launch:setup force-reread: #t))
	      (begin
		(debug:print 0 *default-log-port* "Failed to setup, exiting") 







|
>
>
>







643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
	      ;; (tests:test-force-state-status! run-id test-id "REMOTEHOSTSTART" "n/a")
              (rmt:general-call 'set-test-start-time #f test-id)
	      (rmt:test-set-state-status run-id test-id "REMOTEHOSTSTART" "n/a" #f)
	      )
	     (else ;; (member (db:test-get-state test-info) '("REMOVING" "REMOTEHOSTSTART" "RUNNING" "KILLREQ"))
	      (debug:print-error 0 *default-log-port* "test state is " (db:test-get-state test-info) ", cannot proceed")
	      (exit))))

          ;; cleanup prior execution's steps
          (rmt:delete-steps-for-test! run-id test-id)
          
	  (debug:print 2 *default-log-port* "Executing " test-name " (id: " test-id ") on " (get-host-name))
	  (set! keys       (rmt:get-keys))
	  ;; (runs:set-megatest-env-vars run-id inkeys: keys inkeyvals: keyvals) ;; these may be needed by the launching process
	  ;; one of these is defunct/redundant ...
	  (if (not (launch:setup force-reread: #t))
	      (begin
		(debug:print 0 *default-log-port* "Failed to setup, exiting") 

Modified rmt.scm from [4dc97a8297] to [8caa3939b3].

859
860
861
862
863
864
865




866
867
868
869
870
871
872
  (let* ((state     (items:check-valid-items "state" state-in))
	 (status    (items:check-valid-items "status" status-in)))
    (if (or (not state)(not status))
	(debug:print 3 *default-log-port* "WARNING: Invalid " (if status "status" "state")
		     " value \"" (if status state-in status-in) "\", update your validvalues section in megatest.config"))
    (rmt:send-receive 'teststep-set-status! run-id (list run-id test-id teststep-name state-in status-in comment logfile))))





(define (rmt:get-steps-for-test run-id test-id)
  (rmt:send-receive 'get-steps-for-test run-id (list run-id test-id)))

(define (rmt:get-steps-info-by-id test-step-id)
  (rmt:send-receive 'get-steps-info-by-id #f (list test-step-id)))

;;======================================================================







>
>
>
>







859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
  (let* ((state     (items:check-valid-items "state" state-in))
	 (status    (items:check-valid-items "status" status-in)))
    (if (or (not state)(not status))
	(debug:print 3 *default-log-port* "WARNING: Invalid " (if status "status" "state")
		     " value \"" (if status state-in status-in) "\", update your validvalues section in megatest.config"))
    (rmt:send-receive 'teststep-set-status! run-id (list run-id test-id teststep-name state-in status-in comment logfile))))


(define (rmt:delete-steps-for-test! run-id test-id)
  (rmt:send-receive 'delete-steps-for-test! run-id (list run-id test-id)))

(define (rmt:get-steps-for-test run-id test-id)
  (rmt:send-receive 'get-steps-for-test run-id (list run-id test-id)))

(define (rmt:get-steps-info-by-id test-step-id)
  (rmt:send-receive 'get-steps-info-by-id #f (list test-step-id)))

;;======================================================================

Modified utils/mt_ezstep from [4f4602fc1b] to [c3b3a9d270].

13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
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
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

usage="mt_ezstep stepname prevstepname command [args ...]"

if [[ "$MT_CMDINFO" == "" ]];then
  if [[ -e megatest.sh ]];then
    source megatest.sh
  else
    echo "ERROR: $0 should be run within a megatest test environment"
    echo "Usage: $usage"
    exit
  fi
fi

# Purpose: This is for the [ezsteps] secton in your testconfig file.
#   DO NOT USE IN YOUR SCRIPTS!
#
# Call like this:
# mt_ezstep stepname prevstepname command ....
# 
if [[ "x$1" == "x" ]];then
  echo "Usage: $usage"
  exit
fi

# Since the user may not have . on the path and since we are likely to want to 
# run test scripts in the current directory add the current dir to the path
export PATH=$PATH:$PWD

stepname=$1;shift
prevstepname=$1;shift

command=$*

allstatus=99
runstatus=99
logpropstatus=99

# prev_env=".ezsteps/${prevstepname}.sh"
# echo "prev_env=$prev_env"
# if [[ -e "${prev_env}" ]];then
#     source $prev_env
# fi

# source the environment from the previous step if it exists













# if a logpro file exists then use it otherwise just run the command, nb// was using 2>&1
if [[ -e ${stepname}.logpro ]];then
   # could do:
   $command 2>&1| tee ${stepname}.log | logpro ${stepname}.logpro ${stepname}.html &> /dev/null
   logprostatus=$?
   # $command 2>&1| logpro ${stepname}.logpro ${stepname}.html &> ${stepname}.log 
   # allstatus=(${PIPESTATUS[0]} ${PIPESTATUS[1]}) 
   allstatus=(${PIPESTATUS[0]} ${PIPESTATUS[1]})
   runstatus=${allstatus[0]}
   # logprostatus=${allstatus[1]}
else
   $command &> ${stepname}.log
   runstatus=$?

   logprostatus=$runstatus
fi

# If the test exits with non-zero, we will record FAIL even if logpro
# says it is a PASS

if [[ $runstatus -ne 0 ]]; then
    exitstatus=$runstatus
elif [[ $logprostatus -eq 0 ]]; then
    exitstatus=$logprostatus
elif [[ $logprostatus -eq 2 ]]; then
    exitstatus=2
elif [[ $logprostatus -eq 1 ]]; then
    exitstatus=1

else 

    exitstatus=0
fi

# $MT_MEGATEST -env2file .ezsteps/${stepname}
exit $exitstatus







|

<
<
<
<
<
<
<
<
<















|

|


<











>
>
>
>
>
>
>
>
>
>

>
>


<
<
<
<
<
<
<
<
<
|

>
|
<

<
<
<
|
<
<
|
<
|
<
|
>
|
>
|


<

13
14
15
16
17
18
19
20
21









22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41

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
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

usage="mt_ezstep stepname command [args ...]"











# Purpose: This is for the [ezsteps] secton in your testconfig file.
#   DO NOT USE IN YOUR SCRIPTS!
#
# Call like this:
# mt_ezstep stepname prevstepname command ....
# 
if [[ "x$1" == "x" ]];then
  echo "Usage: $usage"
  exit
fi

# Since the user may not have . on the path and since we are likely to want to 
# run test scripts in the current directory add the current dir to the path
export PATH=$PATH:$PWD
testrundir=$1; shift
stepname=$1;shift


command=$*

allstatus=99
runstatus=99
logpropstatus=99

# prev_env=".ezsteps/${prevstepname}.sh"
# echo "prev_env=$prev_env"
# if [[ -e "${prev_env}" ]];then
#     source $prev_env
# fi

# source the environment from the previous step if it exists
cd $testrundir
#if [[ "$MT_CMDINFO" == "" ]];then
  if [[ -e megatest.sh ]];then
    source megatest.sh
  else
    echo "ERROR: $0 should be run within a megatest test environment"
    echo "Usage: $usage"
    exit
  fi
#fi



# if a logpro file exists then use it otherwise just run the command, nb// was using 2>&1
if [[ -e ${stepname}.logpro ]];then









   eval $command 2>&1 ${stepname}.log
   runstatus=$?
   logpro ${stepname}.logpro ${stepname}.html &> /dev/null < ${stepname}.log
   logprostatus=$?





   if [[ $runstatus == 0 ]]; then


       exitstatus=$logprostatus

   else

       exitstatus=$runstatus
   fi
else
   eval $command &> ${stepname}.log
   exitstatus=$?
fi


exit $exitstatus