Megatest

Diff
Login

Differences From Artifact [b511145c8a]:

To Artifact [eb0858fc28]:


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"))