diff options
| -rw-r--r-- | guix-build-coordinator/utils.scm | 28 |
1 files changed, 26 insertions, 2 deletions
diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm index e07ed9b..81d0899 100644 --- a/guix-build-coordinator/utils.scm +++ b/guix-build-coordinator/utils.scm @@ -925,7 +925,15 @@ References: ~a~%" (current-error-port) "~A work queue, exception when handling job: ~A ~A\n" name key args) - (backtrace)))) + (let* ((stack (make-stack #t 3)) + (backtrace + (call-with-output-string + (lambda (port) + (display-backtrace stack port) + (newline port))))) + (display + backtrace + (current-error-port)))))) #:unwind? #t)) (define (start-thread thread-index) @@ -1108,7 +1116,23 @@ References: ~a~%" (current-error-port))) #:unwind? #t)) (lambda () - (apply proc job-args)) + (with-throw-handler #t + (lambda () + (apply proc job-args)) + (lambda (key . args) + (simple-format + (current-error-port) + "~A thread pool, exception when handling job: ~A ~A\n" + name key args) + (let* ((stack (make-stack #t 3)) + (backtrace + (call-with-output-string + (lambda (port) + (display-backtrace stack port) + (newline port))))) + (display + backtrace + (current-error-port)))))) #:unwind? #t)) (define (start-thread thread-index) |