1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
|
(debug:print-info 2 "still waiting, " (length tests) " tests still running")
(thread-sleep! 10)
(let ((new-tests (proc-get-tests run-id)))
(if (null? new-tests)
(debug:print-info 1 "Run completed according to zero tests matching provided criteria.")
(loop (car new-tests)(cdr new-tests)))))
((archive)
(if (not toplevel-with-children)
(case (string->symbol (args:get-arg "-archive"))
((save save-remove keep-html)
(debug:print-info 0 "Estimating disk space usage for " test-fulln)
(debug:print-info 0 " " (common:get-disk-space-used (conc run-dir "/"))))))
(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)
|
|
>
|
|
>
|
<
|
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
|
(debug:print-info 2 "still waiting, " (length tests) " tests still running")
(thread-sleep! 10)
(let ((new-tests (proc-get-tests run-id)))
(if (null? new-tests)
(debug:print-info 1 "Run completed according to zero tests matching provided criteria.")
(loop (car new-tests)(cdr new-tests)))))
((archive)
(if (and run-dir (not toplevel-with-children))
(let ((ddir (conc run-dir "/")))
(case (string->symbol (args:get-arg "-archive"))
((save save-remove keep-html)
(if (file-exists? ddir)
(debug:print-info 0 "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)
|