130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
(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? (vector-ref exit-info 3) 2) 'warn) ;; rollup-status
((eq? (vector-ref exit-info 3) 0) 'pass)
(else 'fail)))
(next-status (cond
((eq? overall-status 'pass) this-step-status)
|
>
|
|
>
>
|
|
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
(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* ((process-exit-status (vector-ref exit-info 2))
(this-step-status (cond
((and (eq? process-exit-status 2) logpro-used) 'warn)
((and (eq? process-exit-status 3) logpro-used) 'check)
((and (eq? process-exit-status 4) logpro-used) 'abort)
((eq? (vector-ref exit-info 2) 0) 'pass)
(else 'fail)))
(overall-status (cond
((eq? (vector-ref exit-info 3) 2) 'warn) ;; rollup-status
((eq? (vector-ref exit-info 3) 0) 'pass)
(else 'fail)))
(next-status (cond
((eq? overall-status 'pass) this-step-status)
|
159
160
161
162
163
164
165
166
167
168
169
170
171
172
|
(case next-status
((warn)
(vector-set! exit-info 3 2) ;; rollup-status
;; NB// test-set-status! does rdb calls under the hood
(tests:test-set-status! run-id test-id next-state "WARN"
(if (eq? this-step-status 'warn) "Logpro warning found" #f)
#f))
((pass)
(tests:test-set-status! run-id test-id next-state "PASS" #f #f))
(else ;; 'fail
(vector-set! exit-info 3 1) ;; force fail, this used to be next-state but that doesn't make sense. should always be "COMPLETED"
(tests:test-set-status! run-id test-id "COMPLETED" "FAIL" (conc "Failed at step " stepname) #f)
)))
logpro-used))
|
>
>
>
>
>
>
>
>
>
>
>
>
|
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
|
(case next-status
((warn)
(vector-set! exit-info 3 2) ;; rollup-status
;; NB// test-set-status! does rdb calls under the hood
(tests:test-set-status! run-id test-id next-state "WARN"
(if (eq? this-step-status 'warn) "Logpro warning found" #f)
#f))
((check)
(vector-set! exit-info 3 3) ;; rollup-status
;; NB// test-set-status! does rdb calls under the hood
(tests:test-set-status! run-id test-id next-state "CHECK"
(if (eq? this-step-status 'check) "Logpro check found" #f)
#f))
((abort)
(vector-set! exit-info 3 4) ;; rollup-status
;; NB// test-set-status! does rdb calls under the hood
(tests:test-set-status! run-id test-id next-state "ABORT"
(if (eq? this-step-status 'abort) "Logpro abort found" #f)
#f))
((pass)
(tests:test-set-status! run-id test-id next-state "PASS" #f #f))
(else ;; 'fail
(vector-set! exit-info 3 1) ;; force fail, this used to be next-state but that doesn't make sense. should always be "COMPLETED"
(tests:test-set-status! run-id test-id "COMPLETED" "FAIL" (conc "Failed at step " stepname) #f)
)))
logpro-used))
|