gnucash maint: Multiple changes pushed

Christopher Lam clam at code.gnucash.org
Sat Jan 18 20:24:53 EST 2020


Updated	 via  https://github.com/Gnucash/gnucash/commit/b9601e01 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/220eb952 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/e788480e (commit)
	from  https://github.com/Gnucash/gnucash/commit/073e4780 (commit)



commit b9601e012c18a72c8ab808a6043203eb255e89cf
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Sun Jan 19 03:31:53 2020 +0800

    Bug 797584 - New-owner - bill amount field links to wrong account
    
    Amounts formerly linked to the 'transfer' split which is not reliably
    determined. Link to the APAR split instead.
    
    Note whereby a payment spans multiple invoices, it'll link to the
    first APAR payment split.

diff --git a/gnucash/report/business-reports/new-owner-report.scm b/gnucash/report/business-reports/new-owner-report.scm
index c724dfc68..57aea2856 100644
--- a/gnucash/report/business-reports/new-owner-report.scm
+++ b/gnucash/report/business-reports/new-owner-report.scm
@@ -745,7 +745,7 @@
            (and (< orig-value 0) orig-value)
            (and (>= orig-value 0) orig-value)
            (invoice->sale invoice) (invoice->tax invoice)
-           (txn->transfer-split txn)
+           split
            link-option
            (cond
             ((and (txn-is-invoice? txn) (eq? link-option 'simple))

commit 220eb9529189202bee3fa7c3c290cdfb3569ca40
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Sat Jan 18 21:10:25 2020 +0800

    [new-aging] speed up by skipping several loops
    
    Consider a list of APAR splits, from N accounts. For each account,
    their splits needed to find unique valid owners.
    
    Previous algorithm would loops splits several times (1) each split
    finds its owner, and log invalid ones, and (2) delete owner
    duplicates.
    
    New algorithm will take the first split's owner, skip if invalid, then
    process all owner-splits, the reloop with other-owners-splits. The
    invalid-splits list is also managed within loops for better stack
    handling.
    
    Also use (ice-9 match) for conciseness.

diff --git a/gnucash/report/business-reports/new-aging.scm b/gnucash/report/business-reports/new-aging.scm
index 2ee5bb945..0f1e57d2c 100644
--- a/gnucash/report/business-reports/new-aging.scm
+++ b/gnucash/report/business-reports/new-aging.scm
@@ -183,6 +183,12 @@ exist but have no suitable transactions."))
     (gncOwnerFree split-owner)
     retval))
 
+(define (split-owner-is-invalid? split)
+  (let* ((owner (split->owner split))
+         (retval (not (gncOwnerIsValid owner))))
+    (gncOwnerFree owner)
+    retval))
+
 (define (split-from-acct? split acct)
   (equal? acct (xaccSplitGetAccount split)))
 
@@ -230,13 +236,8 @@ exist but have no suitable transactions."))
          (show-zeros (op-value gnc:pagename-general optname-show-zeros))
          (date-type (op-value gnc:pagename-general optname-date-driver))
          (query (qof-query-create-for-splits))
-         (invalid-splits '())
          (document (gnc:make-html-document)))
 
-    ;; for sorting and delete-duplicates. compare GUIDs
-    (define (ownerGUID<? a b)
-      (string<? (gncOwnerGetGUID a) (gncOwnerGetGUID b)))
-
     (define (sort-aging<? a b)
       (match-let* (((own1 aging1 aging-total1) a)
                    ((own2 aging2 aging-total2) b)
@@ -274,6 +275,7 @@ exist but have no suitable transactions."))
                                   (txn-is-payment? (xaccSplitGetParent split))))
                             splits))
                    (accounts-and-owners '())
+                   (invalid-splits '())
                    (tofree '()))
           (cond
            ((null? accounts)
@@ -372,61 +374,50 @@ exist but have no suitable transactions."))
 
            (else
             (let* ((account (car accounts))
-                   (splits-acc-others (list-split splits split-from-acct? account))
-                   (acc-splits (car splits-acc-others))
-                   (other-acc-splits (cdr splits-acc-others))
-                   (split-owners
-                    (fold
-                     (lambda (a b)
-                       (let ((owner (split->owner a)))
-                         (cond
-                          ((gncOwnerIsValid owner) (cons owner b))
-                          ;; some payment splits may have no owner in
-                          ;; this account. skip. see bug 797506.
-                          (else
-                           (gnc:warn "split " (gnc:strify a) " has no owner")
-                           (set! invalid-splits
-                             (cons (list (_ "Payment has no owner") a)
-                                   invalid-splits))
-                           (gncOwnerFree owner)
-                           b))))
-                     '() acc-splits))
-                   (acc-owners (sort-and-delete-duplicates
-                                split-owners ownerGUID<? gnc-owner-equal?)))
-
-              ;; loop into each APAR account split
-              (let lp ((acc-owners acc-owners)
-                       (acc-splits acc-splits)
+                   (splits-acc-others (list-split splits split-from-acct? account)))
+
+              (let lp ((acc-splits (car splits-acc-others))
                        (acc-totals (make-list (1+ num-buckets) 0))
+                       (invalid-splits invalid-splits)
+                       (tofree tofree)
                        (owners-and-aging '()))
-                (cond
-                 ((null? acc-owners)
-                  (loop (cdr accounts)
-                        other-acc-splits
-                        (if (null? owners-and-aging)
-                            accounts-and-owners
-                            (cons (list account owners-and-aging acc-totals)
-                                  accounts-and-owners))
-                        (append-reverse tofree split-owners)))
-
-                 (else
-                  (let* ((owner (car acc-owners))
-                         (splits-own-others (list-split acc-splits split-has-owner?
-                                                        owner))
-                         (owner-splits (car splits-own-others))
-                         (other-owner-splits (cdr splits-own-others))
-                         (aging (gnc:owner-splits->aging-list
-                                 owner-splits num-buckets report-date
-                                 date-type receivable))
-                         (aging-total (apply + aging)))
-                    (lp (cdr acc-owners)
-                        other-owner-splits
-                        (map + acc-totals
-                             (reverse (cons aging-total aging)))
-                        (if (or show-zeros (not (every zero? aging)))
-                            (cons (list owner aging aging-total)
-                                  owners-and-aging)
-                            owners-and-aging)))))))))))))
+
+                (match acc-splits
+                  (()
+                   (loop (cdr accounts)
+                         (cdr splits-acc-others)
+                         (if (null? owners-and-aging)
+                             accounts-and-owners
+                             (cons (list account owners-and-aging acc-totals)
+                                   accounts-and-owners))
+                         invalid-splits
+                         tofree))
+
+                  ;; some payment splits may have no owner in this
+                  ;; account. skip. see bug 797506.
+                  (((? split-owner-is-invalid? this) . rest)
+                   (gnc:warn "split " this " has no owner")
+                   (lp rest
+                       acc-totals
+                       (cons (list (_ "Payment has no owner") this) invalid-splits)
+                       tofree
+                       owners-and-aging))
+
+                  ((this . _)
+                   (match-let* ((owner (split->owner this))
+                                ((owner-splits . other-owner-splits)
+                                 (list-split acc-splits split-has-owner? owner))
+                                (aging (gnc:owner-splits->aging-list
+                                        owner-splits num-buckets report-date
+                                        date-type receivable))
+                                (aging-total (apply + aging)))
+                     (lp other-owner-splits
+                         (map + acc-totals (reverse (cons aging-total aging)))
+                         invalid-splits
+                         (cons owner tofree)
+                         (if (or show-zeros (any (negate zero?) aging))
+                             (cons (list owner aging aging-total) owners-and-aging)
+                             owners-and-aging)))))))))))))
     (gnc:report-finished)
     document))
 

commit e788480e34a09e2469b876953c61c2d652245eb9
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Sat Jan 18 22:26:58 2020 +0800

    [new-aging] replace split->lot->split->lot with split->lot
    
    remove unnecessary call to get earliest-split

diff --git a/gnucash/report/business-reports/new-aging.scm b/gnucash/report/business-reports/new-aging.scm
index 5dd4b0831..2ee5bb945 100644
--- a/gnucash/report/business-reports/new-aging.scm
+++ b/gnucash/report/business-reports/new-aging.scm
@@ -193,7 +193,7 @@ exist but have no suitable transactions."))
 ;; simpler version of gnc:owner-from-split. must be gncOwnerFree after
 ;; use! see split-has-owner? above...
 (define (split->owner split)
-  (let* ((lot (xaccSplitGetLot (gnc-lot-get-earliest-split (xaccSplitGetLot split))))
+  (let* ((lot (xaccSplitGetLot split))
          (owner (gncOwnerNew))
          (use-lot-owner? (gncOwnerGetOwnerFromLot lot owner)))
     (unless use-lot-owner?



Summary of changes:
 gnucash/report/business-reports/new-aging.scm      | 109 ++++++++++-----------
 .../report/business-reports/new-owner-report.scm   |   2 +-
 2 files changed, 51 insertions(+), 60 deletions(-)



More information about the gnucash-changes mailing list