Bug 639049 - Asset Barchart Report includes also the first day of next month transactions

If the original date is an end-of-month date, we take it as an
indicator they always want monthdelta dates to be end-of-months.

This works for monthly/quarterly/halfyearly/annual.

Addendum to commit 65bfeaf5de which was
deemed to be an incomplete fix.

Also I'd forgotten to activate a test in test-date-utilities. Enable it.
This commit is contained in:
christopherlam 2019-03-21 18:52:23 +08:00
parent ee9f1d5efa
commit d711cc35f8
2 changed files with 27 additions and 3 deletions

View File

@ -215,6 +215,13 @@
(define (gnc:time64-ge-date t1 t2)
(gnc:time64-le-date t2 t1))
;; returns #t if adding 1 to mday causes a month change.
(define (end-month? date)
(let ((nextdate (gnc-localtime date)))
(set-tm:mday nextdate (1+ (tm:mday nextdate)))
(not (= (tm:mon (gnc-localtime (gnc-mktime nextdate)))
(tm:mon (gnc-localtime date))))))
(define (incdate-months date nmonths)
(let* ((new-date (gnc-localtime date))
(newmonth (+ (tm:mon new-date) nmonths))
@ -225,9 +232,14 @@
(let loop ((new-mday (tm:mday new-date)))
(set-tm:mday new-date new-mday)
(let ((res (gnc-mktime new-date)))
(if (= new-month-proper (tm:mon (gnc-localtime res)))
res
(loop (1- new-mday)))))))
(cond
;; next date causes a date slip. reduce mday.
((not (= new-month-proper (tm:mon (gnc-localtime res))))
(loop (1- new-mday)))
;; orig date is month-end. ensure all dates are month-ends.
((and (end-month? date) (not (end-month? res)))
(loop (1+ new-mday)))
(else res))))))
;; Build a list of time intervals.
;;

View File

@ -8,6 +8,7 @@
(test-runner-factory gnc:test-runner)
(test-begin "test-date-utilities.scm")
(test-weeknum-calculator)
(test-make-date-list)
(test-date-get-quarter-string)
(test-end "test-date-utilities.scm"))
@ -77,6 +78,17 @@
(create-time64 '(1970 1 15 0 0 1))
WeekDelta))
(test-equal "make-date-list start 30-nov monthly. all dates are month-ends."
(list (create-time64 '(1970 11 30 0 0 1))
(create-time64 '(1970 12 31 0 0 1))
(create-time64 '(1971 1 31 0 0 1))
(create-time64 '(1971 2 28 0 0 1))
(create-time64 '(1971 3 15 0 0 1)))
(gnc:make-date-list
(create-time64 '(1970 11 30 0 0 1))
(create-time64 '(1971 3 15 0 0 1))
MonthDelta))
(test-equal "make-date-list 31-dec-1970 to 15-4-1972 monthly including leapyear"
(list (create-time64 '(1970 12 31 0 0 1))
(create-time64 '(1971 1 31 0 0 1))