223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
|
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
|
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
|
(tdbdat (tasks:open-db)))
(if (tasks:need-server run-id)(tasks:start-and-wait-for-server tdbdat run-id 10))
(set-signal-handler! signal/int
(lambda (signum)
;; (signal-mask! signum) ;; to mask or not? seems to cause issues in exiting
(set! *time-to-exit* #t)
(print "Received signal " signum ", cleaning up before exit. Please wait...")
(let ((th1 (make-thread (lambda ()
(let ((tdbdat (tasks:open-db)))
(rmt:tasks-set-state-given-param-key task-key "killed"))
(print "Killed by signal " signum ". Exiting")
(exit)))
(let ((tdbdat (tasks:open-db)))
(rmt:tasks-set-state-given-param-key task-key "killed"))
(print "Killed by signal " signum ". Exiting")
(exit))))
(th2 (make-thread (lambda ()
(thread-sleep! 3)
(debug:print 0 "Done")
(exit 4)))))
(thread-start! th2)
(thread-start! th1)
(thread-join! th2))))
;; register this run in monitor.db
(rmt:tasks-add "run-tests" user target runname test-patts task-key) ;; params)
(rmt:tasks-set-state-given-param-key task-key "running")
(runs:set-megatest-env-vars run-id inkeys: keys inrunname: runname) ;; these may be needed by the launching process
(if (file-exists? runconfigf)
(setup-env-defaults runconfigf run-id *already-seen-runconfig-info* keyvals target)
|