571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
|
(set! tconfigreg (tests:get-all)) ;; mapping of testname => test source path
(let ((sighand (lambda (signum)
;; (signal-mask! signum) ;; to mask or not? seems to cause issues in exiting
(if (eq? signum signal/stop)
(debug:print-error 0 *default-log-port* "attempt to STOP process. Exiting."))
(set! *time-to-exit* #t)
(print "Received signal " signum ", cleaning up before exit. Please wait...")
(let ((th1 (make-thread (lambda ()
(rmt:test-set-state-status run-id test-id "INCOMPLETE" "KILLED" #f)
(print "Killed by signal " signum ". Exiting")
(thread-sleep! 1)
(thread-sleep! 2)
(debug:print 0 *default-log-port* "Done")
(exit 4)))))
(thread-start! th2)
(thread-start! th1)
(thread-join! th2)))))
(set-signal-handler! signal/int sighand)
(set-signal-handler! signal/term sighand)
|
|
>
|
>
<
|
|
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
|
(set! tconfigreg (tests:get-all)) ;; mapping of testname => test source path
(let ((sighand (lambda (signum)
;; (signal-mask! signum) ;; to mask or not? seems to cause issues in exiting
(if (eq? signum signal/stop)
(debug:print-error 0 *default-log-port* "attempt to STOP process. Exiting."))
(set! *time-to-exit* #t)
(print "Received signal " signum ", cleaning up before exit (set this test to COMPLETED/ABORT) . Please wait...")
(let ((th1 (make-thread (lambda ()
(print "set test to COMPLETED/ABORT begin.")
(rmt:test-set-state-status run-id test-id "COMPLETED" "ABORT" "received kill signal")
(print "set test to COMPLETED/ABORT complete.")
(print "Killed by signal " signum ". Exiting")
(exit 1))))
(th2 (make-thread (lambda ()
(thread-sleep! 20)
(debug:print 0 *default-log-port* "Done")
(exit 4)))))
(thread-start! th2)
(thread-start! th1)
(thread-join! th2)))))
(set-signal-handler! signal/int sighand)
(set-signal-handler! signal/term sighand)
|