Implement lifetime support for thread pools

knots/thread-pool.scm

@@ -270,7 +270,7 @@ from there, or #f if that would be an empty string."
             (destructor/safe args)))))
 
   (define (process thread-index channel args)
-    (let loop ()
+    (let loop ((lifetime thread-lifetime))
       (match (get-message channel)
         ('destroy #f)
         ((reply sent-time proc)
@@ -342,7 +342,11 @@ from there, or #f if that would be an empty string."
              (if (and exception?
                       expire-on-exception?)
                  #t
-                 (loop))))))))
+                 (if lifetime
+                     (if (<= 1 lifetime)
+                         #t
+                         (loop (- lifetime 1)))
+                     (loop lifetime)))))))))
 
   (define (start-thread index channel)
     (call-with-new-thread
@@ -416,7 +420,6 @@ arguments of the thread pool procedure."
              1
              #:thread-initializer thread-initializer
              #:thread-destructor thread-destructor
-             #:thread-lifetime thread-lifetime
              #:expire-on-exception? expire-on-exception?
              #:name name
              #:use-default-io-waiters? use-default-io-waiters?))
@@ -424,6 +427,7 @@ arguments of the thread pool procedure."
           #:destructor destroy-thread-pool
           #:min-size min-size
           #:delay-logger delay-logger
+          #:lifetime thread-lifetime
           #:scheduler scheduler
           #:duration-logger duration-logger
           #:default-checkout-timeout default-checkout-timeout

tests/thread-pool.scm

@@ -85,4 +85,26 @@
              (+ 1 'a))))
         #:unwind? #t)))))
 
+(let ((thread-pool
+       (make-fixed-size-thread-pool 1 #:thread-lifetime 1)))
+
+  (for-each
+   (lambda _
+     (call-with-thread
+      thread-pool
+      (lambda () #f)))
+   (iota 10)))
+
+(run-fibers-for-tests
+ (lambda ()
+   (let ((thread-pool
+          (make-thread-pool 1 #:thread-lifetime 1)))
+
+     (for-each
+      (lambda _
+        (call-with-thread
+         thread-pool
+         (lambda () #f)))
+      (iota 10)))))
+
 (display "thread-pool test finished successfully\n")