diff options
| author | Mathieu Lirzin <mthl@gnu.org> | 2018-03-24 15:28:36 +0100 |
|---|---|---|
| committer | Mathieu Lirzin <mthl@gnu.org> | 2018-03-24 15:32:56 +0100 |
| commit | d1e0d2a8f75b28286986fce7c0e8cfe552cde322 (patch) | |
| tree | 2c0b469f9d4136dd2f73c02cf050726114485302 | |
| parent | 526ce502e5b7bce1e3577696b2c41564f7248920 (diff) | |
| download | mcron-d1e0d2a8f75b28286986fce7c0e8cfe552cde322.tar.gz mcron-d1e0d2a8f75b28286986fce7c0e8cfe552cde322.tar.bz2 mcron-d1e0d2a8f75b28286986fce7c0e8cfe552cde322.zip | |
base: Check 'run-job'
* tests/base.scm ("run-job: basic"): New test.
| -rw-r--r-- | tests/base.scm | 16 |
1 files changed, 16 insertions, 0 deletions
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) |