gnucash maint: Multiple changes pushed

Christopher Lam clam at code.gnucash.org
Tue Nov 26 07:52:39 EST 2019


Updated	 via  https://github.com/Gnucash/gnucash/commit/ff298b36 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/88644451 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/119fdc36 (commit)
	from  https://github.com/Gnucash/gnucash/commit/0973d54d (commit)



commit ff298b365f83346e68638abf530d022e8367c459
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Tue Nov 26 18:18:14 2019 +0800

    [test-balsheet-pnl] add multicol-balsheet and multicol-pnl tests
    
    This commit adds tests for multicolumn balance-sheet and
    income-statement. It mainly tests:
    
    * multiple periods
    * unrealized gains calculators
    * amounts/balances are predictable

diff --git a/gnucash/report/standard-reports/test/test-balsheet-pnl.scm b/gnucash/report/standard-reports/test/test-balsheet-pnl.scm
index 1ffdf1e6a..9fa490a88 100644
--- a/gnucash/report/standard-reports/test/test-balsheet-pnl.scm
+++ b/gnucash/report/standard-reports/test/test-balsheet-pnl.scm
@@ -3,6 +3,8 @@
 (use-modules (gnucash engine test test-extras))
 (use-modules (gnucash report standard-reports balance-sheet))
 (use-modules (gnucash report standard-reports income-statement))
+(use-modules (gnucash report standard-reports balsheet-pnl))
+(use-modules (gnucash report standard-reports transaction))
 (use-modules (gnucash report stylesheets))
 (use-modules (gnucash report report-system))
 (use-modules (gnucash report report-system test test-extras))
@@ -15,6 +17,8 @@
 
 (define balance-sheet-uuid "c4173ac99b2b448289bf4d11c731af13")
 (define pnl-uuid "0b81a3bdfd504aff849ec2e8630524bc")
+(define multicol-balsheet-uuid "065d5d5a77ba11e8b31e83ada73c5eea")
+(define multicol-pnl-uuid "0e94fd0277ba11e8825d43e27232c9d4")
 
 ;; Explicitly set locale to make the report output predictable
 (setlocale LC_ALL "C")
@@ -26,6 +30,8 @@
   (create-test-data)
   (balance-sheet-tests)
   (pnl-tests)
+  (multicol-balsheet-tests)
+  (multicol-pnl-tests)
   (test-end "balsheet and profit&loss"))
 
 (define (options->sxml uuid options test-title)
@@ -465,3 +471,113 @@
     ;;make-multilevel
     (set-option! pnl-options "Display" "Parent account balances" 'immediate-bal)
     (set-option! pnl-options "Display" "Parent account subtotals" 't)))
+
+(define (multicol-balsheet-tests)
+  (define (default-testing-options)
+    (let ((options (gnc:make-report-options multicol-balsheet-uuid)))
+      (set-option! options "General" "Start Date"
+                   (cons 'absolute (gnc-dmy2time64 1 1 1970)))
+      (set-option! options "General" "End Date"
+                   (cons 'absolute (gnc-dmy2time64 1 1 1972)))
+      (set-option! options "General" "Enable dual columns" #f)
+      (set-option! options "General" "Disable amount indenting" #t)
+      (set-option! options "Display" "Account full name instead of indenting" #t)
+      (set-option! options "Accounts" "Levels of Subaccounts" 'all)
+      (set-option! options "Commodities" "Show Exchange Rates" #t)
+      options))
+  (display "\n\n multicol-balsheet tests\n\n")
+  (let* ((multi-bs-options (default-testing-options))
+         (sxml (options->sxml multicol-balsheet-uuid multi-bs-options
+                              "multicol-balsheet-default")))
+    (test-equal "default row headers"
+      '("Asset" "Root" "Root.Asset" "Root.Asset.Bank1" "Root.Asset.Bank1.Bonds"
+        "Root.Asset.Bank1.Current" "Root.Asset.Bank1.Empty" "Root.Asset.Bank1.Savings"
+        "Root.Asset.Broker" "Root.Asset.Broker" "Root.Asset.Broker.Funds"
+        "Root.Asset.ForeignBank" "Root.Asset.ForeignBank.ForeignSavings"
+        "Root.Asset.House" "Total For Asset" "Liability" "Root.Liability"
+        "Root.Liability.Bank2" "Root.Liability.Bank2.CreditCard"
+        "Root.Liability.Bank2.Loan" "Total For Liability" "Equity" "Root.Equity"
+        "Unrealized Gains" "Retained Earnings" "Total For Equity")
+      (sxml->table-row-col sxml 1 #f 1))
+    (test-equal "default balances"
+      '("#200.00" "$106,709.00" "30 FUNDS" "#200.00" "$106,709.00" "30 FUNDS"
+        "$4,709.00" "$2,000.00" "$2,609.00" "$0.00" "$100.00" "$2,000.00"
+        "30 FUNDS" "$2,000.00" "30 FUNDS" "#200.00" "#200.00" "$100,000.00"
+        "30 FUNDS" "#200.00" "$106,709.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"
+        "#0.00")
+      (sxml->table-row-col sxml 1 #f 2))
+
+    ;; the following tests many parts of multicolumn balance sheet:
+    ;; multiple-dates balances, unrealized-gain calculator, pricelists
+    (set-option! multi-bs-options "General" "Period duration" 'YearDelta)
+    (set-option! multi-bs-options "Commodities" "Common Currency" #t)
+    (set-option! multi-bs-options "Commodities" "Report's currency" USD)
+    (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")
+        (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")
+        (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")
+        (sxml->table-row-col sxml 1 #f 4)))))
+
+(define (multicol-pnl-tests)
+  (define (default-testing-options)
+    (let ((options (gnc:make-report-options multicol-pnl-uuid)))
+      (set-option! options "General" "Start Date"
+                   (cons 'absolute (gnc-dmy2time64 1 1 1980)))
+      (set-option! options "General" "End Date"
+                   (cons 'absolute (gnc-dmy2time64 31 3 1980)))
+      (set-option! options "General" "Enable dual columns" #f)
+      (set-option! options "General" "Disable amount indenting" #t)
+      (set-option! options "Display" "Account full name instead of indenting" #t)
+      (set-option! options "Accounts" "Levels of Subaccounts" 'all)
+      (set-option! options "Commodities" "Show Exchange Rates" #t)
+      options))
+  (display "\n\n multicol-pnl tests\n\n")
+  (let* ((multi-bs-options (default-testing-options))
+         (sxml (options->sxml multicol-pnl-uuid multi-bs-options
+                              "multicol-pnl-default")))
+    (test-equal "default row headers"
+      '("Income" "Root.Income" "Root.Income" "Root.Income.Income-GBP"
+        "Total For Income")
+      (sxml->table-row-col sxml 1 #f 1))
+    (test-equal "default pnl"
+      '("$250.00" "#600.00" "$250.00" "#600.00" "$250.00" "#600.00")
+      (sxml->table-row-col sxml 1 #f 2))
+
+    ;; the following tests many parts of multicolumn pnl:
+    ;; multiple-dates pnl
+    (set-option! multi-bs-options "General" "Period duration" 'MonthDelta)
+    (set-option! multi-bs-options "Commodities" "Common Currency" #t)
+    (set-option! multi-bs-options "Commodities" "Report's currency" USD)
+    (let ((sxml (options->sxml multicol-pnl-uuid multi-bs-options
+                               "multicol-pnl-halfyear")))
+      (test-equal "pnl-1/80"
+        '("01/01/80" " to 01/31/80" "$1,100.00" "$250.00" "$850.00" "#500.00 "
+          "$1,100.00" "#1.00 $1.70")
+        (sxml->table-row-col sxml 1 #f 2))
+      (test-equal "pnl-2/80"
+        '("02/01/80" " to 02/29/80" "$170.00" "$0.00" "$170.00" "#100.00 "
+          "$170.00" "#1.00 $1.70")
+        (sxml->table-row-col sxml 1 #f 3))
+      (test-equal "pnl-3/80"
+        '("03/01/80" " to 03/31/80" "$0.00" "$0.00" "$0.00" "#0.00 "
+          "$0.00" "#1.00 $1.70")
+        (sxml->table-row-col sxml 1 #f 4)))))

commit 88644451ef29089c139a3ca643d3e5fbda04f4b6
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Tue Nov 26 18:11:15 2019 +0800

    [test-balsheet-pnl] separate balance-sheet and pnl tests
    
    This is in preparation for balsheet-pnl tests. Note all tests use same
    data -- there's no (teardown).

diff --git a/gnucash/report/standard-reports/test/test-balsheet-pnl.scm b/gnucash/report/standard-reports/test/test-balsheet-pnl.scm
index 8fed4fac5..1ffdf1e6a 100644
--- a/gnucash/report/standard-reports/test/test-balsheet-pnl.scm
+++ b/gnucash/report/standard-reports/test/test-balsheet-pnl.scm
@@ -23,7 +23,9 @@
   (test-runner-factory gnc:test-runner)
   (test-begin "balsheet and profit&loss")
   (null-test)
-  (balsheet-pnl-tests)
+  (create-test-data)
+  (balance-sheet-tests)
+  (pnl-tests)
   (test-end "balsheet and profit&loss"))
 
 (define (options->sxml uuid options test-title)
@@ -80,7 +82,7 @@
   (let ((balance-sheet-options (gnc:make-report-options balance-sheet-uuid)))
     (test-assert "null-test" (options->sxml balance-sheet-uuid balance-sheet-options "null-test"))))
 
-(define (balsheet-pnl-tests)
+(define (create-test-data)
   ;; This function will perform implementation testing on the transaction report.
   (let* ((env (create-test-env))
          (account-alist (env-create-account-structure-alist env structure))
@@ -95,23 +97,7 @@
          (bank2creditcard (cdr (assoc "CreditCard" account-alist)))
          (equity (cdr (assoc "Equity" account-alist)))
          (income (cdr (assoc "Income" account-alist)))
-         (income-GBP (cdr (assoc "Income-GBP" account-alist)))
-         (YEAR (gnc:time64-get-year (gnc:get-today))))
-
-    (define (default-balsheet-testing-options)
-      (let ((balance-sheet-options (gnc:make-report-options balance-sheet-uuid)))
-        (set-option! balance-sheet-options "General" "Balance Sheet Date" (cons 'absolute (gnc-dmy2time64 1 1 1971)))
-        (set-option! balance-sheet-options "Accounts" "Levels of Subaccounts" 'all)
-        (set-option! balance-sheet-options "Commodities" "Show Exchange Rates" #t)
-        balance-sheet-options))
-
-    (define (default-pnl-testing-options)
-      (let ((pnl-options (gnc:make-report-options pnl-uuid)))
-        (set-option! pnl-options "General" "Start Date" (cons 'absolute (gnc-dmy2time64 1 1 1980)))
-        (set-option! pnl-options "General" "End Date" (cons 'absolute (gnc-dmy2time64 1 1 1981)))
-        (set-option! pnl-options "Accounts" "Levels of Subaccounts" 'all)
-        (set-option! pnl-options "Commodities" "Show Exchange Rates" #t)
-        pnl-options))
+         (income-GBP (cdr (assoc "Income-GBP" account-alist))))
 
     ;; $100 in Savings account
     (env-transfer env 01 01 1970 equity bank1savings 100)
@@ -169,300 +155,313 @@
     ;; a couple INCOME transactions, a decade later
     (env-transfer env 01 01 1980 income bank1current 250)
     (env-transfer env 01 01 1980 income-GBP foreignsavings 500)
-    (env-transfer-foreign env 01 02 1980 income-GBP bank1current 100 170 #:description "earn 100GBP into $170")
+    (env-transfer-foreign env 01 02 1980 income-GBP bank1current 100 170 #:description "earn 100GBP into $170")))
 
-    ;; Finally we can begin testing balsheet
-    (display "\n\n balsheet tests\n\n")
-    (let* ((balance-sheet-options (default-balsheet-testing-options))
-           (sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-default")))
-      (test-equal "total assets = $116,009"
-        (list "$116,009.00")
-        (sxml->table-row-col sxml 1 15 6))
-      (test-equal "total liabilities = $9,500.00"
-        (list "$9,500.00")
-        (sxml->table-row-col sxml 1 23 6))
-      (test-equal "total equity  = $106,509.00"
-        (list "$106,509.00")
-        (sxml->table-row-col sxml 1 28 6))
-
-      (set-option! balance-sheet-options "Commodities" "Price Source" 'weighted-average)
-      (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-weighted-average")))
-        (test-equal "weighted average assets = $114,071.66"
-          (list "$114,071.66")
-          (sxml->table-row-col sxml 1 15 6)))
-
-      (set-option! balance-sheet-options "Commodities" "Price Source" 'average-cost)
-      (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-average-cost")))
-        (test-equal "average-cost assets = $113,100"
-          (list "$113,100.00")
-          (sxml->table-row-col sxml 1 15 6)))
-
-      (set-option! balance-sheet-options "Commodities" "Price Source" 'pricedb-nearest)
-      (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-pricedb-nearest")))
-        (test-equal "pricedb-nearest assets = $116,009"
-          (list "$116,009.00")
-          (sxml->table-row-col sxml 1 15 6)))
-
-      (set-option! balance-sheet-options "Commodities" "Price Source" 'pricedb-latest)
-      (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-pricedb-latest")))
-        (test-equal "pricedb-latest assets = $122,049"
-          (list "$122,049.00")
-          (sxml->table-row-col sxml 1 15 6)))
-
-      ;; set multilevel subtotal style
-      ;; verifies amount in EVERY line of the report.
-      (set-option! balance-sheet-options "Display" "Parent account balances" 'immediate-bal)
-      (set-option! balance-sheet-options "Display" "Parent account subtotals" 't)
-      (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-multilevel")))
-        (test-equal "multilevel. root = $0.00"
-          (list "$0.00")
-          (sxml->table-row-col sxml 1 3 6))
-        (test-equal "multilevel. assets = $0.00"
-          (list "$0.00")
-          (sxml->table-row-col sxml 1 4 5))
-        (test-equal "multilevel. bank1 = $0.00"
-          (list "$0.00")
-          (sxml->table-row-col sxml 1 5 4))
-        (test-equal "multilevel. bonds = $2,000.00"
-          (list "$2,000.00")
-          (sxml->table-row-col sxml 1 6 3))
-        (test-equal "multilevel. current = $2609.00"
-          (list "$2,609.00")
-          (sxml->table-row-col sxml 1 7 3))
-        (test-equal "multilevel. empty = $0.00"
-          (list "$0.00")
-          (sxml->table-row-col sxml 1 8 3))
-        (test-equal "multilevel. savings = $100.00"
-          (list "$100.00")
-          (sxml->table-row-col sxml 1 9 3))
-        (test-equal "multilevel. total bank1 = $4709"
-          (list "$4,709.00")
-          (sxml->table-row-col sxml 1 10 4))
-        (test-equal "multilevel. broker = $2,000.00"
-          (list "$2,000.00")
-          (sxml->table-row-col sxml 1 11 4))
-        (test-equal "multilevel. funds = $15,000.00"
-          (list "30 FUNDS" "$15,000.00" "$15,000.00")
-          (sxml->table-row-col sxml 1 12 3))
-        (test-equal "multilevel. total broker = $17,000.00"
-          (list "$17,000.00")
-          (sxml->table-row-col sxml 1 13 4))
-        (test-equal "multilevel. foreign = $0.00"
-          (list "$0.00")
-          (sxml->table-row-col sxml 1 14 4))
-        (test-equal "multilevel. foreignsavings = #200.00 = $340"
-          (list "#200.00" "$340.00" "$340.00")
-          (sxml->table-row-col sxml 1 15 3))
-        (test-equal "multilevel. total foreign = $340"
-          (list "$340.00")
-          (sxml->table-row-col sxml 1 16 4))
-        (test-equal "multilevel. house = $100,000"
-          (list "$100,000.00")
-          (sxml->table-row-col sxml 1 17 4))
-        (test-equal "multilevel. total asset = $122,049"
-          (list "$122,049.00")
-          (sxml->table-row-col sxml 1 18 5))
-        (test-equal "multilevel. total root = $122,049"
-          (list "$122,049.00")
-          (sxml->table-row-col sxml 1 19 6))
-        (test-equal "multilevel. total assets = $122,049"
-          (list "$122,049.00")
-          (sxml->table-row-col sxml 1 20 6)))
-
-      ;; set recursive-subtotal subtotal style
-      (set-option! balance-sheet-options "Display" "Parent account balances" 'recursive-bal)
-      (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")
-          (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")
-          (sxml->table-row-col sxml 1 4 5))
-        (test-equal "recursive. bank1 = $4,709.00"
-          (list "$4,709.00")
-          (sxml->table-row-col sxml 1 5 4))
-        (test-equal "recursive. bonds = $2,000.00"
-          (list "$2,000.00")
-          (sxml->table-row-col sxml 1 6 3))
-        (test-equal "recursive. current = $2609.00"
-          (list "$2,609.00")
-          (sxml->table-row-col sxml 1 7 3))
-        (test-equal "recursive. empty = $0.00"
-          (list "$0.00")
-          (sxml->table-row-col sxml 1 8 3))
-        (test-equal "recursive. savings = $100.00"
-          (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")
-          (sxml->table-row-col sxml 1 10 4))
-        (test-equal "recursive. funds = $15,000.00"
-          (list "30 FUNDS" "$15,000.00" "$15,000.00")
-          (sxml->table-row-col sxml 1 11 3))
-        (test-equal "recursive. foreign = $340.00"
-          (list "#200.00" "$340.00")
-          (sxml->table-row-col sxml 1 12 4))
-        (test-equal "recursive. foreignsavings = #200.00 = $340"
-          (list "#200.00" "$340.00" "$340.00")
-          (sxml->table-row-col sxml 1 13 3))
-        (test-equal "recursive. house = $100,000"
-          (list "$100,000.00")
-          (sxml->table-row-col sxml 1 14 4))
-        (test-equal "recursive. total assets = $122,049.00"
-          (list "$122,049.00")
-          (sxml->table-row-col sxml 1 15 6)))
-
-      (set-option! balance-sheet-options "Commodities" "Show Foreign Currencies" #f)
-      (set-option! balance-sheet-options "Commodities" "Show Exchange Rates" #f)
-      (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-disable show-fcur show-rates")))
-        (test-equal "show-fcur disabled"
-          (list "$122,049.00")
-          (sxml->table-row-col sxml 1 3 6))
-        (test-equal "show-rates disabled"
-          '()
-          (sxml->table-row-col sxml 2 #f #f)))
-
-      (set-option! balance-sheet-options "Commodities" "Show Foreign Currencies" #t)
+(define (balance-sheet-tests)
+  (define (default-balsheet-testing-options)
+    (let ((balance-sheet-options (gnc:make-report-options balance-sheet-uuid)))
+      (set-option! balance-sheet-options "General" "Balance Sheet Date" (cons 'absolute (gnc-dmy2time64 1 1 1971)))
+      (set-option! balance-sheet-options "Accounts" "Levels of Subaccounts" 'all)
       (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")
-          (sxml->table-row-col sxml 1 3 6))
-        (test-equal "show-rates enabled"
-          (list "1 FUNDS" "$500.00" "#1.00" "$1.70")
-          (sxml->table-row-col sxml 2 #f #f)))
-
-      ;;make-multilevel
-      (set-option! balance-sheet-options "Display" "Parent account balances" 'immediate-bal)
-      (set-option! balance-sheet-options "Display" "Parent account subtotals" 't)
-
-      (set-option! balance-sheet-options "Display" "Omit zero balance figures" #t)
-      (set-option! balance-sheet-options "Display" "Include accounts with zero total balances" #f)
-      (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-incl-zb-accts=#f omit-zb-bals=#t")))
-        (test-equal "omit-zb-bals=#t"
-          '()
-          (sxml->table-row-col sxml 1 3 5))
-        (test-equal "incl-zb-accts=#f"
-          '("Savings" "$100.00")        ;i.e.skips "Empty" account with $0.00
-          (sxml->table-row-col sxml 1 8 #f)))
-
-      (set-option! balance-sheet-options "Display" "Omit zero balance figures" #f)
-      (set-option! balance-sheet-options "Display" "Include accounts with zero total balances" #t)
-      (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-incl-zb-accts=#t omit-zb-bals=#f")))
-        (test-equal "omit-zb-bals=#f"
-          (list "$0.00")
-          (sxml->table-row-col sxml 1 3 6))
-        (test-equal "incl-zb-accts=#t"
-          '("Empty" "$0.00")
-          (sxml->table-row-col sxml 1 8 #f)))
-      )
-
-    (display "\n\n pnl tests\n\n")
-    (let* ((pnl-options (default-pnl-testing-options))
-           (sxml (options->sxml pnl-uuid pnl-options "pnl-default")))
-      (test-equal "total revenue  = $1,270.00"
+      balance-sheet-options))
+  (display "\n\n balsheet tests\n\n")
+  (let* ((balance-sheet-options (default-balsheet-testing-options))
+         (sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-default")))
+
+    (test-equal "total assets = $116,009"
+      (list "$116,009.00")
+      (sxml->table-row-col sxml 1 15 6))
+    (test-equal "total liabilities = $9,500.00"
+      (list "$9,500.00")
+      (sxml->table-row-col sxml 1 23 6))
+    (test-equal "total equity  = $106,509.00"
+      (list "$106,509.00")
+      (sxml->table-row-col sxml 1 28 6))
+
+    (set-option! balance-sheet-options "Commodities" "Price Source" 'weighted-average)
+    (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-weighted-average")))
+      (test-equal "weighted average assets = $114,071.66"
+        (list "$114,071.66")
+        (sxml->table-row-col sxml 1 15 6)))
+
+    (set-option! balance-sheet-options "Commodities" "Price Source" 'average-cost)
+    (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-average-cost")))
+      (test-equal "average-cost assets = $113,100"
+        (list "$113,100.00")
+        (sxml->table-row-col sxml 1 15 6)))
+
+    (set-option! balance-sheet-options "Commodities" "Price Source" 'pricedb-nearest)
+    (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-pricedb-nearest")))
+      (test-equal "pricedb-nearest assets = $116,009"
+        (list "$116,009.00")
+        (sxml->table-row-col sxml 1 15 6)))
+
+    (set-option! balance-sheet-options "Commodities" "Price Source" 'pricedb-latest)
+    (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-pricedb-latest")))
+      (test-equal "pricedb-latest assets = $122,049"
+        (list "$122,049.00")
+        (sxml->table-row-col sxml 1 15 6)))
+
+    ;; set multilevel subtotal style
+    ;; verifies amount in EVERY line of the report.
+    (set-option! balance-sheet-options "Display" "Parent account balances" 'immediate-bal)
+    (set-option! balance-sheet-options "Display" "Parent account subtotals" 't)
+    (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-multilevel")))
+      (test-equal "multilevel. root = $0.00"
+        (list "$0.00")
+        (sxml->table-row-col sxml 1 3 6))
+      (test-equal "multilevel. assets = $0.00"
+        (list "$0.00")
+        (sxml->table-row-col sxml 1 4 5))
+      (test-equal "multilevel. bank1 = $0.00"
+        (list "$0.00")
+        (sxml->table-row-col sxml 1 5 4))
+      (test-equal "multilevel. bonds = $2,000.00"
+        (list "$2,000.00")
+        (sxml->table-row-col sxml 1 6 3))
+      (test-equal "multilevel. current = $2609.00"
+        (list "$2,609.00")
+        (sxml->table-row-col sxml 1 7 3))
+      (test-equal "multilevel. empty = $0.00"
+        (list "$0.00")
+        (sxml->table-row-col sxml 1 8 3))
+      (test-equal "multilevel. savings = $100.00"
+        (list "$100.00")
+        (sxml->table-row-col sxml 1 9 3))
+      (test-equal "multilevel. total bank1 = $4709"
+        (list "$4,709.00")
+        (sxml->table-row-col sxml 1 10 4))
+      (test-equal "multilevel. broker = $2,000.00"
+        (list "$2,000.00")
+        (sxml->table-row-col sxml 1 11 4))
+      (test-equal "multilevel. funds = $15,000.00"
+        (list "30 FUNDS" "$15,000.00" "$15,000.00")
+        (sxml->table-row-col sxml 1 12 3))
+      (test-equal "multilevel. total broker = $17,000.00"
+        (list "$17,000.00")
+        (sxml->table-row-col sxml 1 13 4))
+      (test-equal "multilevel. foreign = $0.00"
+        (list "$0.00")
+        (sxml->table-row-col sxml 1 14 4))
+      (test-equal "multilevel. foreignsavings = #200.00 = $340"
+        (list "#200.00" "$340.00" "$340.00")
+        (sxml->table-row-col sxml 1 15 3))
+      (test-equal "multilevel. total foreign = $340"
+        (list "$340.00")
+        (sxml->table-row-col sxml 1 16 4))
+      (test-equal "multilevel. house = $100,000"
+        (list "$100,000.00")
+        (sxml->table-row-col sxml 1 17 4))
+      (test-equal "multilevel. total asset = $122,049"
+        (list "$122,049.00")
+        (sxml->table-row-col sxml 1 18 5))
+      (test-equal "multilevel. total root = $122,049"
+        (list "$122,049.00")
+        (sxml->table-row-col sxml 1 19 6))
+      (test-equal "multilevel. total assets = $122,049"
+        (list "$122,049.00")
+        (sxml->table-row-col sxml 1 20 6)))
+
+    ;; set recursive-subtotal subtotal style
+    (set-option! balance-sheet-options "Display" "Parent account balances" 'recursive-bal)
+    (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")
+        (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")
+        (sxml->table-row-col sxml 1 4 5))
+      (test-equal "recursive. bank1 = $4,709.00"
+        (list "$4,709.00")
+        (sxml->table-row-col sxml 1 5 4))
+      (test-equal "recursive. bonds = $2,000.00"
+        (list "$2,000.00")
+        (sxml->table-row-col sxml 1 6 3))
+      (test-equal "recursive. current = $2609.00"
+        (list "$2,609.00")
+        (sxml->table-row-col sxml 1 7 3))
+      (test-equal "recursive. empty = $0.00"
+        (list "$0.00")
+        (sxml->table-row-col sxml 1 8 3))
+      (test-equal "recursive. savings = $100.00"
+        (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")
+        (sxml->table-row-col sxml 1 10 4))
+      (test-equal "recursive. funds = $15,000.00"
+        (list "30 FUNDS" "$15,000.00" "$15,000.00")
+        (sxml->table-row-col sxml 1 11 3))
+      (test-equal "recursive. foreign = $340.00"
+        (list "#200.00" "$340.00")
+        (sxml->table-row-col sxml 1 12 4))
+      (test-equal "recursive. foreignsavings = #200.00 = $340"
+        (list "#200.00" "$340.00" "$340.00")
+        (sxml->table-row-col sxml 1 13 3))
+      (test-equal "recursive. house = $100,000"
+        (list "$100,000.00")
+        (sxml->table-row-col sxml 1 14 4))
+      (test-equal "recursive. total assets = $122,049.00"
+        (list "$122,049.00")
+        (sxml->table-row-col sxml 1 15 6)))
+
+    (set-option! balance-sheet-options "Commodities" "Show Foreign Currencies" #f)
+    (set-option! balance-sheet-options "Commodities" "Show Exchange Rates" #f)
+    (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-disable show-fcur show-rates")))
+      (test-equal "show-fcur disabled"
+        (list "$122,049.00")
+        (sxml->table-row-col sxml 1 3 6))
+      (test-equal "show-rates disabled"
+        '()
+        (sxml->table-row-col sxml 2 #f #f)))
+
+    (set-option! balance-sheet-options "Commodities" "Show Foreign Currencies" #t)
+    (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")
+        (sxml->table-row-col sxml 1 3 6))
+      (test-equal "show-rates enabled"
+        (list "1 FUNDS" "$500.00" "#1.00" "$1.70")
+        (sxml->table-row-col sxml 2 #f #f)))
+
+    ;;make-multilevel
+    (set-option! balance-sheet-options "Display" "Parent account balances" 'immediate-bal)
+    (set-option! balance-sheet-options "Display" "Parent account subtotals" 't)
+
+    (set-option! balance-sheet-options "Display" "Omit zero balance figures" #t)
+    (set-option! balance-sheet-options "Display" "Include accounts with zero total balances" #f)
+    (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-incl-zb-accts=#f omit-zb-bals=#t")))
+      (test-equal "omit-zb-bals=#t"
+        '()
+        (sxml->table-row-col sxml 1 3 5))
+      (test-equal "incl-zb-accts=#f"
+        '("Savings" "$100.00")        ;i.e.skips "Empty" account with $0.00
+        (sxml->table-row-col sxml 1 8 #f)))
+
+    (set-option! balance-sheet-options "Display" "Omit zero balance figures" #f)
+    (set-option! balance-sheet-options "Display" "Include accounts with zero total balances" #t)
+    (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-incl-zb-accts=#t omit-zb-bals=#f")))
+      (test-equal "omit-zb-bals=#f"
+        (list "$0.00")
+        (sxml->table-row-col sxml 1 3 6))
+      (test-equal "incl-zb-accts=#t"
+        '("Empty" "$0.00")
+        (sxml->table-row-col sxml 1 8 #f)))))
+
+(define (pnl-tests)
+  (define (default-pnl-testing-options)
+    (let ((pnl-options (gnc:make-report-options pnl-uuid)))
+      (set-option! pnl-options "General" "Start Date" (cons 'absolute (gnc-dmy2time64 1 1 1980)))
+      (set-option! pnl-options "General" "End Date" (cons 'absolute (gnc-dmy2time64 1 1 1981)))
+      (set-option! pnl-options "Accounts" "Levels of Subaccounts" 'all)
+      (set-option! pnl-options "Commodities" "Show Exchange Rates" #t)
+      pnl-options))
+  (display "\n\n pnl tests\n\n")
+  (let* ((pnl-options (default-pnl-testing-options))
+         (sxml (options->sxml pnl-uuid pnl-options "pnl-default")))
+    (test-equal "total revenue  = $1,270.00"
+      (list "$1,270.00")
+      ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
+       sxml))
+    (test-equal "total expenses  = $0.00"
+      (list "$0.00")
+      ((sxpath '(// table // (tr 2) // table // (tr 3) // (td 6) // *text*))
+       sxml))
+
+    (set-option! pnl-options "Commodities" "Price Source" 'weighted-average)
+    (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-weighted-average")))
+      (test-equal "weighted average revenue = $1160.36"
+        (list "$1,160.36")
+        ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
+         sxml)))
+
+    (set-option! pnl-options "Commodities" "Price Source" 'average-cost)
+    (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-average-cost")))
+      (test-equal "average-cost revenue = $976"
+        (list "$976.00")
+        ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
+         sxml)))
+
+    (set-option! pnl-options "Commodities" "Price Source" 'pricedb-nearest)
+    (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-pricedb-nearest")))
+      (test-equal "pricedb-nearest revenue = $1270"
+        (list "$1,270.00")
+        ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
+         sxml)))
+
+    (set-option! pnl-options "Commodities" "Price Source" 'pricedb-latest)
+    (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-pricedb-latest")))
+      (test-equal "pricedb-latest revenue = $1270"
         (list "$1,270.00")
         ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
+         sxml)))
+
+    ;; set multilevel subtotal style
+    ;; verifies amount in EVERY line of the report.
+    (set-option! pnl-options "Display" "Parent account balances" 'immediate-bal)
+    (set-option! pnl-options "Display" "Parent account subtotals" 't)
+    (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-multilevel")))
+      (test-equal "multilevel. income = -$250.00"
+        (list "-$250.00")
+        ((sxpath '(// table // (tr 1) // table // (tr 3) // (td 6) // *text*))
+         sxml))
+      (test-equal "multilevel. income-GBP = -#600"
+        (list "-#600.00" "-$1,020.00")
+        ((sxpath '(// table // (tr 1) // table // (tr 4) // (td 5) // *text*))
+         sxml))
+      (test-equal "multilevel. total income = -$1,270.00"
+        (list "-$1,270.00")
+        ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
+         sxml))
+      (test-equal "multilevel. total revenue = $1,270.00"
+        (list "$1,270.00")
+        ((sxpath '(// table // (tr 1) // table // (tr 6) // (td 6) // *text*))
          sxml))
-      (test-equal "total expenses  = $0.00"
+      (test-equal "multilevel. expenses = $0.00"
         (list "$0.00")
         ((sxpath '(// table // (tr 2) // table // (tr 3) // (td 6) // *text*))
          sxml))
-
-      (set-option! pnl-options "Commodities" "Price Source" 'weighted-average)
-      (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-weighted-average")))
-        (test-equal "weighted average revenue = $1160.36"
-          (list "$1,160.36")
-          ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
-           sxml)))
-
-      (set-option! pnl-options "Commodities" "Price Source" 'average-cost)
-      (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-average-cost")))
-        (test-equal "average-cost revenue = $976"
-          (list "$976.00")
-          ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
-           sxml)))
-
-      (set-option! pnl-options "Commodities" "Price Source" 'pricedb-nearest)
-      (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-pricedb-nearest")))
-        (test-equal "pricedb-nearest revenue = $1270"
-          (list "$1,270.00")
-          ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
-           sxml)))
-
-      (set-option! pnl-options "Commodities" "Price Source" 'pricedb-latest)
-      (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-pricedb-latest")))
-        (test-equal "pricedb-latest revenue = $1270"
-          (list "$1,270.00")
-          ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
-           sxml)))
-
-      ;; set multilevel subtotal style
-      ;; verifies amount in EVERY line of the report.
-      (set-option! pnl-options "Display" "Parent account balances" 'immediate-bal)
-      (set-option! pnl-options "Display" "Parent account subtotals" 't)
-      (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-multilevel")))
-        (test-equal "multilevel. income = -$250.00"
-          (list "-$250.00")
-          ((sxpath '(// table // (tr 1) // table // (tr 3) // (td 6) // *text*))
-           sxml))
-        (test-equal "multilevel. income-GBP = -#600"
-          (list "-#600.00" "-$1,020.00")
-          ((sxpath '(// table // (tr 1) // table // (tr 4) // (td 5) // *text*))
-           sxml))
-        (test-equal "multilevel. total income = -$1,270.00"
-          (list "-$1,270.00")
-          ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
-           sxml))
-        (test-equal "multilevel. total revenue = $1,270.00"
-          (list "$1,270.00")
-          ((sxpath '(// table // (tr 1) // table // (tr 6) // (td 6) // *text*))
-           sxml))
-        (test-equal "multilevel. expenses = $0.00"
-          (list "$0.00")
-          ((sxpath '(// table // (tr 2) // table // (tr 3) // (td 6) // *text*))
-           sxml))
-        (test-equal "multilevel. net-income = $1,270"
-          (list "$1,270.00")
-          ((sxpath '(// table // (tr 2) // table // (tr 4) // (td 6) // *text*))
-           sxml)))
-
-      ;; set recursive-subtotal subtotal style
-      (set-option! pnl-options "Display" "Parent account balances" 'recursive-bal)
-      (set-option! pnl-options "Display" "Parent account subtotals" 'f)
-      (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-recursive")))
-        (test-equal "recursive. income = $1020+250"
-          (list "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00" "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00")
-          (sxml->table-row-col sxml 1 3 6))
-        (test-equal "recursive. income-gbp = $1020"
-          (list "-#600.00" "-$1,020.00" "-#600.00" "-$1,020.00")
-          (sxml->table-row-col sxml 1 4 5))
-        (test-equal "recursive. total revenue = $1270"
-          (list "$1,270.00" "$1,270.00")
-          (sxml->table-row-col sxml 1 5 6)))
-
-      (set-option! pnl-options "Commodities" "Show Foreign Currencies" #f)
-      (set-option! pnl-options "Commodities" "Show Exchange Rates" #f)
-      (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-disable show-fcur show-rates")))
-        (test-equal "show-fcur disabled"
-          (list "-$1,270.00" "$0.00" "-$1,270.00" "$0.00")
-          (sxml->table-row-col sxml 1 3 6))
-        (test-equal "show-rates disabled"
-          '()
-          (sxml->table-row-col sxml 2 #f #f)))
-
-      (set-option! pnl-options "Commodities" "Show Foreign Currencies" #t)
-      (set-option! pnl-options "Commodities" "Show Exchange Rates" #t)
-      (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-enable show-fcur show-rates")))
-        (test-equal "show-fcur enabled"
-          (list "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00" "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00")
-          (sxml->table-row-col sxml 1 3 6))
-        (test-equal "show-rates enabled"
-          (list "#1.00" "$1.70")
-          (sxml->table-row-col sxml 2 #f #f)))
-
-      ;;make-multilevel
-      (set-option! pnl-options "Display" "Parent account balances" 'immediate-bal)
-      (set-option! pnl-options "Display" "Parent account subtotals" 't)
-      )))
+      (test-equal "multilevel. net-income = $1,270"
+        (list "$1,270.00")
+        ((sxpath '(// table // (tr 2) // table // (tr 4) // (td 6) // *text*))
+         sxml)))
+
+    ;; set recursive-subtotal subtotal style
+    (set-option! pnl-options "Display" "Parent account balances" 'recursive-bal)
+    (set-option! pnl-options "Display" "Parent account subtotals" 'f)
+    (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-recursive")))
+      (test-equal "recursive. income = $1020+250"
+        (list "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00" "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00")
+        (sxml->table-row-col sxml 1 3 6))
+      (test-equal "recursive. income-gbp = $1020"
+        (list "-#600.00" "-$1,020.00" "-#600.00" "-$1,020.00")
+        (sxml->table-row-col sxml 1 4 5))
+      (test-equal "recursive. total revenue = $1270"
+        (list "$1,270.00" "$1,270.00")
+        (sxml->table-row-col sxml 1 5 6)))
+
+    (set-option! pnl-options "Commodities" "Show Foreign Currencies" #f)
+    (set-option! pnl-options "Commodities" "Show Exchange Rates" #f)
+    (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-disable show-fcur show-rates")))
+      (test-equal "show-fcur disabled"
+        (list "-$1,270.00" "$0.00" "-$1,270.00" "$0.00")
+        (sxml->table-row-col sxml 1 3 6))
+      (test-equal "show-rates disabled"
+        '()
+        (sxml->table-row-col sxml 2 #f #f)))
+
+    (set-option! pnl-options "Commodities" "Show Foreign Currencies" #t)
+    (set-option! pnl-options "Commodities" "Show Exchange Rates" #t)
+    (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-enable show-fcur show-rates")))
+      (test-equal "show-fcur enabled"
+        (list "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00" "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00")
+        (sxml->table-row-col sxml 1 3 6))
+      (test-equal "show-rates enabled"
+        (list "#1.00" "$1.70")
+        (sxml->table-row-col sxml 2 #f #f)))
+
+    ;;make-multilevel
+    (set-option! pnl-options "Display" "Parent account balances" 'immediate-bal)
+    (set-option! pnl-options "Display" "Parent account subtotals" 't)))

commit 119fdc368b41d0a1207e9d281deddcfe08e52d59
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Mon Nov 25 22:52:36 2019 +0800

    [report-utilities] can strify records
    
    srfi-9 records can contain complex objects eg lists/vectors also
    gnc:monetary or gnc:html-table objects. previously gnc:strify would
    use the default printer; this commit modifies so that they are
    prettified.
    
    example output; a :col-datum record from balsheet-pnl. the record's
    split-balance contains a $0 monetary object.
    
    Rec::col-datum{last-split=#f, split-balance=[$0.00]}
    
    this last pretty-printer must be the last one before object->string,
    because we want previous printers which may be records too
    eg. monetary->str etc to use their own printer.

diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index 3422fdeaa..f2cfaad44 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -1284,6 +1284,13 @@ flawed. see report-utilities.scm. please update reports.")
       (try owner->str)
       (try invoice->str)
       (try lot->str)
+      (and (record? d)
+           (let ((rtd (record-type-descriptor d)))
+             (define (fld->str fld)
+               (format #f "~a=~a" fld (gnc:strify ((record-accessor rtd fld) d))))
+             (format #f "Rec:~a{~a}"
+                     (record-type-name rtd)
+                     (string-join (map fld->str (record-type-fields rtd)) ", "))))
       (object->string d)))
 
 (define (pair->num pair)



Summary of changes:
 gnucash/report/report-system/report-utilities.scm  |   7 +
 .../standard-reports/test/test-balsheet-pnl.scm    | 731 ++++++++++++---------
 2 files changed, 430 insertions(+), 308 deletions(-)



More information about the gnucash-changes mailing list