Megatest

Diff
Login

Differences From Artifact [5bdb7484d4]:

To Artifact [d31d8a3cf1]:


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







-
-
+
















-
-
+

-
+







		  
		  (if (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 "script: " script)
		  ;; DO NOT remote
		  (db:teststep-set-status! #f test-id stepname "start" "-" #f #f work-area: test-run-dir)
		  (rmt:teststep-set-status! #f 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") "")))
		      ;; testing if procedures called in a remote call cause problems (ans: no or so I suspect)
		      (db:teststep-set-status! #f test-id stepname "end" exinfo #f logfna work-area: test-run-dir))
		      (rmt:teststep-set-status! #f test-id stepname "end" exinfo #f logfna))
		    (if logpro-used
			(cdb:test-set-log! *runremote*  test-id (conc stepname ".html")))
			(rmt:test-set-log! 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)