Allow customising the resource-pool put-message timeout

This commit is contained in:
Christopher Baines 2025-01-08 12:23:18 +00:00
parent 66e0c52bf4
commit 409fa1df5c

View file

@ -71,8 +71,7 @@
lifetime lifetime
scheduler scheduler
(name "unnamed") (name "unnamed")
;; Add options for customizing timeouts (put-message-timeout 0.5))
)
(define (initializer/safe) (define (initializer/safe)
(with-exception-handler (with-exception-handler
(lambda (exn) (lambda (exn)
@ -157,7 +156,8 @@
(wrap-operation (wrap-operation
(put-operation reply new-resource) (put-operation reply new-resource)
(const #t)) (const #t))
(wrap-operation (sleep-operation 1) (wrap-operation (sleep-operation
put-message-timeout)
(const #f)))))) (const #f))))))
(unless checkout-success? (unless checkout-success?
(set! checkout-failure-count (set! checkout-failure-count
@ -180,7 +180,8 @@
(wrap-operation (wrap-operation
(put-operation reply (car available)) (put-operation reply (car available))
(const #t)) (const #t))
(wrap-operation (sleep-operation 1) (wrap-operation (sleep-operation
put-message-timeout)
(const #f)))))) (const #f))))))
(unless checkout-success? (unless checkout-success?
(set! checkout-failure-count (set! checkout-failure-count
@ -215,7 +216,8 @@
(put-operation (last waiters) (put-operation (last waiters)
resource) resource)
(const #t)) (const #t))
(wrap-operation (sleep-operation 1) (wrap-operation (sleep-operation
put-message-timeout)
(const #f)))))) (const #f))))))
(unless checkout-success? (unless checkout-success?
(set! checkout-failure-count (set! checkout-failure-count
@ -269,7 +271,8 @@
(wrap-operation (wrap-operation
(put-operation reply stats) (put-operation reply stats)
(const #t)) (const #t))
(wrap-operation (sleep-operation 1) (wrap-operation (sleep-operation
put-message-timeout)
(const #f))))))) (const #f)))))))
(loop resources (loop resources