214
215
216
217
218
219
220
221
222
223
224
225
226
227
|
(all-tests-registry #f) ;; (tests:get-all)) ;; (tests:get-valid-tests (make-hash-table) test-search-path)) ;; all valid tests to check waiton names
(all-test-names #f) ;; (hash-table-keys all-tests-registry))
(test-names #f) ;; (tests:filter-test-names all-test-names test-patts))
(required-tests #f) ;;(lset-intersection equal? (string-split test-patts ",") test-names))) ;; test-names)) ;; Added test-names as initial for required-tests but that failed to work
(task-key (conc (hash-table->alist flags) " " (get-host-name) " " (current-process-id)))
(tdbdat (tasks:open-db)))
(set-signal-handler! signal/int
(lambda (signum)
(signal-mask! signum)
(print "Received signal " signum ", cleaning up before exit. Please wait...")
(let ((tdbdat (tasks:open-db)))
(tasks:set-state-given-param-key (db:delay-if-busy tdbdat) task-key "killed"))
(print "Killed by signal " signum ". Exiting")
|
>
>
|
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
|
(all-tests-registry #f) ;; (tests:get-all)) ;; (tests:get-valid-tests (make-hash-table) test-search-path)) ;; all valid tests to check waiton names
(all-test-names #f) ;; (hash-table-keys all-tests-registry))
(test-names #f) ;; (tests:filter-test-names all-test-names test-patts))
(required-tests #f) ;;(lset-intersection equal? (string-split test-patts ",") test-names))) ;; test-names)) ;; Added test-names as initial for required-tests but that failed to work
(task-key (conc (hash-table->alist flags) " " (get-host-name) " " (current-process-id)))
(tdbdat (tasks:open-db)))
(tasks:start-and-wait-for-server tdbdat run-id 10)
(set-signal-handler! signal/int
(lambda (signum)
(signal-mask! signum)
(print "Received signal " signum ", cleaning up before exit. Please wait...")
(let ((tdbdat (tasks:open-db)))
(tasks:set-state-given-param-key (db:delay-if-busy tdbdat) task-key "killed"))
(print "Killed by signal " signum ". Exiting")
|
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
|
'()))
(lasttpath "/does/not/exist/I/hope"))
(debug:print-info 4 "runs:operate-on run=" run ", header=" header)
(if (not (null? tests))
(begin
(case action
((remove-runs)
;; seek and kill in flight -runtests with % as testpatt here
(if (equal? testpatt "%")
(tasks:kill-runner (db:delay-if-busy tdbdat) target run-name)
(debug:print 0 "not attempting to kill any run launcher processes as testpatt is " testpatt))
(debug:print 1 "Removing tests for run: " runkey " " (db:get-value-by-header run header "runname")))
((set-state-status)
(debug:print 1 "Modifying state and staus for tests for run: " runkey " " (db:get-value-by-header run header "runname")))
((print-run)
(debug:print 1 "Printing info for run " runkey ", run=" run ", tests=" tests ", header=" header)
action)
((run-wait)
(debug:print 1 "Waiting for run " runkey ", run=" runnamepatt " to complete"))
(else
|
>
>
|
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
|
'()))
(lasttpath "/does/not/exist/I/hope"))
(debug:print-info 4 "runs:operate-on run=" run ", header=" header)
(if (not (null? tests))
(begin
(case action
((remove-runs)
(tasks:start-and-wait-for-server tdbdat run-id 10)
;; seek and kill in flight -runtests with % as testpatt here
(if (equal? testpatt "%")
(tasks:kill-runner (db:delay-if-busy tdbdat) target run-name)
(debug:print 0 "not attempting to kill any run launcher processes as testpatt is " testpatt))
(debug:print 1 "Removing tests for run: " runkey " " (db:get-value-by-header run header "runname")))
((set-state-status)
(tasks:start-and-wait-for-server tdbdat run-id 10)
(debug:print 1 "Modifying state and staus for tests for run: " runkey " " (db:get-value-by-header run header "runname")))
((print-run)
(debug:print 1 "Printing info for run " runkey ", run=" run ", tests=" tests ", header=" header)
action)
((run-wait)
(debug:print 1 "Waiting for run " runkey ", run=" runnamepatt " to complete"))
(else
|