Tweak the thread pool delay and duration loggers

Bringing the functionality in line with the resource pool loggers.

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
+Called as @code{(delay-logger seconds)} with the time spent waiting
-waiting for a thread to become available.
+for a thread to become available.
 
 @item #:duration-logger
-Called as @code{(duration-logger seconds proc)} after each procedure
+Called as @code{(duration-logger seconds)} after each procedure
-completes.
+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)
+                              internal-time-units-per-second))))
-                           proc)))
 
          (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))
+                           delay-logger
-                           (duration-logger (const #f))
+                           duration-logger
                            thread-lifetime
                            (expire-on-exception? #f)
                            (name "unnamed")

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