Sort out resource pool delay and duration logging

This commit is contained in:
Christopher Baines 2026-03-23 13:12:13 +00:00
parent 781c8cf9db
commit a44cc014a4
2 changed files with 168 additions and 43 deletions

View file

@ -282,4 +282,50 @@
(destroy-resource-pool resource-pool))))
;; Test delay-logger and duration-logger
(run-fibers-for-tests
(lambda ()
(let* ((logged-delay #f)
(logged-duration #f)
(resource-pool (make-fixed-size-resource-pool
(list 1)
#:delay-logger
(lambda (seconds)
(set! logged-delay seconds))
#:duration-logger
(lambda (seconds)
(set! logged-duration seconds)))))
(call-with-resource-from-pool resource-pool
(lambda (res)
(sleep 0.2)))
(assert-true (number? logged-delay))
(assert-true (number? logged-duration))
(assert-true (>= logged-duration 0.1))
(destroy-resource-pool resource-pool))))
;; Test per-call duration-logger overrides pool default
(run-fibers-for-tests
(lambda ()
(let* ((pool-logged #f)
(call-logged #f)
(resource-pool (make-fixed-size-resource-pool
(list 1)
#:duration-logger
(lambda (seconds)
(set! pool-logged seconds)))))
(call-with-resource-from-pool resource-pool
(lambda (res) #t)
#:duration-logger
(lambda (seconds)
(set! call-logged seconds)))
(assert-true (not pool-logged))
(assert-true (number? call-logged))
(destroy-resource-pool resource-pool))))
(display "resource-pool test finished successfully\n")