diff --git a/knots/thread-pool.scm b/knots/thread-pool.scm index aa460de..3844d8f 100644 --- a/knots/thread-pool.scm +++ b/knots/thread-pool.scm @@ -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") diff --git a/tests/thread-pool.scm b/tests/thread-pool.scm index dc22119..a086640 100644 --- a/tests/thread-pool.scm +++ b/tests/thread-pool.scm @@ -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")