diff options
| author | Christopher Baines <mail@cbaines.net> | 2020-05-31 18:23:40 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2020-05-31 18:23:40 +0100 |
| commit | 4ff7ee1dc340cbb8cd1c49fc98619dd72650c5fe (patch) | |
| tree | 4380859f1a02366440a4c21124e080e060ac1c98 | |
| parent | 56cc1bdec4787e50cbe81d60f96ee1dc5b69c594 (diff) | |
| download | build-coordinator-4ff7ee1dc340cbb8cd1c49fc98619dd72650c5fe.tar build-coordinator-4ff7ee1dc340cbb8cd1c49fc98619dd72650c5fe.tar.gz | |
Improve worker exception handling
| -rw-r--r-- | guix-build-coordinator/utils.scm | 26 |
1 files changed, 17 insertions, 9 deletions
diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm index 7487fad..8d9e9f4 100644 --- a/guix-build-coordinator/utils.scm +++ b/guix-build-coordinator/utils.scm @@ -75,12 +75,19 @@ arguments of the worker thread procedure." (let loop () (match (get-message channel) (((? channel? reply) . (? procedure? proc)) - (put-message reply - (catch #t - (lambda () - (apply proc args)) - (lambda (key . args) - (cons* 'worker-thread-error key args)))))) + (put-message + reply + (with-exception-handler + (lambda (exn) + (cons 'worker-thread-error exn)) + (lambda () + (with-exception-handler + (lambda (exn) + (backtrace) + (raise-exception exn)) + (lambda () + (apply proc args)))) + #:unwind? #t)))) (loop))))))) (iota parallelism)) channel))) @@ -94,9 +101,10 @@ If already in the worker thread, call PROC immediately." (let ((reply (make-channel))) (put-message channel (cons reply proc)) (match (get-message reply) - (('worker-thread-error key args ...) - (apply throw key args)) - (result result)))))) + (('worker-thread-error . exn) + (raise-exception exn)) + (result + result)))))) (define (random-v4-uuid) ;; https://tools.ietf.org/html/rfc4122#page-14 |