From 526ce502e5b7bce1e3577696b2c41564f7248920 Mon Sep 17 00:00:00 2001
From: Mathieu Lirzin <mthl@gnu.org>
Date: Sat, 24 Mar 2018 14:03:54 +0100
Subject: base: Box 'number-children'

* src/mcron/base.scm (number-children): Box it using SRFI-111 to be
explicit about the mutability of this object.
(update-number-children!): New procedure.
(run-job, child-cleanup): Use it.
* tests/base.scm ("update-number-children!: 1+")
("number-children: init", "update-number-children!: 1-"): New tests.
---
 src/mcron/base.scm | 21 +++++++++++++++------
 1 file changed, 15 insertions(+), 6 deletions(-)

(limited to 'src/mcron/base.scm')

diff --git a/src/mcron/base.scm b/src/mcron/base.scm
index 2f1c060..17ddd5c 100644
--- a/src/mcron/base.scm
+++ b/src/mcron/base.scm
@@ -32,6 +32,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-2)
   #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-111)
   #:export (add-job
             remove-user-jobs
             display-schedule
@@ -157,10 +158,18 @@ unusable."
                    jobs))))
     (display-schedule (- count 1) port #:schedule schedule)))
 
-;; For proper housekeeping, it is necessary to keep a record of the number of
-;; child processes we fork off to run the jobs.
+;;;
+;;; Running jobs
+;;;
+
+(define number-children
+  ;; For proper housekeeping, it is necessary to keep a record of the number
+  ;; of child processes we fork off to run the jobs.
+  (box 0))
 
-(define number-children 0)
+(define (update-number-children! proc)
+  ;; Apply PROC to the value stored in 'number-children'.
+  (set-box! number-children (proc (unbox number-children))))
 
 (define (run-job job)
   "Run JOB in a separate process. The process is run as JOB user with the
@@ -178,16 +187,16 @@ next value."
         (λ ()
           (primitive-exit 0)))
       (begin                            ;parent
-        (set! number-children (+ number-children 1))
+        (update-number-children! 1+)
         (job:next-time-set! job ((job:next-time-function job)
                                  (current-time))))))
 
 (define (child-cleanup)
   ;; Give any zombie children a chance to die, and decrease the number known
   ;; to exist.
-  (unless (or (<= number-children 0)
+  (unless (or (<= (unbox number-children) 0)
               (= (car (waitpid WAIT_ANY WNOHANG)) 0))
-    (set! number-children (- number-children 1))
+    (update-number-children! 1-)
     (child-cleanup)))
 
 (define* (run-job-loop #:optional fd-list #:key (schedule %global-schedule))
-- 
cgit v1.2.3