[report-utilities] fix gnc:account-accumulate-at-dates sorting & operator

This commit performs 2 important fixes.

1. the account splitlist walking assumes that the split->date always
increases. This is now enforced by sorting the splitlist, *only* if a
custom split->date is offered. By default the splits are sorted by
posted_date, and if a custom split->date is used, will be
stable-sorted to ensure the algorithm works.

2. the handling of splits *ON* date boundaries is fixed. Previously if
a split->date was equal to a date boundary, it would be considered
part of the "after" date section. It is more intuitive that a date
boundary includes all splits on and before the date. In regular use
the dates are normalised to canonicaldaytime or end-day-time and is
not important. However when comparing reconciled dates, the statement
dates be exactly equal to the reconciled dates, therefore this
difference is crucial. In other words, the date boundaries mean we
include all splits before or on the date (to the exact second).

Add a test to verify above.
This commit is contained in:
Christopher Lam 2020-03-24 23:53:00 +08:00
parent 33902a6793
commit 447de7f64d
2 changed files with 52 additions and 5 deletions

View File

@ -493,9 +493,14 @@ flawed. see report-utilities.scm. please update reports.")
(define* (gnc:account-accumulate-at-dates
acc dates #:key
(nosplit->elt #f)
(split->date (compose xaccTransGetDate xaccSplitGetParent))
(split->date #f)
(split->elt xaccSplitGetBalance))
(let lp ((splits (xaccAccountGetSplitList acc))
(define to-date (or split->date (compose xaccTransGetDate xaccSplitGetParent)))
(define (less? a b) (< (to-date a) (to-date b)))
(let lp ((splits (if split->date
(stable-sort! (xaccAccountGetSplitList acc) less?)
(xaccAccountGetSplitList acc)))
(dates (sort dates <))
(result '())
(last-result nosplit->elt))
@ -505,8 +510,8 @@ flawed. see report-utilities.scm. please update reports.")
(() (reverse result))
((date . rest)
(define (before-date? s) (< (split->date s) date))
(define (after-date? s) (< date (split->date s)))
(define (before-date? s) (<= (to-date s) date))
(define (after-date? s) (< date (to-date s)))
(match splits
;; end of splits, but still has dates. pad with last-result

View File

@ -644,6 +644,13 @@
(define (split->amount split)
(and split (xaccSplitGetAmount split)))
(define (set-reconcile txn date)
(for-each
(lambda (s)
(xaccSplitSetReconcile s #\y)
(xaccSplitSetDateReconciledSecs s date))
(xaccTransGetSplitList txn)))
(define (test-get-account-at-dates)
(test-group-with-cleanup "test-get-balance-at-dates"
(let* ((env (create-test-env))
@ -729,5 +736,40 @@
(test-equal "1 txn in early slot"
'(#f 10 10 10)
(gnc:account-accumulate-at-dates bank4 dates)))
(gnc:account-accumulate-at-dates bank4 dates))
;; Tests split->date sorting. note the 3 txns created below are
;; initially sorted by posted_date ie txn2 < txn3 <
;; txn1. However the reconciled_date sorting will be
;; different. The accumulator will test both the reconciled_date
;; sorting and the splits being accumulated in the correct date
;; buckets.
(let ((txn1 (env-transfer env 15 03 1971 income bank1 2))
(txn2 (env-transfer env 15 01 1971 income bank1 3))
(txn3 (env-transfer env 15 02 1971 income bank1 11)))
(define split->reconciled
(let ((accum 0))
(lambda (s)
(when (eqv? (xaccSplitGetReconcile s) #\y)
(set! accum (+ accum (xaccSplitGetAmount s))))
accum)))
(define (split->reconciled-date s)
(if (eqv? (xaccSplitGetReconcile s) #\y)
(xaccSplitGetDateReconciled s)
+inf.0))
(set-reconcile txn1 (gnc-dmy2time64 1 4 1971))
(set-reconcile txn2 (gnc-dmy2time64 1 4 1971))
(set-reconcile txn3 (gnc-dmy2time64 1 5 1971))
(test-equal "sort by reconcile-date"
'(#f 5 16)
(gnc:account-accumulate-at-dates
bank1 (list (gnc-dmy2time64 1 3 1971)
(gnc-dmy2time64 1 4 1971)
(gnc-dmy2time64 1 5 1971))
#:split->date split->reconciled-date
#:split->elt split->reconciled))))
(teardown)))