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.
2025-02-25 18:55:30 -06:00 · 2019-12-17 22:09:46 +08:00 · 2019-12-17 22:09:46 +08:00 · 92509761a5
commit 92509761a5
parent 984fe65822
4 changed files with 33 additions and 33 deletions
--- 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
--- 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)))

--- 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
--- 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)