Fix idle resource removal in the resource pool

This commit is contained in:
Christopher Baines 2025-02-03 12:16:16 +01:00
parent a2ab770536
commit bddc6c04ad
2 changed files with 23 additions and 8 deletions

View file

@ -391,16 +391,10 @@
(spawn-fiber-to-destroy-resource resource))
resources-to-destroy))
(loop (lset-difference eq? resources resources-to-destroy)
(loop resources
(lset-difference eq? available resources-to-destroy)
waiters
(filter-map
(lambda (resource last-used)
(if (memq resource resources-to-destroy)
#f
last-used))
resources
resources-last-used))))
resources-last-used)))
(('destroy reply)
(if (null? resources)

View file

@ -72,6 +72,27 @@
(destroy-resource-pool resource-pool))))
(run-fibers-for-tests
(lambda ()
(let ((resource-pool (make-resource-pool
new-number
2
#:idle-seconds 0.5
#:destructor
(lambda (res)
#t))))
(fibers-for-each
(lambda _
(with-resource-from-pool resource-pool
res
res))
(iota 20))
(let loop ((stats (resource-pool-stats resource-pool)))
(unless (= 0 (assq-ref stats 'resources))
(sleep 0.1)
(loop (resource-pool-stats resource-pool)))))))
(run-fibers-for-tests
(lambda ()
(let* ((counter 0)