dmbcs/mcron
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

tests: Add "tests/base.scm"

Browse source 
* tests/base.scm: New test.
* Makefile.am (TESTS): Add it.
This commit is contained in:
Mathieu Lirzin 2018-03-24 00:40:04 +01:00
commit 6583e83d16
No known key found for this signature in database
GPG key ID: 0ADEE10094604D37
2 changed files with 152 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

151
tests/base.scm Normal file
View file

@ -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)