diff --git a/knots/resource-pool.scm b/knots/resource-pool.scm index f00e05b..f957c3d 100644 --- a/knots/resource-pool.scm +++ b/knots/resource-pool.scm @@ -391,7 +391,7 @@ (('list-resources reply) (spawn-fiber (lambda () - (put-message reply (list-copy resources)))) + (put-message reply (vector->list resources)))) (loop available waiters)) @@ -967,7 +967,9 @@ (('list-resources reply) (spawn-fiber (lambda () - (put-message reply (list-copy resources)))) + (put-message reply (hash-map->list + (lambda (_ value) value) + resources)))) (loop next-resource-id available @@ -1115,13 +1117,14 @@ (lambda () (let loop () (put-message channel '(check-for-idle-resources)) - (when (choice-operation - (wrap-operation - (sleep-operation idle-seconds) - (const #t)) - (wrap-operation - (wait-operation destroy-condition) - (const #f))) + (when (perform-operation + (choice-operation + (wrap-operation + (sleep-operation idle-seconds) + (const #t)) + (wrap-operation + (wait-operation destroy-condition) + (const #f)))) (loop)))))) (with-exception-handler diff --git a/tests/resource-pool.scm b/tests/resource-pool.scm index 2e30cb9..b3a84d7 100644 --- a/tests/resource-pool.scm +++ b/tests/resource-pool.scm @@ -252,4 +252,34 @@ (destroy-resource-pool resource-pool)))) +;; Test allocating resources to waiters and destroying resources +(run-fibers-for-tests + (lambda () + (let ((resource-pool (make-resource-pool + (lambda () + (sleep 1) + 'res) + 2 + #:idle-seconds 1 + #:add-resources-parallelism 10 + #:destructor + (const #t)))) + (fibers-for-each + (lambda _ + (with-resource-from-pool resource-pool + res + res)) + (iota 20)) + + (sleep 2) + + (fibers-for-each + (lambda _ + (with-resource-from-pool resource-pool + res + res)) + (iota 20)) + + (destroy-resource-pool resource-pool)))) + (display "resource-pool test finished successfully\n")