SummaryRefsLogTreeCommitDiffStats
path: root/tests/base.scm
diff options
context:
space:
mode:
Diffstat (limited to 'tests/base.scm')
-rw-r--r--tests/base.scm151
1 files changed, 151 insertions, 0 deletions
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 <mthl@gnu.org>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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)