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

8
tests/resource-pool.scm
View file

@ -15,4 +15,12 @@
res) res)
2)))) 2))))
(let* ((error-constructor
(record-constructor &resource-pool-timeout))
(err
(error-constructor 'foo)))
(assert-equal
(resource-pool-timeout-error-pool err)
'foo))
(display "resource-pool test finished successfully\n") (display "resource-pool test finished successfully\n")