diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-04-16 23:02:13 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-04-16 23:02:13 +0200 |
commit | e45cbbc18a7ff311da92a251fb3fbbceabb7db85 (patch) | |
tree | 4f266fad689fefb33e18c761102d5d4dda037b51 /module/datetime.scm | |
parent | Fix directory-table erroring when subdirs are present. (diff) | |
download | calp-e45cbbc18a7ff311da92a251fb3fbbceabb7db85.tar.gz calp-e45cbbc18a7ff311da92a251fb3fbbceabb7db85.tar.xz |
Fix date-difference when changing year.
Previously some days in a date-difference would be dropped when the
end date was in the year after the start date.
There might be more bugs of this nature, better testing should be put in
place.
Diffstat (limited to 'module/datetime.scm')
-rw-r--r-- | module/datetime.scm | 13 |
1 files changed, 8 insertions, 5 deletions
diff --git a/module/datetime.scm b/module/datetime.scm index 0b3179ee..d74023b9 100644 --- a/module/datetime.scm +++ b/module/datetime.scm @@ -597,7 +597,6 @@ ;; #2020-01-01 #2020-00-26 → #2020-00-06 #2020-00-00 (define-values (b* a*) (let loop ((b b) (a a)) - ;; (format (current-error-port) "a=~a b=~a~%" a b) (if (> (day a) (day b)) (let ((new-a (set (day a) = (- (1+ (day b)))))) (loop (if (= 0 (month b)) @@ -608,20 +607,24 @@ ) (set-> b (month = (- 1)) - (day (1- (days-in-month (set (month b) = (- 0))))))) + (day (1- (days-in-month b))))) ; last in prev month new-a)) ;; elif (> (day b) (day a)) (values (set (day b) = (- (day a))) (set (day a) 0))))) + + ;; (day a*) should be 0 here. + (define-values (b** a**) (let loop ((b b*) (a a*)) (if (> (month a) (month b)) (loop (set-> b (year = (- 1)) (month 11) - (day 30)) - (set (month a) = (- (month b)))) + #; (day 30) + ) + (set (month a) = (- (1+ (month b))))) ;; elif (> (month b) (month a)) (values (set (month b) = (- (month a))) (set (month a) 0))))) @@ -637,7 +640,7 @@ (negative? (day b)) (negative? (month a)) (negative? (day a)) ) - (error "Negative months or days are an error")) + (error "Negative months or days are errors")) (date-difference% (set-> b (month = (- 1)) |