From 19fd7229bc668e5b34adc5357557aff3f62b9308 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 17 Nov 2017 10:47:11 +0100 Subject: [PATCH] workers: Add test with exceptions. * tests/workers.scm ("exceptions"): New test. --- tests/workers.scm | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/tests/workers.scm b/tests/workers.scm index 44b882f691..4eaefbb43d 100644 --- a/tests/workers.scm +++ b/tests/workers.scm @@ -42,4 +42,30 @@ (poll))) result)) +;; Same as above, but throw exceptions within the workers and make sure they +;; remain alive. +(test-equal "exceptions" + 4242 + (let* ((pool (make-pool 10)) + (result 0) + (1+! (let ((lock (make-mutex))) + (lambda () + (with-mutex lock + (set! result (+ result 1))))))) + (let loop ((i 10)) + (unless (zero? i) + (pool-enqueue! pool (lambda () + (throw 'whatever))) + (loop (- i 1)))) + (let loop ((i 4242)) + (unless (zero? i) + (pool-enqueue! pool 1+!) + (loop (- i 1)))) + (let poll () + (unless (pool-idle? pool) + (pk 'busy result) + (sleep 1) + (poll))) + result)) + (test-end)