diff options
| -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 |