gnucash maint: sort-and-delete-duplicates: change < function to ensure dedupe works
Christopher Lam
clam at code.gnucash.org
Tue Dec 17 17:32:41 EST 2019
Updated via https://github.com/Gnucash/gnucash/commit/92509761 (commit)
from https://github.com/Gnucash/gnucash/commit/984fe658 (commit)
commit 92509761a53d5126ef2bf77d819dabd1de690f49
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue Dec 17 22:09:46 2019 +0800
sort-and-delete-duplicates: change < function to ensure dedupe works
sort-and-delete-duplicates require that the < proc can sort elements
properly.
In new-owner-report, previous used split->parent->posted_date for
sorting during call to sort-and-delete-duplicates. This does not
guarantee equal elements will be adjacent. Using xaccSplitOrder
satisfies that guarantee, and splits will be deduped properly.
Also account and commodity comparison functions similarly defined to
have consistent code.
This change will modify the output in some tests (e.g. balsheet-pnl
will now group currencies and commodities together due to
string-comparison using gnc-commodity-get-full-name) which must be
modified.
diff --git a/gnucash/report/business-reports/new-aging.scm b/gnucash/report/business-reports/new-aging.scm
index a9bb0a045..444fcde90 100644
--- a/gnucash/report/business-reports/new-aging.scm
+++ b/gnucash/report/business-reports/new-aging.scm
@@ -161,6 +161,9 @@ exist but have no suitable transactions."))
(define (gnc-owner-equal? a b)
(string=? (gncOwnerReturnGUID a) (gncOwnerReturnGUID b)))
+(define (account<? a b)
+ (< (xaccAccountOrder a b) 0))
+
(define (split-has-owner? split owner)
(let* ((split-owner (split->owner split))
(retval (gnc-owner-equal? split-owner owner)))
@@ -237,7 +240,7 @@ exist but have no suitable transactions."))
(setup-query query accounts report-date)
(let* ((splits (xaccQueryGetSplitsUniqueTrans query))
(accounts (sort-and-delete-duplicates (map xaccSplitGetAccount splits)
- gnc:account-path-less-p equal?)))
+ account<? equal?)))
(qof-query-destroy query)
;; loop into each APAR account
diff --git a/gnucash/report/business-reports/new-owner-report.scm b/gnucash/report/business-reports/new-owner-report.scm
index 7e75cae53..e53d2f5d5 100644
--- a/gnucash/report/business-reports/new-owner-report.scm
+++ b/gnucash/report/business-reports/new-owner-report.scm
@@ -181,8 +181,7 @@
(define (txn-is-payment? txn)
(eqv? (xaccTransGetTxnType txn) TXN-TYPE-PAYMENT))
(define (split<? a b)
- (< (xaccTransGetDate (xaccSplitGetParent a))
- (xaccTransGetDate (xaccSplitGetParent b))))
+ (< (xaccSplitOrder a b) 0))
(define (split-is-payment? split)
(txn-is-payment? (xaccSplitGetParent split)))
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index 5cb4d44e7..6c652ae9a 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -133,8 +133,8 @@ construct gnc:make-gnc-monetary and use gnc:monetary->string instead.")
(sort-and-delete-duplicates
(map xaccAccountGetCommodity accounts)
(lambda (a b)
- (string<? (gnc-commodity-get-mnemonic a)
- (gnc-commodity-get-mnemonic b)))
+ (string<? (gnc-commodity-get-unique-name a)
+ (gnc-commodity-get-unique-name b)))
gnc-commodity-equiv)))
@@ -155,8 +155,7 @@ construct gnc:make-gnc-monetary and use gnc:monetary->string instead.")
(define (gnc:accounts-and-all-descendants accountslist)
(sort-and-delete-duplicates
(apply append accountslist (map gnc-account-get-descendants accountslist))
- (lambda (a b)
- (string<? (gnc-account-get-full-name a) (gnc-account-get-full-name b)))
+ (lambda (a b) (< (xaccAccountOrder a b) 0))
equal?))
;;; Here's a statistics collector... Collects max, min, total, and makes
diff --git a/gnucash/report/standard-reports/test/test-balsheet-pnl.scm b/gnucash/report/standard-reports/test/test-balsheet-pnl.scm
index 96b5f7c9b..46ab45516 100644
--- a/gnucash/report/standard-reports/test/test-balsheet-pnl.scm
+++ b/gnucash/report/standard-reports/test/test-balsheet-pnl.scm
@@ -273,10 +273,10 @@
(set-option! balance-sheet-options "Display" "Parent account subtotals" 'f)
(let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-recursive")))
(test-equal "recursive. root = $760+15000+104600"
- (list "#200.00" "$340.00" "30 FUNDS" "$15,000.00" "$106,709.00" "$106,709.00")
+ '("#200.00" "$340.00" "$106,709.00" "$106,709.00" "30 FUNDS" "$15,000.00")
(sxml->table-row-col sxml 1 3 6))
(test-equal "recursive. assets = $760+15000+104600"
- (list "#200.00" "$340.00" "30 FUNDS" "$15,000.00" "$106,709.00" "$106,709.00")
+ '("#200.00" "$340.00" "$106,709.00" "$106,709.00" "30 FUNDS" "$15,000.00")
(sxml->table-row-col sxml 1 4 5))
(test-equal "recursive. bank1 = $4,709.00"
(list "$4,709.00")
@@ -294,7 +294,7 @@
(list "$100.00")
(sxml->table-row-col sxml 1 9 3))
(test-equal "recursive. broker = $15000+2000.00"
- (list "30 FUNDS" "$15,000.00" "$2,000.00" "$2,000.00")
+ '("$2,000.00" "$2,000.00" "30 FUNDS" "$15,000.00")
(sxml->table-row-col sxml 1 10 4))
(test-equal "recursive. funds = $15,000.00"
(list "30 FUNDS" "$15,000.00" "$15,000.00")
@@ -326,10 +326,10 @@
(set-option! balance-sheet-options "Commodities" "Show Exchange Rates" #t)
(let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-enable show-fcur show-rates")))
(test-equal "show-fcur enabled"
- (list "#200.00" "$340.00" "30 FUNDS" "$15,000.00" "$106,709.00" "$106,709.00")
+ '("#200.00" "$340.00" "$106,709.00" "$106,709.00" "30 FUNDS" "$15,000.00")
(sxml->table-row-col sxml 1 3 6))
(test-equal "show-rates enabled"
- (list "1 FUNDS" "$500.00" "#1.00" "$1.70")
+ '("#1.00" "$1.70" "1 FUNDS" "$500.00")
(sxml->table-row-col sxml 2 #f #f)))
;;make-multilevel
@@ -516,25 +516,25 @@
(let ((sxml (options->sxml multicol-balsheet-uuid multi-bs-options
"multicol-balsheet-halfyear")))
(test-equal "bal-1/1/70"
- '("01/01/70" "$113,100.00" "$113,100.00" "$8,970.00" "$2,000.00" "$6,870.00"
- "$0.00" "$100.00" "$4,000.00" "$2,000.00" "$2,000.00" "10 FUNDS " "$130.00"
- "$130.00" "#100.00 " "$100,000.00" "$113,100.00" "$9,500.00" "$9,500.00"
- "$500.00" "$9,000.00" "$9,500.00" "$103,600.00" "$0.00" "$0.00"
- "$103,600.00" "1 FUNDS $200.00" "#1.00 $1.30")
+ '("01/01/70" "$113,100.00" "$113,100.00" "$8,970.00" "$2,000.00"
+ "$6,870.00" "$0.00" "$100.00" "$4,000.00" "$2,000.00" "$2,000.00"
+ "10 FUNDS " "$130.00" "$130.00" "#100.00 " "$100,000.00" "$113,100.00"
+ "$9,500.00" "$9,500.00" "$500.00" "$9,000.00" "$9,500.00" "$103,600.00"
+ "$0.00" "$0.00" "$103,600.00" "#1.00 $1.30" "1 FUNDS $200.00")
(sxml->table-row-col sxml 1 #f 2))
(test-equal "bal-1/1/71"
- '("01/01/71" "$116,009.00" "$116,009.00" "$4,709.00" "$2,000.00" "$2,609.00"
- "$0.00" "$100.00" "$11,000.00" "$2,000.00" "$9,000.00" "30 FUNDS " "$300.00"
- "$300.00" "#200.00 " "$100,000.00" "$116,009.00" "$9,500.00" "$9,500.00"
- "$500.00" "$9,000.00" "$9,500.00" "$103,600.00" "$2,909.00" "$0.00"
- "$106,509.00" "1 FUNDS $300.00" "#1.00 $1.50")
+ '("01/01/71" "$116,009.00" "$116,009.00" "$4,709.00" "$2,000.00"
+ "$2,609.00" "$0.00" "$100.00" "$11,000.00" "$2,000.00" "$9,000.00"
+ "30 FUNDS " "$300.00" "$300.00" "#200.00 " "$100,000.00" "$116,009.00"
+ "$9,500.00" "$9,500.00" "$500.00" "$9,000.00" "$9,500.00" "$103,600.00"
+ "$2,909.00" "$0.00" "$106,509.00" "#1.00 $1.50" "1 FUNDS $300.00")
(sxml->table-row-col sxml 1 #f 3))
(test-equal "bal-1/1/72"
- '("01/01/72" "$117,529.00" "$117,529.00" "$4,709.00" "$2,000.00" "$2,609.00"
- "$0.00" "$100.00" "$12,500.00" "$2,000.00" "$10,500.00" "30 FUNDS " "$320.00"
- "$320.00" "#200.00 " "$100,000.00" "$117,529.00" "$9,500.00" "$9,500.00"
- "$500.00" "$9,000.00" "$9,500.00" "$103,600.00" "$4,429.00" "$0.00"
- "$108,029.00" "1 FUNDS $350.00" "#1.00 $1.60")
+ '("01/01/72" "$117,529.00" "$117,529.00" "$4,709.00" "$2,000.00"
+ "$2,609.00" "$0.00" "$100.00" "$12,500.00" "$2,000.00" "$10,500.00"
+ "30 FUNDS " "$320.00" "$320.00" "#200.00 " "$100,000.00" "$117,529.00"
+ "$9,500.00" "$9,500.00" "$500.00" "$9,000.00" "$9,500.00" "$103,600.00"
+ "$4,429.00" "$0.00" "$108,029.00" "#1.00 $1.60" "1 FUNDS $350.00")
(sxml->table-row-col sxml 1 #f 4)))
;; the following includes non-zero retained earnings of $1,270
@@ -544,12 +544,11 @@
(let ((sxml (options->sxml multicol-balsheet-uuid multi-bs-options
"multicol-balsheet-retained")))
(test-equal "bal-1/3/80"
- '("$123,319.00" "$123,319.00" "$5,129.00" "$2,000.00" "$3,029.00"
- "$0.00" "$100.00" "$17,000.00" "$2,000.00" "$15,000.00" "30 FUNDS "
- "$1,190.00" "$1,190.00" "#700.00 " "$100,000.00" "$123,319.00"
- "$9,500.00" "$9,500.00" "$500.00" "$9,000.00" "$9,500.00"
- "$103,600.00" "$8,949.00" "$1,270.00" "$113,819.00" "1 FUNDS $500.00"
- "#1.00 $1.70")
+ '("$123,319.00" "$123,319.00" "$5,129.00" "$2,000.00" "$3,029.00" "$0.00"
+ "$100.00" "$17,000.00" "$2,000.00" "$15,000.00" "30 FUNDS " "$1,190.00"
+ "$1,190.00" "#700.00 " "$100,000.00" "$123,319.00" "$9,500.00" "$9,500.00"
+ "$500.00" "$9,000.00" "$9,500.00" "$103,600.00" "$8,949.00" "$1,270.00"
+ "$113,819.00" "#1.00 $1.70" "1 FUNDS $500.00")
(sxml->table-row-col sxml 1 #f 2)))))
(define (multicol-pnl-tests)
Summary of changes:
gnucash/report/business-reports/new-aging.scm | 5 ++-
.../report/business-reports/new-owner-report.scm | 3 +-
gnucash/report/report-system/report-utilities.scm | 7 ++-
.../standard-reports/test/test-balsheet-pnl.scm | 51 +++++++++++-----------
4 files changed, 33 insertions(+), 33 deletions(-)
More information about the gnucash-changes
mailing list