gnucash stable: Multiple changes pushed
John Ralls
jralls at code.gnucash.org
Fri Sep 15 14:33:51 EDT 2023
Updated via https://github.com/Gnucash/gnucash/commit/69149514 (commit)
via https://github.com/Gnucash/gnucash/commit/04545fab (commit)
from https://github.com/Gnucash/gnucash/commit/a8dffb85 (commit)
commit 69149514b52c20fc9dd59625a9f8ff1008ca85f5
Merge: a8dffb8559 04545fab11
Author: John Ralls <jralls at ceridwen.us>
Date: Fri Sep 15 11:33:22 2023 -0700
Merge Jeff Shelley's 'issue/728910' into stable.
commit 04545fab117173bcbd7ea05d547f67831201efca
Author: Jeff Shelley <hea45992 at adobe.com>
Date: Wed Aug 23 09:08:21 2023 -0500
728910: Made report handle liabilities correctly
diff --git a/gnucash/report/reports/standard/budget-balance-sheet.scm b/gnucash/report/reports/standard/budget-balance-sheet.scm
index b215874267..a4c3649c20 100644
--- a/gnucash/report/reports/standard/budget-balance-sheet.scm
+++ b/gnucash/report/reports/standard/budget-balance-sheet.scm
@@ -224,8 +224,7 @@
(gnc:report-options report-obj) pagename optname))
(define (get-budget-account-budget-balance budget account)
- (let ((bal (gnc:budget-account-get-net budget account #f #f)))
- (if (gnc-reverse-balance account) (gnc:collector- bal) bal)))
+ (gnc:budget-account-get-net budget account #f #f))
(define (get-budget-account-initial-balance budget account)
(gnc:budget-account-get-initial-balance budget account))
@@ -248,6 +247,20 @@
(budget (gnc:select-assoc-account-balance budget-balances account)))
(and initial budget (gnc:collector+ initial budget))))
+ (define (make-sign-handler accounts)
+ (if (null? accounts)
+ identity
+ (lambda (bal)
+ (if (gnc-reverse-balance (car accounts)) (gnc:collector- bal) bal))))
+
+
+ (define (make-get-balance-fn initial-balances budget-balances)
+ (lambda (account start-date end-date)
+ (sum-prefetched-account-balances-for-account
+ initial-balances
+ budget-balances
+ account)))
+
(gnc:report-starting reportname)
;; get all option's values
@@ -309,7 +322,7 @@
(income-accounts (assoc-ref split-up-accounts ACCT-TYPE-INCOME))
(expense-accounts (assoc-ref split-up-accounts ACCT-TYPE-EXPENSE))
(equity-accounts (assoc-ref split-up-accounts ACCT-TYPE-EQUITY))
-
+ (liability-sign-handler (make-sign-handler liability-accounts))
(doc (gnc:make-html-document))
;; this can occasionally put extra (blank) columns in our
;; table (when there is one account at the maximum depth and
@@ -371,19 +384,16 @@
(existing-assets #f)
(allocated-assets #f)
(unallocated-assets #f)
- (asset-get-balance-fn #f)
(existing-liabilities #f)
(new-liabilities #f)
(liability-repayments #f)
(liability-balance #f)
- (liability-get-balance-fn #f)
(unrealized-gain #f)
(existing-equity #f)
(new-equity #f)
(equity-balance #f)
- (equity-get-balance-fn #f)
(new-retained-earnings #f)
(existing-retained-earnings #f)
@@ -424,13 +434,6 @@
asset-accounts
get-budget-account-budget-balance))
- (set! asset-get-balance-fn
- (lambda (account start-date end-date)
- (sum-prefetched-account-balances-for-account
- asset-account-initial-balances
- asset-account-budget-balances
- account)))
-
(gnc:report-percent-done 6)
@@ -449,12 +452,6 @@
liability-accounts
get-budget-account-budget-balance))
- (set! liability-get-balance-fn
- (lambda (account start-date end-date)
- (sum-prefetched-account-balances-for-account
- liability-account-initial-balances
- liability-account-budget-balances
- account)))
(gnc:report-percent-done 8)
@@ -474,28 +471,17 @@
equity-accounts
get-budget-account-budget-balance))
- (set! equity-get-balance-fn
- (lambda (account start-date end-date)
- (sum-prefetched-account-balances-for-account
- equity-account-initial-balances
- equity-account-budget-balances
- account)))
-
(gnc:report-percent-done 10)
- ;; Existing liabilities must be negated.
+ ;; Existing liabilities prior to the first budget period
(set! existing-liabilities
- (get-assoc-account-balances-total-negated liability-account-initial-balances))
+ (gnc:get-assoc-account-balances-total liability-account-initial-balances))
- ;; Budgeted liabilities are liability repayments (negative liabilities).
- (set! liability-repayments
- (gnc:get-assoc-account-balances-total liability-account-budget-balances))
-
- ;; New liabilities are then negated liability repayments.
+ ;; New liabilities are the sum of the liabilities changes projected in the budget itself
(set! new-liabilities
- (gnc:commodity-collector-get-negated liability-repayments))
+ (gnc:get-assoc-account-balances-total liability-account-budget-balances))
;; Total liabilities.
(set! liability-balance
@@ -516,8 +502,9 @@
;; Total new retained earnings.
(set! new-retained-earnings
(gnc:collector-
- (get-budget-accountlist-budget-balance budget income-accounts)
- (get-budget-accountlist-budget-balance budget expense-accounts)))
+ (gnc:collector+
+ (get-budget-accountlist-budget-balance budget income-accounts)
+ (get-budget-accountlist-budget-balance budget expense-accounts))))
;; Total retained earnings.
(set! retained-earnings
@@ -537,11 +524,11 @@
;; Total unallocated assets.
;; unallocated-assets =
- ;; new-retained-earnings - allocated-assets - liability-repayments
+ ;; new-retained-earnings - (allocated-assets + new-liabilities)
(set! unallocated-assets
- (gnc:collector- new-retained-earnings
- allocated-assets
- liability-repayments))
+ (gnc:collector-
+ new-retained-earnings
+ (gnc:collector+ allocated-assets new-liabilities)))
;; Total assets.
(set! asset-balance
@@ -557,9 +544,8 @@
(gnc:accounts-get-comm-total-assets
asset-accounts get-total-value-fn))
(liability-basis
- (gnc:collector-
(gnc:accounts-get-comm-total-assets
- liability-accounts get-total-value-fn))))
+ liability-accounts get-total-value-fn)))
(set! unrealized-gain
(gnc:collector-
@@ -587,7 +573,7 @@
;; Total liability + equity.
(set! liability-plus-equity
- (gnc:collector+ liability-balance equity-balance))
+ (gnc:collector+ (gnc:collector- liability-balance) equity-balance))
(gnc:report-percent-done 30)
@@ -633,7 +619,12 @@
(if label-assets? (add-subtotal-line left-table (G_ "Assets") #f #f))
(set! asset-table
(gnc:make-html-acct-table/env/accts
- (append table-env (list (list 'get-balance-fn asset-get-balance-fn)))
+ (append table-env
+ (list
+ (list 'get-balance-fn
+ (make-get-balance-fn
+ asset-account-initial-balances
+ asset-account-budget-balances))))
asset-accounts))
(gnc:html-table-add-account-balances left-table asset-table params)
@@ -664,8 +655,13 @@
(set! liability-table
(gnc:make-html-acct-table/env/accts
(append table-env
- (list (list 'get-balance-fn liability-get-balance-fn)))
+ (list
+ (list 'get-balance-fn
+ (make-get-balance-fn
+ liability-account-initial-balances
+ liability-account-budget-balances))))
liability-accounts))
+
(gnc:html-table-add-account-balances
right-table liability-table params)
(if total-liabilities?
@@ -673,16 +669,13 @@
(if new-existing?
(begin
(add-subtotal-line
- right-table
- (G_ "Existing Liabilities")
- #f
- existing-liabilities)
+ right-table (G_ "Existing Liabilities") #f (liability-sign-handler existing-liabilities))
(add-subtotal-line
- right-table (G_ "New Liabilities") #f new-liabilities)))
+ right-table (G_ "New Liabilities") #f (liability-sign-handler new-liabilities))))
(add-subtotal-line
- right-table (G_ "Total Liabilities") #f liability-balance)))
+ right-table (G_ "Total Liabilities") #f (liability-sign-handler liability-balance))))
(add-rule right-table)
@@ -693,8 +686,13 @@
(set! equity-table
(gnc:make-html-acct-table/env/accts
(append table-env
- (list (list 'get-balance-fn equity-get-balance-fn)))
+ (list
+ (list 'get-balance-fn
+ (make-get-balance-fn
+ equity-account-initial-balances
+ equity-account-budget-balances))))
equity-accounts))
+
(gnc:html-table-add-account-balances
right-table equity-table params)
diff --git a/gnucash/report/reports/standard/test/test-budget.scm b/gnucash/report/reports/standard/test/test-budget.scm
index ac032ba930..81f45e3cdd 100644
--- a/gnucash/report/reports/standard/test/test-budget.scm
+++ b/gnucash/report/reports/standard/test/test-budget.scm
@@ -43,15 +43,15 @@
(define (run-test)
(test-runner-factory gnc:test-runner)
(test-begin "budget")
- (test-group-with-cleanup "budget.scm"
- (test-budget)
- (teardown))
+ (test-group-with-cleanup "budget.scm"
+ (test-budget)
+ (teardown))
(test-group-with-cleanup "budget-income-statement.scm"
(test-budget-income-statement)
(teardown))
(test-group-with-cleanup "budget-balance-sheet.scm"
- (test-budget-balance-sheet)
- (teardown))
+ (test-budget-balance-sheet)
+ (teardown))
(test-end "budget"))
(define (set-option options page tag value)
@@ -205,15 +205,15 @@
(sxml->table-row-col sxml 1 9 #f))
(test-equal "unallocated assets"
- '("Unallocated Assets" "-$405.00")
+ '("Unallocated Assets" "-$15.00")
(sxml->table-row-col sxml 1 10 #f))
(test-equal "total assets"
- '("Total Assets" "$2,833.00")
+ '("Total Assets" "$3,223.00")
(sxml->table-row-col sxml 1 11 #f))
(test-equal "existing liab"
- '("Existing Liabilities" "$3.00")
+ '("Existing Liabilities" "-$3.00")
(sxml->table-row-col sxml 1 16 #f))
(test-equal "new liab"
@@ -221,15 +221,15 @@
(sxml->table-row-col sxml 1 17 #f))
(test-equal "total liab"
- '("Total Liabilities" "$3.00")
+ '("Total Liabilities" "-$3.00")
(sxml->table-row-col sxml 1 18 #f))
(test-equal "retained earnings"
'("Existing Retained Earnings" "$3,227.00")
(sxml->table-row-col sxml 1 22 #f))
- (test-equal "retained losses"
- '("New Retained Losses" "$285.00")
+ (test-equal "retained earnings"
+ '("New Retained Earnings" "$105.00")
(sxml->table-row-col sxml 1 23 #f))
(test-equal "unrealized losses"
@@ -241,14 +241,14 @@
(sxml->table-row-col sxml 1 25 #f))
(test-equal "new equity"
- '("New Equity" "-$285.00")
+ '("New Equity" "$105.00")
(sxml->table-row-col sxml 1 26 #f))
(test-equal "total equity"
- '("Total Equity" "$2,830.00")
+ '("Total Equity" "$3,220.00")
(sxml->table-row-col sxml 1 27 #f))
(test-equal "total liab and equity"
- '("Total Liabilities & Equity" "$2,833.00")
+ '("Total Liabilities & Equity" "$3,223.00")
(sxml->table-row-col sxml 1 29 #f)))))
Summary of changes:
.../reports/standard/budget-balance-sheet.scm | 102 ++++++++++-----------
.../report/reports/standard/test/test-budget.scm | 28 +++---
2 files changed, 64 insertions(+), 66 deletions(-)
More information about the gnucash-changes
mailing list