From 6583e83d16288d78645d806af3e4f69f4f1a655a Mon Sep 17 00:00:00 2001 From: Mathieu Lirzin Date: Sat, 24 Mar 2018 00:40:04 +0100 Subject: tests: Add "tests/base.scm" * tests/base.scm: New test. * Makefile.am (TESTS): Add it. --- tests/base.scm | 151 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 151 insertions(+) create mode 100644 tests/base.scm (limited to 'tests') diff --git a/tests/base.scm b/tests/base.scm new file mode 100644 index 0000000..89b7349 --- /dev/null +++ b/tests/base.scm @@ -0,0 +1,151 @@ +;;;; base.scm -- tests for (mcron base) module +;;; Copyright © 2018 Mathieu Lirzin +;;; +;;; This file is part of GNU Mcron. +;;; +;;; GNU Mcron is free software: you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation, either version 3 of the License, or +;;; (at your option) any later version. +;;; +;;; GNU Mcron is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Mcron. If not, see . + +(use-modules (srfi srfi-64) + (mcron base)) + +(test-begin "base") + +(setlocale LC_ALL "C") +(setenv "TZ" "UTC0") + +;;; Import private procedures. +(define make-schedule (@@ (mcron base) make-schedule)) +(define schedule-current (@@ (mcron base) schedule-current)) +(define schedule-user (@@ (mcron base) schedule-user)) +(define schedule-system (@@ (mcron base) schedule-system)) +(define make-job (@@ (mcron base) make-job)) +(define find-next-jobs (@@ (mcron base) find-next-jobs)) + +(define %user0 #("user0" "x" 0 0 "user0" "/var/empty" "/bin/sh")) +(define %user1 #("user1" "x" 1 1 "user1" "/var/empty" "/bin/sh")) + +(define* (make-dummy-job #:optional (displayable "dummy") + #:key + (user (getpw)) + (time-proc 1+) + (action (λ () "dummy action")) + (environment '()) + (next-time 0)) + (make-job user time-proc action environment displayable next-time)) + +;;; Check 'use-system-job-list' and 'use-user-job-list' effect +(let ((schdl (make-schedule '() '() 'user))) + (use-system-job-list #:schedule schdl) + (test-eq "use-system-job-list" + 'system + (schedule-current schdl)) + + (use-user-job-list #:schedule schdl) + (test-eq "use-user-job-list" + 'user + (schedule-current schdl))) + +;;; Check that 'remove-user-jobs' with only one type of user job clears the +;;; schedule. +(let* ((job (make-dummy-job #:user %user0)) + (schdl (make-schedule (list job) '() 'user))) + (remove-user-jobs %user0 #:schedule schdl) + (test-equal "remove-user-jobs: only one" + '() + (schedule-user schdl))) + +;;; Check that 'remove-user-jobs' with only two types of user jobs keep the +;;; other user jobs in the schedule. +(let* ((job0 (make-dummy-job #:user %user0)) + (job1 (make-dummy-job #:user %user1)) + (schdl (make-schedule (list job0 job1) '() 'user))) + (remove-user-jobs %user0 #:schedule schdl) + (test-equal "remove-user-jobs: keep one" + (list job1) + (schedule-user schdl))) + +;;; Check that 'clear-system-jobs' removes all system jobs and has no effect +;;; on the user jobs. +(let* ((job0 (make-dummy-job #:user %user0)) + (job1 (make-dummy-job #:user %user1)) + (schdl (make-schedule (list job0) (list job1) 'user))) + (clear-system-jobs #:schedule schdl) + (test-assert "clear-system-jobs: basic" + (and (equal? (list job0) (schedule-user schdl)) + (equal? '() (schedule-system schdl))))) + +;;; Check that 'add-job' adds a user job when the current schedule is 'user. +(let ((schdl (make-schedule '() '() 'user))) + (add-job 1+ (const #t) "job0" 0 "user" #:schedule schdl) + (test-assert "add-job: user schedule" + (and (= 1 (length (schedule-user schdl))) + (= 0 (length (schedule-system schdl)))))) + +;;; Check that 'add-job' adds a system job when the current schedule is +;;; 'system. +(let ((schdl (make-schedule '() '() 'system))) + (add-job 1+ (const #t) "job0" 0 "user" #:schedule schdl) + (test-assert "add-job: system schedule" + (and (= 0 (length (schedule-user schdl))) + (= 1 (length (schedule-system schdl)))))) + +;;; Check that 'find-next-jobs' find the soonest job. +(let* ((job0 (make-dummy-job #:user %user0 #:next-time 5)) + (job1 (make-dummy-job #:user %user1 #:next-time 10)) + (schdl (make-schedule (list job0) (list job1) 'user))) + (test-equal "find-next-jobs: basic" + (list 5 job0) + (find-next-jobs #:schedule schdl))) + +;;; Check that 'find-next-jobs' can find multiple soonest jobs. +(let* ((job0 (make-dummy-job #:user %user0 #:next-time 5)) + (job1 (make-dummy-job #:user %user1 #:next-time 5)) + (schdl (make-schedule (list job0) (list job1) 'user))) + (test-equal "find-next-jobs: two jobs" + (list 5 job0 job1) + (find-next-jobs #:schedule schdl))) + +;;; Check that 'find-next-jobs' returns #f when the schedule is empty. +(let ((schdl (make-schedule '() '() 'user))) + (test-equal "find-next-jobs: empty" + (list #f) + (find-next-jobs #:schedule schdl))) + +;;; Check output of 'display-schedule' with a basic schedule. +(test-assert "display-schedule: basic" + (and (equal? + "Thu Jan 1 00:00:05 1970 +0000\ndummy\n\n" + (let* ((job0 (make-dummy-job #:user %user0 #:next-time 5)) + (job1 (make-dummy-job #:user %user1 #:next-time 10)) + (schdl (make-schedule (list job0) (list job1) 'user))) + (with-output-to-string + (λ () (display-schedule 1 #:schedule schdl))))) + (equal? + (string-append + "Thu Jan 1 00:00:05 1970 +0000\ndummy\n\n" + "Thu Jan 1 00:00:06 1970 +0000\ndummy\n\n") + (let* ((job0 (make-dummy-job #:user %user0 #:next-time 5)) + (job1 (make-dummy-job #:user %user1 #:next-time 10)) + (schdl (make-schedule (list job0) (list job1) 'user))) + (with-output-to-string + (λ () (display-schedule 2 #:schedule schdl))))))) + +;;; Check output of 'display-schedule' with an empty schedule. +(let ((schdl (make-schedule '() '() 'user))) + (test-equal "display-schedule: empty" + "" + (with-output-to-string + (λ () (display-schedule 1 #:schedule schdl))))) + +(test-end) -- cgit v1.2.3