cbaines/guile-knots
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Support getting the pool from the timeout error

Browse source
This commit is contained in:
Christopher Baines 2025-01-06 19:04:06 +00:00
parent 6119ece5cb
commit 97a3116b81
2 changed files with 19 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

16
knots/resource-pool.scm
View file

@ -36,6 +36,7 @@
resource-pool-retry-checkout-timeout
&resource-pool-timeout
resource-pool-timeout-error-pool
resource-pool-timeout-error?
resource-pool-default-timeout-handler
@ -349,7 +350,12 @@
(define &resource-pool-timeout
(make-exception-type '&recource-pool-timeout
&error
'(name)))
'(pool)))
(define resource-pool-timeout-error-pool
(exception-accessor
&resource-pool-timeout
(record-accessor &resource-pool-timeout 'pool)))
(define make-resource-pool-timeout-error
(record-constructor &resource-pool-timeout))
@ -427,7 +433,7 @@ available. Return the resource once PROC has returned."
(timeout-handler pool proc timeout))
(raise-exception
(make-resource-pool-timeout-error (resource-pool-name pool))))
(make-resource-pool-timeout-error pool)))
(with-exception-handler
(lambda (exception)
@ -465,7 +471,7 @@ available. Return the resource once PROC has returned."
(wrap-operation (sleep-operation timeout)
(lambda _
(raise-exception
(make-resource-pool-timeout-error))))))
(make-resource-pool-timeout-error pool))))))
(let ((time-remaining
(- timeout
@ -479,7 +485,7 @@ available. Return the resource once PROC has returned."
(wrap-operation (sleep-operation time-remaining)
(lambda _
(raise-exception
(make-resource-pool-timeout-error))))))
(make-resource-pool-timeout-error pool))))))
(raise-exception
(make-resource-pool-timeout-error))))))
(make-resource-pool-timeout-error pool))))))