Tweak the thread pool delay and duration loggers

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

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")