Sort out resource pool delay and duration logging
This commit is contained in:
parent
781c8cf9db
commit
a44cc014a4
2 changed files with 168 additions and 43 deletions
|
|
@ -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")
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue