AboutSummaryRefsLogTreeCommitDiffStats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/base.scm29
1 files changed, 23 insertions, 6 deletions
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)