Address issue with failures when creating resource pool resources
All checks were successful
/ test (push) Successful in 5s
All checks were successful
/ test (push) Successful in 5s
Previously failures could lead to no resources in the pool, and waiters which will never get a resource. Retrying here fixes that issue, although maybe another approach is needed that keeps track of new resources being created, as that'll allow keeping track of this when destroying resource pools.
This commit is contained in:
parent
094259b049
commit
5260c38b5e
1 changed files with 37 additions and 25 deletions
|
|
@ -562,31 +562,43 @@
|
|||
#f
|
||||
(raise-exception exn)))
|
||||
(lambda ()
|
||||
(with-parallelism-limiter
|
||||
return-new-resource/parallelism-limiter
|
||||
(let ((max-size
|
||||
(assq-ref (resource-pool-configuration pool)
|
||||
'max-size))
|
||||
(size (count-resources resources)))
|
||||
(unless (>= size max-size)
|
||||
(with-exception-handler
|
||||
(lambda _ #f)
|
||||
(lambda ()
|
||||
(with-exception-handler
|
||||
(lambda (exn)
|
||||
(simple-format
|
||||
(current-error-port)
|
||||
"exception adding resource to pool ~A: ~A\n\n"
|
||||
name
|
||||
return-new-resource)
|
||||
(print-backtrace-and-exception/knots exn)
|
||||
(raise-exception exn))
|
||||
(lambda ()
|
||||
(let ((new-resource
|
||||
(start-stack #t (return-new-resource))))
|
||||
(put-message channel
|
||||
(list 'add-resource new-resource))))))
|
||||
#:unwind? #t)))))
|
||||
(let loop ()
|
||||
(let ((success?
|
||||
(with-parallelism-limiter
|
||||
return-new-resource/parallelism-limiter
|
||||
(let ((max-size
|
||||
(assq-ref (resource-pool-configuration pool)
|
||||
'max-size))
|
||||
(size (count-resources resources)))
|
||||
(or (>= size max-size)
|
||||
(with-exception-handler
|
||||
(lambda _ #f)
|
||||
(lambda ()
|
||||
(with-exception-handler
|
||||
(lambda (exn)
|
||||
(simple-format
|
||||
(current-error-port)
|
||||
"exception adding resource to pool ~A: ~A\n\n"
|
||||
name
|
||||
return-new-resource)
|
||||
(print-backtrace-and-exception/knots exn)
|
||||
(raise-exception exn))
|
||||
(lambda ()
|
||||
(let ((new-resource
|
||||
(start-stack #t (return-new-resource))))
|
||||
(put-message channel
|
||||
(list 'add-resource new-resource)))
|
||||
#t)))
|
||||
#:unwind? #t))))))
|
||||
(unless success?
|
||||
;; TODO Maybe this should be configurable?
|
||||
(sleep 1)
|
||||
|
||||
;; Important to retry here and eventually create
|
||||
;; a new resource, as there might be waiters
|
||||
;; stuck waiting for a resource, especially if
|
||||
;; the pool is empty.
|
||||
(loop)))))
|
||||
#:unwind? #t))))
|
||||
|
||||
(define (spawn-fiber-to-destroy-resource resource-id resource-value)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue