From ef452ce43b80959ab25b4a8bd90942c2ea1a9122 Mon Sep 17 00:00:00 2001 From: Mathieu Lirzin Date: Sun, 1 Apr 2018 21:44:28 +0200 Subject: vixie-time: Adapt to '%find-best-next' possible infinite result This is a follow up to commit ae6deb8ea23570c02a7b575a53bba37048aab59f. * src/mcron/vixie-time.scm (increment-time-component): Check if '%find-best-next' returns '+inf.0' not 9999. --- src/mcron/vixie-time.scm | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) (limited to 'src/mcron/vixie-time.scm') diff --git a/src/mcron/vixie-time.scm b/src/mcron/vixie-time.scm index c4d6bd9..0a39e41 100644 --- a/src/mcron/vixie-time.scm +++ b/src/mcron/vixie-time.scm @@ -1,5 +1,6 @@ ;;;; vixie-time.scm -- parse Vixie-style times ;;; Copyright © 2003 Dale Mellor +;;; Copyright © 2018 Mathieu Lirzin ;;; ;;; This file is part of GNU Mcron. ;;; @@ -17,6 +18,7 @@ ;;; along with GNU Mcron. If not, see . (define-module (mcron vixie-time) + #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (mcron job-specifier) #:use-module (srfi srfi-1) @@ -176,16 +178,17 @@ ;; simply unreadable without all of these aliases. (define (increment-time-component time time-spec) - (let* ((time-list (time-spec:list time-spec)) - (getter (time-spec:getter time-spec)) - (setter (time-spec:setter time-spec)) - (find-best-next (@@ (mcron job-specifier) %find-best-next)) - (next-best (find-best-next (getter time) time-list)) - (wrap-around (eqv? (cdr next-best) 9999))) - (setter time ((if wrap-around car cdr) next-best)) - wrap-around)) - - + (let ((time-list (time-spec:list time-spec)) + (getter (time-spec:getter time-spec)) + (setter (time-spec:setter time-spec)) + (find-best-next (@@ (mcron job-specifier) %find-best-next))) + (match (find-best-next (getter time) time-list) + ((smallest . closest+) + (let ((infinite (inf? closest+))) + (if infinite + (setter time smallest) + (setter time closest+)) + infinite))))) ;; There now follows a set of procedures for adjusting an element of time, ;; i.e. taking it to the next acceptable value. In each case, the head of the -- cgit v1.2.3