tests: Add "tests/base.scm"
* tests/base.scm: New test. * Makefile.am (TESTS): Add it.
This commit is contained in:
Mathieu Lirzin
parent
ac39c00859
commit
6583e83d16
2 changed files with 152 additions and 0 deletions
|
|
@ -136,6 +136,7 @@ SCM_LOG_DRIVER = \
|
||||||
TESTS = \
|
TESTS = \
|
||||||
tests/basic.sh \
|
tests/basic.sh \
|
||||||
tests/schedule.sh \
|
tests/schedule.sh \
|
||||||
|
tests/base.scm \
|
||||||
tests/environment.scm \
|
tests/environment.scm \
|
||||||
tests/job-specifier.scm
|
tests/job-specifier.scm
|
||||||
|
|
||||||
|
|
|
||||||
151
tests/base.scm
Normal file
151
tests/base.scm
Normal 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)
|
||||||
Loading…
Add table
Add a link
Reference in a new issue