2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
|
(loop (car tal)(append tal (list new-test-dat)))))
(begin
(runs:remove-test-directory new-test-dat mode) ;; 'remove-all)
(if (not (null? tal))
(loop (car tal)(cdr tal)))))))
(rmt:update-run-stats run-id (rmt:get-raw-run-stats run-id)))
((set-state-status)
;; BB TODO - manage has-subrun case
(debug:print-info 2 *default-log-port* "new state " (car state-status) ", new status " (cadr state-status))
(mt:test-set-state-status-by-id run-id (db:test-get-id test) (car state-status)(cadr state-status) #f)
|
>
>
>
>
>
>
|
>
>
>
>
>
>
|
|
|
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
|
(loop (car tal)(append tal (list new-test-dat)))))
(begin
(runs:remove-test-directory new-test-dat mode) ;; 'remove-all)
(if (not (null? tal))
(loop (car tal)(cdr tal)))))))
(rmt:update-run-stats run-id (rmt:get-raw-run-stats run-id)))
((set-state-status)
(let* ((new-state (car state-status))
(new-status (cadr state-status))
(test-id (db:test-get-id test))
(test-run-dir (db:test-get-rundir new-test-dat))
(has-subrun (and (subrun:subrun-test-initialized? test-run-dir)
(not (subrun:subrun-removed? test-run-dir)))))
(when has-subrun
(common:send-thunk-to-background-thread
(lambda ()
(subrun:set-state-status test-run-dir state status new-state-status)
)
)
)
(debug:print-info 2 *default-log-port* "new state " new-state ", new status " new-status )
(mt:test-set-state-status-by-id run-id test-id new-state new-status #f))
(if (not (null? tal))
(loop (car tal)(cdr tal))))
((run-wait)
;; BB TODO - manage has-subrun case
(debug:print-info 2 *default-log-port* "still waiting, " (length tests) " tests still running")
(thread-sleep! 10)
(let ((new-tests (proc-get-tests run-id)))
|
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
|
((save save-remove keep-html)
(if (common:file-exists? ddir)
(debug:print-info 0 *default-log-port* "Estimating disk space usage for " test-fulln ": " (common:get-disk-space-used ddir)))))))
(if (not (null? tal))
(loop (car tal)(cdr tal))))
)))
)
(if worker-thread (thread-join! worker-thread))))))
;; remove the run if zero tests remain
(if (eq? action 'remove-runs)
(let* ((run-id (db:get-value-by-header run header "id")) ;; NB// masks run-id from above?
(remtests (mt:get-tests-for-run run-id #f '("DELETED") '("n/a") not-in: #t)))
(if (null? remtests) ;; no more tests remaining
(let* ((dparts (string-split lasttpath "/"))
(runpath (conc "/" (string-intersperse
|
|
>
|
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
|
((save save-remove keep-html)
(if (common:file-exists? ddir)
(debug:print-info 0 *default-log-port* "Estimating disk space usage for " test-fulln ": " (common:get-disk-space-used ddir)))))))
(if (not (null? tal))
(loop (car tal)(cdr tal))))
)))
)
(if worker-thread (thread-join! worker-thread)))
(common:join-backgrounded-threads))))
;; remove the run if zero tests remain
(if (eq? action 'remove-runs)
(let* ((run-id (db:get-value-by-header run header "id")) ;; NB// masks run-id from above?
(remtests (mt:get-tests-for-run run-id #f '("DELETED") '("n/a") not-in: #t)))
(if (null? remtests) ;; no more tests remaining
(let* ((dparts (string-split lasttpath "/"))
(runpath (conc "/" (string-intersperse
|