31
32
33
34
35
36
37
38
39
40
41
42
43
44
|
(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))
(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 (file-exists? test-run-dir)
(push-directory test-run-dir)
(if (> count 0)
(begin
|
>
|
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
(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 (file-exists? test-run-dir)
(push-directory test-run-dir)
(if (> count 0)
(begin
|
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
|
(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)
(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") "")))
(rmt:teststep-set-status! #f test-id stepname "end" exinfo #f logfna))
(if logpro-used
(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)))
|
|
|
|
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
|
(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)
(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! 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)))
|
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
(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 "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 (cdb:get-test-info-by-id *runremote* 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
|
|
|
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
(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 "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-by-id 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
|