diff options
| -rw-r--r-- | src/mcron/base.scm | 21 | ||||
| -rw-r--r-- | tests/base.scm | 32 |
2 files changed, 47 insertions, 6 deletions
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)) diff --git a/tests/base.scm b/tests/base.scm index 89b7349..d7a2dbd 100644 --- a/tests/base.scm +++ b/tests/base.scm @@ -17,6 +17,7 @@ ;;; along with GNU Mcron. If not, see <http://www.gnu.org/licenses/>. (use-modules (srfi srfi-64) + (srfi srfi-111) (mcron base)) (test-begin "base") @@ -148,4 +149,35 @@ (with-output-to-string (λ () (display-schedule 1 #:schedule schdl))))) +;;; +;;; Running jobs +;;; + +;;; Import private global. +(define number-children (@@ (mcron base) number-children)) + +;;; Import private procedures. +(define update-number-children! (@@ (mcron base) update-number-children!)) + +;;; Check 'number-children' initial value. +(let ((schdl (make-schedule '() '() 'user))) + (test-equal "number-children: init" + 0 + (unbox number-children))) + +;;; Check 'update-number-children!' incrementation. +(let ((schdl (make-schedule '() '() 'user))) + (update-number-children! 1+) + (update-number-children! 1+) + (test-equal "update-number-children!: 1+" + 2 + (unbox number-children))) + +;;; Check 'update-number-children!' decrementation. +(let ((schdl (make-schedule '() '() 'user))) + (update-number-children! 1-) + (test-equal "update-number-children!: 1-" + 1 + (unbox number-children))) + (test-end) |