diff options
author | Christopher Baines <mail@cbaines.net> | 2024-05-11 07:30:43 +0100 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2024-05-11 07:30:43 +0100 |
commit | cb5ff917725363ce2bb46cc675029833e207a867 (patch) | |
tree | 8f12a13b9a56cca21bceff937e927d3397e7e632 | |
parent | 32c4ff9c7e08f170b5f0b4a2bb2f42730c4aa48d (diff) | |
download | nar-herder-cb5ff917725363ce2bb46cc675029833e207a867.tar nar-herder-cb5ff917725363ce2bb46cc675029833e207a867.tar.gz |
Fix with-port-timeout exceptions
-rw-r--r-- | nar-herder/utils.scm | 12 |
1 files changed, 6 insertions, 6 deletions
diff --git a/nar-herder/utils.scm b/nar-herder/utils.scm index 4755d33..7be0482 100644 --- a/nar-herder/utils.scm +++ b/nar-herder/utils.scm @@ -701,7 +701,7 @@ If already in the worker thread, call PROC immediately." (define &port-timeout (make-exception-type '&port-timeout &external-error - '(port))) + '(thunk port))) (define make-port-timeout-error (record-constructor &port-timeout)) @@ -735,7 +735,7 @@ If already in the worker thread, call PROC immediately." #:key timeout (read-timeout timeout) (write-timeout timeout)) - (define (no-fibers-wait port mode timeout) + (define (no-fibers-wait thunk port mode timeout) (define poll-timeout-ms 200) ;; When the GC runs, it restarts the poll syscall, but the timeout @@ -755,8 +755,8 @@ If already in the worker thread, call PROC immediately." timeout-internal) (raise-exception (if (string=? mode "r") - (make-port-read-timeout-error port) - (make-port-write-timeout-error port))) + (make-port-read-timeout-error thunk port) + (make-port-write-timeout-error thunk port))) (loop (port-poll port mode poll-timeout-ms))) poll-value)))) @@ -772,7 +772,7 @@ If already in the worker thread, call PROC immediately." (lambda () (raise-exception (make-port-read-timeout-error thunk port)))))) - (no-fibers-wait port "r" read-timeout)))) + (no-fibers-wait thunk port "r" read-timeout)))) (current-write-waiter (lambda (port) (if (current-scheduler) @@ -784,5 +784,5 @@ If already in the worker thread, call PROC immediately." (lambda () (raise-exception (make-port-write-timeout-error thunk port)))))) - (no-fibers-wait port "w" write-timeout))))) + (no-fibers-wait thunk port "w" write-timeout))))) (thunk))) |