Allow specifying the resource-pool-channel

This commit is contained in:
Christopher Baines 2025-04-27 10:52:36 +01:00
parent 68cfbe0380
commit 1dca6d755e

View file

@ -786,7 +786,8 @@
(define* (call-with-resource-from-pool
pool proc #:key (timeout 'default)
(timeout-handler (resource-pool-default-timeout-handler))
(max-waiters 'default))
(max-waiters 'default)
(channel (resource-pool-channel pool)))
"Call PROC with a resource from POOL, blocking until a resource becomes
available. Return the resource once PROC has returned."
@ -810,7 +811,7 @@ available. Return the resource once PROC has returned."
(perform-operation
(choice-operation
(wrap-operation
(put-operation (resource-pool-channel pool)
(put-operation channel
(list 'checkout
reply
(+ start-time
@ -846,7 +847,7 @@ available. Return the resource once PROC has returned."
response))
'timeout)))))
(let loop ((reply (make-channel)))
(put-message (resource-pool-channel pool)
(put-message channel
(list 'checkout
reply
#f