03/03: Avoid locking up the thread pool channel on letpar& exceptions

[Christopher Baines]

cbaines pushed a commit to branch master
in repository data-service.

commit 888d9fcb98c6d697120993efe0b3bbd175bf37d7
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Sun Oct 4 15:36:38 2020 +0100

    Avoid locking up the thread pool channel on letpar& exceptions
    
    Previously, if an exception occurred during the processing of any but the 
last
    letpar& expression, the replies for the other expressions would never be
    fetched, resulting in that thread in the pool just waiting for a receiver 
for
    the message.
    
    To avoid this, make sure to read all the replies before raising any
    exceptions.
---
 guix-data-service/utils.scm | 12 +++++++++++-
 1 file changed, 11 insertions(+), 1 deletion(-)

diff --git a/guix-data-service/utils.scm b/guix-data-service/utils.scm
index cc9b7ac..8ad60f9 100644
--- a/guix-data-service/utils.scm
+++ b/guix-data-service/utils.scm
@@ -111,6 +111,16 @@
     (result
      (apply values result))))
 
+(define (fetch-result-of-defered-thunks . reply-channels)
+  (let ((responses (map get-message reply-channels)))
+    (map
+     (match-lambda
+       (('worker-thread-error . exn)
+        (raise-exception exn))
+       (result
+        (apply values result)))
+     responses)))
+
 (define-syntax parallel-via-thread-pool-channel
   (lambda (x)
     (syntax-case x ()
@@ -120,7 +130,7 @@
                          (lambda ()
                            e0)))
                  ...)
-             (values (fetch-result-of-defered-thunk tmp0) ...)))))))
+             (apply values (fetch-result-of-defered-thunks tmp0 ...))))))))
 
 (define-syntax-rule (letpar& ((v e) ...) b0 b1 ...)
   (call-with-values