From bc89fa75db183ee68611218addea5c0975f0a725 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sun, 24 May 2020 22:53:17 +0200 Subject: Fix multi day overflow in time-. --- module/datetime.scm | 31 ++++++++++++++++++++----------- tests/datetime.scm | 16 +++++++++++++--- 2 files changed, 33 insertions(+), 14 deletions(-) diff --git a/module/datetime.scm b/module/datetime.scm index 5e531961..957303b7 100644 --- a/module/datetime.scm +++ b/module/datetime.scm @@ -473,8 +473,6 @@ base rest))) (values time sum)))) -;; hour is number of days we overflow (negative) -;; (time- #03:00:00 #07:00:00) ; => 20:00:00 => 1 ;; time, Δtime → time, hour (define (time-% base change) @@ -498,15 +496,24 @@ (values (set (minute target) = (- (minute change))) (set (minute change) 0))))) - - (if (>= (hour minute-fixed) (hour change)) - (values (set (hour minute-fixed) = (- (hour change))) - 0) - ;; TODO overflow more than one day - (let ((diff (- (hour change) (hour minute-fixed)))) - (values (set (hour minute-fixed) (- 24 diff)) - 1)))) - + (if (>= (hour minute-fixed) (hour change**)) + (values (set (hour minute-fixed) = (- (hour change**))) 0) + (let ((diff (- (hour minute-fixed) + (hour change**)))) + (values (set (hour minute-fixed) (modulo diff 24)) + (abs (floor (/ diff 24))))))) + +;; Goes backwards from base, returning the two values: +;; the new time, and the number of days back we went. +;; Note that neither time+ or time- can return a time +;; component greater than 24h, but nothing is stoping +;; a user from creating them manually. +;; @lisp +;; (time- #10:00:00 #09:00:00) ; => 01:00:00 => 0 +;; (time- #03:00:00 #07:00:00) ; => 20:00:00 => 1 +;; (time- #10:00:00 (time hour: 48)) ; => 10:00:00 => 2 +;; (time- #10:00:00 (time hour: (+ 48 4))) ; => 06:00:00 => 2 +;; @end lisp (define-public (time- base . rest) (let ((sum 0)) (let ((time (fold (lambda (next done) @@ -576,6 +583,7 @@ +;; NOTE, this is only properly defined when b is greater than a. (define-public (date-difference b a) (when (or (negative? (month b)) (negative? (day b)) @@ -591,6 +599,7 @@ (day = (- 1))))) +;; NOTE, this is only properly defined when end is greater than start. (define-public (datetime-difference end start) ;; NOTE Makes both start and end datetimes in the current local time. (let* ((fixed-time overflow (time- (get-time% end) diff --git a/tests/datetime.scm b/tests/datetime.scm index b678edad..c4a725e8 100644 --- a/tests/datetime.scm +++ b/tests/datetime.scm @@ -9,6 +9,7 @@ leap-year? ) ((ice-9 format) format) + ((util) let*) ) (test-equal "empty time" @@ -91,9 +92,18 @@ (date day: 5))) -(test-equal "time- self" - #00:00:00 - (time- #10:20:30 #10:20:30)) +(let* ((diff overflow (time- #10:20:30 #10:20:30))) + (test-equal "time- self" #00:00:00 diff) + (test-equal "time- self overflow" 0 overflow)) + +(let* ((diff overflow (time- #10:00:00 #10:00:01))) + (test-equal "time- overflow 1s" #23:59:59 diff) + (test-equal "time- overflow 1s overflow" 1 overflow)) + + +(let* ((diff overflow (time- #10:00:00 (time hour: (+ 48 4))))) + (test-equal "time- overflow multiple" #06:00:00 diff) + (test-equal "time- overflow multiple overflow" 2 overflow)) (test-equal "datetime-difference self" #0000-00-00T00:00:00 -- cgit v1.2.3