From 3aba4d2dd8fc9e9b59ff2412a562f587c6d84c54 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Thu, 8 Feb 2018 21:55:08 +0800 Subject: [PATCH] bug 793278 fix for maint This is caused by commit 766e74096 - min-date was erroneously thought to mean 'min date of date-list' but actually meant 'negative infinity date'. This commit changes date comparison logic to always return #t when comparing (gnc:timepair-le min-date date) for the first date interval. Test case also created. --- .../report-system/report-collectors.scm | 5 +- .../test/test-generic-category-report.scm | 50 +++++++++++++++++++ 2 files changed, 53 insertions(+), 2 deletions(-) diff --git a/src/report/report-system/report-collectors.scm b/src/report/report-system/report-collectors.scm index b4415e5d8b..992a447eac 100644 --- a/src/report/report-system/report-collectors.scm +++ b/src/report/report-system/report-collectors.scm @@ -94,7 +94,8 @@ (slotset (make-slotset (lambda (split) (let* ((date (split->date split)) (interval-index (binary-search-lt (lambda (pair date) - (gnc:timepair-le (car pair) date)) + (or (not (car pair)) + (gnc:timepair-le (car pair) date))) (cons date 0) date-vector)) (interval (vector-ref date-vector interval-index))) @@ -155,7 +156,7 @@ (list min-date max-date datepairs))) (define (category-report-dates-accumulate dates) - (let* ((min-date (decdate (car (list-min-max dates gnc:timepair-lt)) DayDelta)) + (let* ((min-date #f) (max-date (cdr (list-min-max dates gnc:timepair-lt))) (datepairs (reverse! (cdr (fold (lambda (next acc) (let ((prev (car acc)) diff --git a/src/report/standard-reports/test/test-generic-category-report.scm b/src/report/standard-reports/test/test-generic-category-report.scm index e5a0473829..f5717aae6e 100644 --- a/src/report/standard-reports/test/test-generic-category-report.scm +++ b/src/report/standard-reports/test/test-generic-category-report.scm @@ -64,6 +64,7 @@ (and (null-test asset-report-uuid) (null-test liability-report-uuid) (asset-test asset-report-uuid) + (liability-test liability-report-uuid) #t)) ;; No real test here, just confirm that no exceptions are thrown @@ -241,3 +242,52 @@ (= (/ (* row-count (+ row-count 1)) 2) (string->number (car (tbl-ref tbl (- row-count 1) 1)))) #t))))))) + +(define (liability-test uuid) + ;; this test is tailored for bug 793278 + ;; except we can't use $10,000 because the string->number + ;; function cannot handle thousand separators. Use $100. + (let* ((liability-template (gnc:find-report-template uuid)) + (liability-options (gnc:make-report-options uuid)) + (liability-report (constructor uuid "bar" liability-options + #t #t #f #f "")) + (liability-renderer (gnc:report-template-renderer liability-template))) + (let* ((env (create-test-env)) + (asset--acc (env-create-root-account env ACCT-TYPE-ASSET (gnc-default-report-currency))) + (liabil-acc (env-create-root-account env ACCT-TYPE-CREDIT (gnc-default-report-currency))) + (income-acc (env-create-root-account env ACCT-TYPE-INCOME (gnc-default-report-currency)))) + (env-create-transaction env (gnc-dmy2timespec 01 10 2016) asset--acc liabil-acc (gnc:make-gnc-numeric 100 1)) ;loan + (env-create-transaction env (gnc-dmy2timespec 01 01 2017) asset--acc income-acc (gnc:make-gnc-numeric 10 1)) ;salary#1 + (env-create-transaction env (gnc-dmy2timespec 02 01 2017) liabil-acc asset--acc (gnc:make-gnc-numeric 9 1)) ;repay#1 + (env-create-transaction env (gnc-dmy2timespec 01 02 2017) asset--acc income-acc (gnc:make-gnc-numeric 10 1)) ;salary#2 + (env-create-transaction env (gnc-dmy2timespec 02 02 2017) liabil-acc asset--acc (gnc:make-gnc-numeric 9 1)) ;repay#2 + (env-create-transaction env (gnc-dmy2timespec 01 03 2017) asset--acc income-acc (gnc:make-gnc-numeric 10 1)) ;salary#3 + (env-create-transaction env (gnc-dmy2timespec 02 03 2017) liabil-acc asset--acc (gnc:make-gnc-numeric 9 1)) ;repay#3 + (env-create-transaction env (gnc-dmy2timespec 01 04 2017) asset--acc income-acc (gnc:make-gnc-numeric 10 1)) ;salary#4 + (env-create-transaction env (gnc-dmy2timespec 02 04 2017) liabil-acc asset--acc (gnc:make-gnc-numeric 9 1)) ;repay#4 + (env-create-transaction env (gnc-dmy2timespec 01 05 2017) asset--acc income-acc (gnc:make-gnc-numeric 10 1)) ;salary#5 + (env-create-transaction env (gnc-dmy2timespec 02 05 2017) liabil-acc asset--acc (gnc:make-gnc-numeric 9 1)) ;repay#5 + (begin + (set-option liability-report gnc:pagename-display "Show table" #t) + (set-option liability-report gnc:pagename-general "Start Date" (cons 'absolute (gnc-dmy2timespec 01 01 2017))) + (set-option liability-report gnc:pagename-general "End Date" (cons 'absolute (gnc-dmy2timespec 31 12 2018))) + (set-option liability-report gnc:pagename-general "Step Size" 'MonthDelta) + (set-option liability-report gnc:pagename-general "Price Source" 'pricedb-nearest) + (set-option liability-report gnc:pagename-general "Report's currency" (gnc-default-report-currency)) + (set-option liability-report gnc:pagename-accounts "Accounts" (list liabil-acc)) + (set-option liability-report gnc:pagename-accounts "Show Accounts until level" 'all) + (let ((doc (liability-renderer liability-report))) + (gnc:html-document-set-style-sheet! doc (gnc:report-stylesheet liability-report)) + (let* ((html-document (gnc:html-document-render doc #f)) + (columns (columns-from-report-document html-document)) + (tbl (stream->list + (pattern-streamer "" + (list (list " ([0-9][0-9])/([0-9][0-9])/([0-9][0-9])" 1 2 3) + (list " [^0-9]*([^<]*)" 1)) + html-document))) + (row-count (tbl-row-count tbl))) + (format #t "\nrender:\n~a\n" html-document) + (and (= 2 (length columns)) + (= 100 (string->number (car (tbl-ref tbl 0 1)))) + (= 55 (string->number (car (tbl-ref tbl (- row-count 1) 1)))) + #t)))))))