Fix fixed size thread pool lifetimes
Some checks failed
/ test (push) Has been cancelled

This commit is contained in:
Christopher Baines 2025-11-19 13:18:39 +00:00
parent 05ad83c703
commit 95200eccfd
2 changed files with 38 additions and 3 deletions

View file

@ -343,7 +343,7 @@ from there, or #f if that would be an empty string."
expire-on-exception?) expire-on-exception?)
#t #t
(if lifetime (if lifetime
(if (<= 1 lifetime) (if (<= lifetime 1)
#t #t
(loop (- lifetime 1))) (loop (- lifetime 1)))
(loop lifetime))))))))) (loop lifetime)))))))))

View file

@ -1,4 +1,5 @@
(use-modules (tests) (use-modules (tests)
(ice-9 atomic)
(srfi srfi-71) (srfi srfi-71)
(fibers) (fibers)
(unit-test) (unit-test)
@ -86,13 +87,21 @@
#:unwind? #t))))) #:unwind? #t)))))
(let ((thread-pool (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 (for-each
(lambda _ (lambda _
(call-with-thread (call-with-thread
thread-pool thread-pool
(lambda () #f))) (lambda (box)
(if (atomic-box-ref box)
(atomic-box-set! box #f)
(error (atomic-box-ref box))))))
(iota 10))) (iota 10)))
(run-fibers-for-tests (run-fibers-for-tests
@ -107,4 +116,30 @@
(lambda () #f))) (lambda () #f)))
(iota 10))))) (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") (display "thread-pool test finished successfully\n")