cbaines/guile-knots
1
Fork 0
Code Issues 1 Pull requests Activity Actions

Tweak the thread pool delay and duration loggers

Browse source 
Bringing the functionality in line with the resource pool loggers.
This commit is contained in:
Christopher Baines 2026-03-23 13:25:29 +00:00
parent a44cc014a4
commit b411faf279
2 changed files with 59 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

19
knots/thread-pool.scm
View file

@ -277,12 +277,12 @@ Seconds to wait for a free thread slot before raising
forever).
@item #:delay-logger
Called as @code{(delay-logger seconds proc)} with the time spent
waiting for a thread to become available.
Called as @code{(delay-logger seconds)} with the time spent waiting
for a thread to become available.
@item #:duration-logger
Called as @code{(duration-logger seconds proc)} after each procedure
completes.
Called as @code{(duration-logger seconds)} after each procedure
completes, whether it returned normally or raised an exception.
@end table"
(define channel
(make-channel))
@ -352,8 +352,7 @@ completes.
(- (get-internal-real-time)
sent-time)))
(delay-logger (/ time-delay
internal-time-units-per-second)
proc)))
internal-time-units-per-second))))
(let* ((start-time (get-internal-real-time))
(response
@ -406,11 +405,11 @@ completes.
(match response
(('thread-pool-error duration _)
(when duration-logger
(duration-logger duration proc))
(duration-logger duration))
#t)
((duration . _)
(when duration-logger
(duration-logger duration proc))
(duration-logger duration))
#f))))
(if (and exception?
expire-on-exception?)
@ -474,8 +473,8 @@ completes.
scheduler
thread-initializer
thread-destructor
(delay-logger (lambda _ #f))
(duration-logger (const #f))
delay-logger
duration-logger
thread-lifetime
(expire-on-exception? #f)
(name "unnamed")

50
tests/thread-pool.scm
View file

@ -172,4 +172,54 @@
(destroy-thread-pool thread-pool)
(assert-equal pool-size destructor-count))
;; Test delay-logger and duration-logger for fixed-size thread pool
(let* ((logged-delay #f)
(logged-duration #f)
(thread-pool
(make-fixed-size-thread-pool
1
#:delay-logger
(lambda (seconds)
(set! logged-delay seconds))
#:duration-logger
(lambda (seconds)
(set! logged-duration seconds)))))
(call-with-thread
thread-pool
(lambda ()
(usleep 100000)))
(assert-true (number? logged-delay))
(assert-true (number? logged-duration))
(assert-true (>= logged-duration 0.1))
(destroy-thread-pool thread-pool))
;; Test delay-logger and duration-logger for dynamic thread pool
(run-fibers-for-tests
(lambda ()
(let* ((logged-delay #f)
(logged-duration #f)
(thread-pool
(make-thread-pool
1
#:delay-logger
(lambda (seconds)
(set! logged-delay seconds))
#:duration-logger
(lambda (seconds)
(set! logged-duration seconds)))))
(call-with-thread
thread-pool
(lambda ()
(usleep 100000)))
(assert-true (number? logged-delay))
(assert-true (number? logged-duration))
(assert-true (>= logged-duration 0.1))
(destroy-thread-pool thread-pool))))
(display "thread-pool test finished successfully\n")