Megatest

Diff
Login

Differences From Artifact [1748d73246]:

To Artifact [a165297934]:


166
167
168
169
170
171
172
173
174
175
176





177
178
179

180
181
182
183
184
185
186
166
167
168
169
170
171
172




173
174
175
176
177
178
179

180
181
182
183
184
185
186
187







-
-
-
-
+
+
+
+
+


-
+







							(logpro-used #f))
						   ;; NB// can safely assume we are in test-area directory
						   (debug:print 4 "ezsteps:\n stepname: " stepname " stepinfo: " stepinfo " stepparts: " stepparts
								" stepparms: " stepparms " stepcmd: " stepcmd)
						   
						   (if (file-exists? (conc stepname ".logpro"))(set! logpro-used #t))

						   ;; first source the previous environment
						   (let ((prev-env (conc ".ezsteps/" prevstep (if (string-search (regexp "csh") (get-environment-variable "SHELL")) ".csh" ".sh"))))
						     (if (and prevstep (file-exists? prev-env))
							 (set! script (conc script "source " prev-env))))
						   ;; ;; first source the previous environment
						   ;; (let ((prev-env (conc ".ezsteps/" prevstep (if (string-search (regexp "csh") 
						   ;;      							 (get-environment-variable "SHELL")) ".csh" ".sh"))))
						   ;;   (if (and prevstep (file-exists? prev-env))
						   ;;       (set! script (conc script "source " prev-env))))
						   
						   ;; call the command using mt_ezstep
						   (set! script (conc script ";mt_ezstep " stepname " " stepcmd))
						   (set! script (conc "mt_ezstep " stepname " " (if prevstep prevstep "-") " " stepcmd))

						   (debug:print 4 "script: " script)

						   (teststep-set-status! db run-id test-name stepname "start" "-" itemdat #f #f)
						   ;; now launch
						   (let ((pid (process-run script)))
						     (let processloop ((i 0))
214
215
216
217
218
219
220
221


222
223
224
225


226
227
228



229
230
231
232
233
234
235
215
216
217
218
219
220
221

222
223
224
225
226

227
228
229
230

231
232
233
234
235
236
237
238
239
240







-
+
+



-
+
+


-
+
+
+







									       (else 'fail))))
						       (debug:print 4 "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)
							  (test-set-status! db run-id test-name "COMPLETED" "WARN" itemdat 
							  ;; (test-set-status! db run-id test-name "COMPLETED" "WARN" itemdat 
							  (test-set-status! db run-id test-name "RUNNING" "WARN" itemdat 
									    (if (eq? this-step-status 'warn) "Logpro warning found" #f)
									    #f))
							 ((pass)
							  (test-set-status! db run-id test-name "COMPLETED" "PASS" itemdat #f #f))
							  ;; (test-set-status! db run-id test-name "COMPLETED" "PASS" itemdat #f #f))
							  (test-set-status! db run-id test-name "RUNNING" "PASS" itemdat #f #f))
							 (else ;; 'fail
							  (set! rollup-status 1) ;; force fail
							  (test-set-status! db run-id test-name "COMPLETED" "FAIL" itemdat (conc "Failed at step " stepname) #f)))))
							  ;; (test-set-status! db run-id test-name "COMPLETED" "FAIL" itemdat (conc "Failed at step " stepname) #f)
							  (test-set-status! db run-id test-name "RUNNING" "FAIL" itemdat (conc "Failed at step " stepname) #f)
							  ))))
						   (if (and (steprun-good? logpro-used (vector-ref exit-info 2))
							    (not (null? tal)))
						       (loop (car tal) (cdr tal) stepname)))
					     (debug:print 4 "WARNING: a prior step failed, stopping at " ezstep))))))))
		 (monitorjob   (lambda ()
				 (let* ((start-seconds (current-seconds))
					(calc-minutes  (lambda ()
372
373
374
375
376
377
378
379
380
381







382
383
384
385
386
387
388
389
390
391
392
393


394
395
396


397
398
399
400
401
402
403
377
378
379
380
381
382
383



384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400


401
402
403


404
405
406
407
408
409
410
411
412







-
-
-
+
+
+
+
+
+
+










-
-
+
+

-
-
+
+







					   (db:get-header run-info)
					   "runname"))
	 (key-vals (get-key-vals db run-id))
	 (key-str  (string-intersperse key-vals "/"))
	 (dfullp   (conc disk-path "/" key-str "/" runname "/" testname
			 item-path))
	 (toptest-path (conc disk-path "/" key-str "/" runname "/" testname))
	 (runsdir  (config-lookup *configdat* "setup" "runsdir"))
	 (lnkpath  (conc (if runsdir runsdir (conc *toppath* "/runs"))
			 "/" key-str "/" runname item-path)))
	 (linktree  (let ((rd (config-lookup *configdat* "setup" "linktree")))
		     (if rd rd (conc *toppath* "/runs"))))
	 (lnkpath  (conc linktree "/" key-str "/" runname item-path)))
    (if (not (file-exists? linktree))
	(begin
	  (debug:print 0 "WARNING: linktree did not exist! Creating it now at " linktree)
	  (system (conc "mkdir -p " linktree))))
    ;; since this is an iterated test this is as good a place as any to
    ;; update the toptest record with its location rundir
    (if (not (equal? item-path ""))
	(db:test-set-rundir! db run-id testname "" toptest-path))
    (debug:print 2 "Setting up test run area")
    (debug:print 2 " - creating run area in " dfullp)
    (system  (conc "mkdir -p " dfullp))
    (debug:print 2 " - creating link from " dfullp "/" testname " to " lnkpath)
    (system  (conc "mkdir -p " lnkpath))

;; I suspect this section was deleting test directories under some 
;; wierd sitations
    ;; I suspect this section was deleting test directories under some 
    ;; wierd sitations? This doesn't make sense - reenabling the rm -f 

;;    (if (file-exists? (conc lnkpath "/" testname))
;;	(system (conc "rm -f " lnkpath "/" testname)))
    (if (file-exists? (conc lnkpath "/" testname))
    	(system (conc "rm -f " lnkpath "/" testname)))
    (system  (conc "ln -sf " dfullp " " lnkpath "/" testname))
    (if (directory? dfullp)
	(begin
	  (let* ((cmd    (conc "rsync -av" (if (> *verbosity* 1) "" "q") " " test-path "/ " dfullp "/"))
		 (status (system cmd)))
	    (if (not (eq? status 0))
		(debug:print 2 "ERROR: problem with running \"" cmd "\"")))