From 95fb9140257ec83bc7ac830fe9a10b802def131e Mon Sep 17 00:00:00 2001
From: Mathieu Lirzin <mthl@gnu.org>
Date: Mon, 26 Mar 2018 20:27:12 +0200
Subject: base: Check how child processes are handled

* tests/base.scm ("run-job: basic"): Check the number of children too.
("child-cleanup: one", "update-number-children!: set value"): New tests.
---
 tests/base.scm | 29 +++++++++++++++++++++++------
 1 file changed, 23 insertions(+), 6 deletions(-)

(limited to 'tests')

diff --git a/tests/base.scm b/tests/base.scm
index 39e35fd..eb9e11a 100644
--- a/tests/base.scm
+++ b/tests/base.scm
@@ -158,6 +158,7 @@
 
 ;;; Import private procedures.
 (define update-number-children! (@@ (mcron base) update-number-children!))
+(define child-cleanup (@@ (mcron base) child-cleanup))
 (define run-job (@@ (mcron base) run-job))
 
 ;;; Check 'number-children' initial value.
@@ -180,19 +181,35 @@
     (update-number-children! 1-)
     (unbox number-children)))
 
-;;; Check 'run-job' basic call.
+;;; Check 'update-number-children!' constant value.
+(test-equal "update-number-children!: set value"
+  0
+  (begin
+    (update-number-children! (const 0))
+    (unbox number-children)))
+
+;;; Check 'run-job' and 'child-cleanup'.
 ;;; XXX: Having to use the filesystem for a unit test is wrong.
 (let* ((filename (tmpnam))
        (action (λ () (close-port (open-output-file filename))))
        (job (make-dummy-job #:user (getpw (getuid)) #:action action)))
   (dynamic-wind
+    (const #t)
     (λ ()
+      (sigaction SIGCHLD (const #t))
       (run-job job)
-      (waitpid WAIT_ANY))
-    (λ ()
-      (test-assert "run-job: basic"
-        (access? filename F_OK)))
+      ;; Wait for the SIGCHLD signal sent when job exits.
+      (pause)
+      ;; Check 'run-job' result and if the number of children is up-to-date.
+      (test-equal "run-job: basic"
+        1
+        (and (access? filename F_OK)
+             (unbox number-children)))
+      (child-cleanup)
+      ;; Check that 'child-cleanup' updates the number of children.
+      (test-equal "child-cleanup: one" 0 (unbox number-children)))
     (λ ()
-      (delete-file filename))))
+      (and (access? filename F_OK) (delete-file filename))
+      (sigaction SIGCHLD SIG_DFL))))
 
 (test-end)
-- 
cgit v1.2.3