From d1e0d2a8f75b28286986fce7c0e8cfe552cde322 Mon Sep 17 00:00:00 2001
From: Mathieu Lirzin <mthl@gnu.org>
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(+)

(limited to 'tests')

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