From d1e0d2a8f75b28286986fce7c0e8cfe552cde322 Mon Sep 17 00:00:00 2001 From: Mathieu Lirzin Date: Sat, 24 Mar 2018 15:28:36 +0100 Subject: base: Check 'run-job' * tests/base.scm ("run-job: basic"): New test. --- tests/base.scm | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/tests/base.scm b/tests/base.scm index d7a2dbd..164f364 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 run-job (@@ (mcron base) run-job)) ;;; Check 'number-children' initial value. (let ((schdl (make-schedule '() '() 'user))) @@ -180,4 +181,19 @@ 1 (unbox number-children))) +;;; Check 'run-job' basic call. +;;; 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 + (λ () + (run-job job) + (waitpid WAIT_ANY)) + (λ () + (test-assert "run-job: basic" + (access? filename F_OK))) + (λ () + (delete-file filename)))) + (test-end) -- cgit v1.2.3