2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
|
((not-started)
(debug:print 0 *default-log-port* "WARNING: postponing removal of " test-fulln " with run-id " run-id " as it has a subrun")
(hash-table-set! backgrounded-remove-status test-fulln 'started)
(hash-table-set! backgrounded-remove-last-visit test-fulln (current-seconds))
(common:send-thunk-to-background-thread
(lambda ()
(let* ((subrun-remove-succeeded
(subrun:remove-subrun run-dir new-test-dat test-name item-path test-state test-fulln toplevel-with-children test)))
(hash-table-set! backgrounded-remove-result test-fulln subrun-remove-succeeded)
(hash-table-set! backgrounded-remove-status test-fulln 'done)))
name: (conc "remove-subrun:"test-fulln))
;; send to back of line, loop
(let ((newtal (append tal (list test))))
(loop (car newtal)(cdr newtal)))
|
|
|
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
|
((not-started)
(debug:print 0 *default-log-port* "WARNING: postponing removal of " test-fulln " with run-id " run-id " as it has a subrun")
(hash-table-set! backgrounded-remove-status test-fulln 'started)
(hash-table-set! backgrounded-remove-last-visit test-fulln (current-seconds))
(common:send-thunk-to-background-thread
(lambda ()
(let* ((subrun-remove-succeeded
(subrun:remove-subrun run-dir keep-records)))
(hash-table-set! backgrounded-remove-result test-fulln subrun-remove-succeeded)
(hash-table-set! backgrounded-remove-status test-fulln 'done)))
name: (conc "remove-subrun:"test-fulln))
;; send to back of line, loop
(let ((newtal (append tal (list test))))
(loop (car newtal)(cdr newtal)))
|
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
|
(let ((subrun-remove-succeeded (hash-table-ref/default backgrounded-remove-result test-fulln 'exception)))
(cond
((eq? subrun-remove-succeeded 'exception)
(let* ((logfile (subrun:get-log-path run-dir "remove")))
(debug:print 0 *default-log-port* "ERROR: removing subrun of of " test-fulln " with run-id " run-id " ; see logfile @ "logfile)))
(subrun-remove-succeeded
(debug:print 0 *default-log-port* "Now removing of " test-fulln " with run-id " run-id " since subrun was removed.")
(runs:remove-test-directory new-test-dat mode))
(else
(let* ((logfile (subrun:get-log-path run-dir "remove")))
(debug:print 0 *default-log-port* "WARNING: removal of subrun failed. Please check "logfile" for details."))))
(if (not (null? tal))
(loop (car tal)(cdr tal)))))
) ; end case rem-status
) ; end let
); end cond has-subrun
(else
(debug:print-info 0 *default-log-port* "test: " test-name " itest-state: " test-state)
(if (member test-state (list "RUNNING" "LAUNCHED" "REMOTEHOSTSTART" "KILLREQ"))
|
|
>
|
|
>
>
>
>
>
|
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
|
(let ((subrun-remove-succeeded (hash-table-ref/default backgrounded-remove-result test-fulln 'exception)))
(cond
((eq? subrun-remove-succeeded 'exception)
(let* ((logfile (subrun:get-log-path run-dir "remove")))
(debug:print 0 *default-log-port* "ERROR: removing subrun of of " test-fulln " with run-id " run-id " ; see logfile @ "logfile)))
(subrun-remove-succeeded
(debug:print 0 *default-log-port* "Now removing of " test-fulln " with run-id " run-id " since subrun was removed.")
;;(runs:remove-test-directory new-test-dat mode) ;; let normal case handle this. it will go thru loop again as non-subrun
)
(else
(let* ((logfile (subrun:get-log-path run-dir "remove")))
(debug:print 0 *default-log-port* "WARNING: removal of subrun failed. Please check "logfile" for details."))))
;;(if (not (null? tal))
;; (loop (car tal)(cdr tal)))
;; send to back of line, loop (will not match has-subrun next time through)
(let ((newtal (append tal (list test))))
(loop (car newtal)(cdr newtal)))
))
) ; end case rem-status
) ; end let
); end cond has-subrun
(else
(debug:print-info 0 *default-log-port* "test: " test-name " itest-state: " test-state)
(if (member test-state (list "RUNNING" "LAUNCHED" "REMOTEHOSTSTART" "KILLREQ"))
|