From 95200eccfd5668fa94a0dfad6eab93d7b7731c9d Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Wed, 19 Nov 2025 13:18:39 +0000
Subject: [PATCH] Fix fixed size thread pool lifetimes

---
 knots/thread-pool.scm |  2 +-
 tests/thread-pool.scm | 39 +++++++++++++++++++++++++++++++++++++--
 2 files changed, 38 insertions(+), 3 deletions(-)

diff --git a/knots/thread-pool.scm b/knots/thread-pool.scm
index cbbaf21..22c1b5c 100644
--- a/knots/thread-pool.scm
+++ b/knots/thread-pool.scm
@@ -343,7 +343,7 @@ from there, or #f if that would be an empty string."
                       expire-on-exception?)
                  #t
                  (if lifetime
-                     (if (<= 1 lifetime)
+                     (if (<= lifetime 1)
                          #t
                          (loop (- lifetime 1)))
                      (loop lifetime)))))))))
diff --git a/tests/thread-pool.scm b/tests/thread-pool.scm
index dd0b852..e3a1cdd 100644
--- a/tests/thread-pool.scm
+++ b/tests/thread-pool.scm
@@ -1,4 +1,5 @@
 (use-modules (tests)
+             (ice-9 atomic)
              (srfi srfi-71)
              (fibers)
              (unit-test)
@@ -86,13 +87,21 @@
         #:unwind? #t)))))
 
 (let ((thread-pool
-       (make-fixed-size-thread-pool 1 #:thread-lifetime 1)))
+       (make-fixed-size-thread-pool
+        1
+        #:thread-lifetime 1
+        #:thread-initializer
+        (lambda ()
+          (list (make-atomic-box #t))))))
 
   (for-each
    (lambda _
      (call-with-thread
       thread-pool
-      (lambda () #f)))
+      (lambda (box)
+        (if (atomic-box-ref box)
+            (atomic-box-set! box #f)
+            (error (atomic-box-ref box))))))
    (iota 10)))
 
 (run-fibers-for-tests
@@ -107,4 +116,30 @@
          (lambda () #f)))
       (iota 10)))))
 
+(let ((thread-pool
+       (make-fixed-size-thread-pool
+        1
+        #:thread-lifetime 2
+        #:thread-initializer
+        (lambda ()
+          (list (make-atomic-box 2))))))
+
+  (define (ref-and-decrement box)
+    (let ((val (atomic-box-ref box)))
+      (atomic-box-set! box (- val 1))
+      val))
+
+  (unless (= 2 (call-with-thread
+                thread-pool
+                ref-and-decrement))
+    (error))
+  (unless (= 1 (call-with-thread
+                thread-pool
+                ref-and-decrement))
+    (error))
+  (unless (= 2 (call-with-thread
+                thread-pool
+                ref-and-decrement))
+    (error)))
+
 (display "thread-pool test finished successfully\n")