gnucash maint: Multiple changes pushed
Christopher Lam
clam at code.gnucash.org
Tue Sep 24 11:16:03 EDT 2019
Updated via https://github.com/Gnucash/gnucash/commit/22cdd237 (commit)
via https://github.com/Gnucash/gnucash/commit/298724dd (commit)
from https://github.com/Gnucash/gnucash/commit/ee260d8e (commit)
commit 22cdd237f1c00b9679382793b19124a215a2df58
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Feb 21 17:07:17 2019 +0800
[test-portfolios] initial commit
1.1.1980 seed $10,000
1.2.1980 buy 1 AAPL @ $100
1.3.1980 buy 1 AAPL @ $200
1.5.1980 sell 1 AAPL @ $400, FIFO capgain = $300, less $10 fee
1.10.1980 1:10 stock split 1 to 10 AAPL, price now $40
1.11.1980 1:10 stock split 10 to 100 AAPL, price now $4
1.12.1980 3:1 stock split 100 to 33 AAPL, price now $12;
cash-in-lieu for 1/3 AAPL = $4
tests both portfolio.scm and advanced-portfolio.csm
tests report output using average/fifo/lifo
pending: DRP etc
diff --git a/gnucash/report/standard-reports/test/CMakeLists.txt b/gnucash/report/standard-reports/test/CMakeLists.txt
index 97b09f68a..600105681 100644
--- a/gnucash/report/standard-reports/test/CMakeLists.txt
+++ b/gnucash/report/standard-reports/test/CMakeLists.txt
@@ -16,6 +16,7 @@ set(scm_test_with_srfi64_SOURCES
test-register.scm
test-trial-balance.scm
test-average-balance.scm
+ test-portfolios.scm
)
set(scm_test_with_textual_ports_SOURCES
diff --git a/gnucash/report/standard-reports/test/test-portfolios.scm b/gnucash/report/standard-reports/test/test-portfolios.scm
new file mode 100644
index 000000000..6ce643e8e
--- /dev/null
+++ b/gnucash/report/standard-reports/test/test-portfolios.scm
@@ -0,0 +1,127 @@
+(use-modules (gnucash gnc-module))
+(gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
+(use-modules (gnucash engine test test-extras))
+(use-modules (gnucash report standard-reports portfolio))
+(use-modules (gnucash report standard-reports advanced-portfolio))
+(use-modules (gnucash report stylesheets))
+(use-modules (gnucash report report-system))
+(use-modules (gnucash report report-system test test-extras))
+(use-modules (srfi srfi-64))
+(use-modules (gnucash engine test srfi64-extras))
+(use-modules (sxml simple))
+(use-modules (sxml xpath))
+(use-modules (system vm coverage))
+(use-modules (system vm vm))
+
+;; This is implementation testing for both the Portfolio and the
+;; Advanced Portfolio Report.
+
+(define portfolio-uuid "4a6b82e8678c4f3d9e85d9f09634ca89")
+(define advanced-uuid "21d7cfc59fc74f22887596ebde7e462d")
+
+;; Explicitly set locale to make the report output predictable
+(setlocale LC_ALL "C")
+
+(define (run-test)
+ (if #f
+ (coverage-test)
+ (run-test-proper)))
+
+(define (coverage-test)
+ (let ((currfile (dirname (current-filename))))
+ (add-to-load-path (string-take currfile (string-rindex currfile #\/))))
+ (call-with-values
+ (lambda () (with-code-coverage run-test-proper))
+ (lambda (data result)
+ (let ((port (open-output-file "/tmp/lcov.info")))
+ (coverage-data->lcov data port)
+ (close port)))))
+
+(define (run-test-proper)
+ (test-runner-factory gnc:test-runner)
+ (test-begin "test-portfolios.scm")
+ (null-test "portfolio" portfolio-uuid)
+ (null-test "advanced-portfolio" advanced-uuid)
+ (portfolio-tests)
+ (advanced-tests)
+ (test-end "test-portfolios.scm"))
+
+(define (options->sxml uuid options test-title)
+ (gnc:options->sxml uuid options "test-apr" test-title))
+
+(define (set-option! options section name value)
+ (let ((option (gnc:lookup-option options section name)))
+ (if option
+ (gnc:option-set-value option value)
+ (test-assert (format #f "wrong-option ~a ~a" section name) #f))))
+
+(define (teardown)
+ (gnc-pricedb-destroy
+ (gnc-pricedb-get-db
+ (gnc-get-current-book)))
+ (gnc-clear-current-session))
+
+(define (null-test variant uuid)
+ ;; This null-test tests for the presence of report.
+ (let ((options (gnc:make-report-options uuid)))
+ (test-assert (format #f "null-test ~a" variant)
+ (options->sxml uuid options "null-test"))))
+
+(define (portfolio-tests)
+ (test-group-with-cleanup "portfolio-tests"
+ (let* ((account-alist (create-stock-test-data))
+ (options (gnc:make-report-options portfolio-uuid)))
+ (set-option! options "General" "Price Source" 'pricedb-latest)
+ (let ((sxml (options->sxml portfolio-uuid options "latest")))
+ (test-equal "portfolio: pricedb-latest"
+ '("AAPL" "AAPL" "NASDAQ" "42.00" "$6.00" "$252.00")
+ (sxml->table-row-col sxml 1 1 #f)))
+
+ (set-option! options "General" "Price Source" 'pricedb-nearest)
+ (set-option! options "General" "Date" (cons 'absolute (gnc-dmy2time64 1 3 1980)))
+ (let ((sxml (options->sxml portfolio-uuid options "nearest")))
+ (test-equal "portfolio: pricedb-nearest"
+ '("AAPL" "AAPL" "NASDAQ" "2.00" "$200.00" "$400.00")
+ (sxml->table-row-col sxml 1 1 #f)))
+
+ (set-option! options "General" "Price Source" 'average-cost)
+ (set-option! options "General" "Date" (cons 'absolute (gnc-dmy2time64 1 9 1980)))
+ (let ((sxml (options->sxml portfolio-uuid options "average-cost")))
+ (test-equal "portfolio: average-cost"
+ '("AAPL" "AAPL" "NASDAQ" "1.00" "$200.00" "$200.00")
+ (sxml->table-row-col sxml 1 1 #f)))
+
+ (set-option! options "General" "Price Source" 'weighted-average)
+ (let ((sxml (options->sxml portfolio-uuid options "'weighted-average")))
+ (test-equal "portfolio: weighted-average"
+ '("AAPL" "AAPL" "NASDAQ" "1.00" "$233.33" "$233 + 1/3")
+ (sxml->table-row-col sxml 1 1 #f))))
+ (teardown)))
+
+(define (advanced-tests)
+ (test-group-with-cleanup "advanced-portfolio-tests"
+ (let ((account-alist (create-stock-test-data))
+ (options (gnc:make-report-options advanced-uuid)))
+ (let ((sxml (options->sxml advanced-uuid options "basic average")))
+ (test-equal "advanced: average basis"
+ '("AAPL" "AAPL" "NASDAQ" "42.00" "$6.00" "$484.88" "$252.00" "$800.00"
+ "$553.00" "$227.88" "-$232.88" "-$5.00" "-0.63%" "$4.00"
+ "$10.00" "-$1.00" "-0.13%")
+ (sxml->table-row-col sxml 1 1 #f)))
+
+ (set-option! options "General" "Basis calculation method" 'fifo-basis)
+ (let ((sxml (options->sxml advanced-uuid options "basic fifo")))
+ (test-equal "advanced: fifo basis"
+ '("AAPL" "AAPL" "NASDAQ" "42.00" "$6.00" "$543.94" "$252.00" "$800.00"
+ "$553.00" "$286.94" "-$291.94" "-$5.00" "-0.63%" "$4.00" "$10.00"
+ "-$1.00" "-0.13%")
+ (sxml->table-row-col sxml 1 1 #f)))
+
+ (set-option! options "General" "Basis calculation method" 'filo-basis)
+ (let ((sxml (options->sxml advanced-uuid options "basic filo")))
+ (test-equal "advanced: filo basis"
+ '("AAPL" "AAPL" "NASDAQ" "42.00" "$6.00" "$400.00" "$252.00" "$800.00"
+ "$553.00" "$143.00" "-$148.00" "-$5.00" "-0.63%" "$4.00" "$10.00"
+ "-$1.00" "-0.13%")
+ (sxml->table-row-col sxml 1 1 #f))))
+ (teardown)))
diff --git a/libgnucash/engine/test/test-extras.scm b/libgnucash/engine/test/test-extras.scm
index 84e23deed..3fbe5bd9f 100644
--- a/libgnucash/engine/test/test-extras.scm
+++ b/libgnucash/engine/test/test-extras.scm
@@ -833,3 +833,180 @@
"trans-payment-num-1"))
(vector inv-1 inv-2 inv-3 inv-4 inv-5 inv-6 inv-7 inv-8)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; various stock transactions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; This function aims to replicate the stock-split process in
+;; gnc_stock_split_assistant_finish in assistant-stock-split.c. It
+;; creates a 1 or 3-split transaction, and possibly a pricedb entry.
+(define (stock-split account date shares description
+ ;; price-amount may be #f
+ price-amount pricecurrency
+ ;; cash-in-lieu, cash-amount may be #f
+ cash-amount cash-memo cash-income cash-asset)
+ (let* ((book (gnc-get-current-book))
+ (accounts '())
+ (trans (xaccMallocTransaction book)))
+ (xaccTransBeginEdit trans)
+ (xaccTransSetCurrency trans (gnc-default-currency))
+ (xaccTransSetDatePostedSecsNormalized trans date)
+ (xaccTransSetDescription trans description)
+
+ (let ((stocksplit (xaccMallocSplit book)))
+ (xaccAccountBeginEdit account)
+ (set! accounts (cons account accounts))
+ (xaccSplitSetAccount stocksplit account)
+ (xaccSplitSetAmount stocksplit shares)
+ (xaccSplitMakeStockSplit stocksplit)
+ (xaccSplitSetAction stocksplit "Split")
+ (xaccSplitSetParent stocksplit trans))
+
+ ;; add pricedb
+ (when price-amount
+ (let ((price (gnc-price-create book)))
+ (gnc-price-begin-edit price)
+ (gnc-price-set-commodity price (xaccAccountGetCommodity account))
+ (gnc-price-set-currency price pricecurrency)
+ (gnc-price-set-time64 price date)
+ (gnc-price-set-source price PRICE-SOURCE-STOCK-SPLIT)
+ (gnc-price-set-typestr price "unknown")
+ (gnc-price-set-value price price-amount)
+ (gnc-price-commit-edit price)
+ (gnc-pricedb-add-price (gnc-pricedb-get-db book) price)))
+
+ ;; cash-in-lieu
+ (when cash-amount
+ (let ((asset-split (xaccMallocSplit book)))
+ (xaccAccountBeginEdit cash-asset)
+ (set! accounts (cons cash-asset accounts))
+ (xaccSplitSetAccount asset-split cash-asset)
+ (xaccSplitSetParent asset-split trans)
+ (xaccSplitSetAmount asset-split cash-amount)
+ (xaccSplitSetValue asset-split cash-amount)
+ (xaccSplitSetMemo asset-split cash-memo))
+
+ (let ((income-split (xaccMallocSplit book)))
+ (xaccAccountBeginEdit cash-income)
+ (set! accounts (cons cash-income accounts))
+ (xaccSplitSetAccount income-split cash-income)
+ (xaccSplitSetParent income-split trans)
+ (xaccSplitSetAmount income-split (- cash-amount))
+ (xaccSplitSetValue income-split (- cash-amount))
+ (xaccSplitSetMemo income-split cash-memo)))
+
+ (xaccTransCommitEdit trans)
+ (for-each xaccAccountCommitEdit accounts)
+ trans))
+
+(define-public (create-stock-test-data)
+ (define structure
+ (list "Root" (list (cons 'type ACCT-TYPE-ASSET))
+ (list "Asset"
+ (list "Bank"))
+ (list "Income" (list (cons 'type ACCT-TYPE-INCOME)))
+ (list "Expenses" (list (cons 'type ACCT-TYPE-EXPENSE)))
+ (list "Equity" (list (cons 'type ACCT-TYPE-EQUITY)))
+ (list "Broker"
+ (list "AAPL" (list (cons 'type ACCT-TYPE-STOCK)))
+ (list "MSFT" (list (cons 'type ACCT-TYPE-STOCK)))
+ (list "TSLA" (list (cons 'type ACCT-TYPE-STOCK))))))
+ (let* ((env (create-test-env))
+ (book (gnc-get-current-book))
+ (comm-table (gnc-commodity-table-get-table book))
+ (AAPL (gnc-commodity-new book "Apple" "NASDAQ" "AAPL" "" 1))
+ (MSFT (gnc-commodity-new book "Microsoft" "NASDAQ" "MSFT" "" 1))
+ (TSLA (gnc-commodity-new book "Tesla Motors" "NASDAQ" "TSLA" "" 1))
+ (account-alist (env-create-account-structure-alist env structure))
+ (bank (cdr (assoc "Bank" account-alist)))
+ (inco (cdr (assoc "Income" account-alist)))
+ (expe (cdr (assoc "Expenses" account-alist)))
+ (equity (cdr (assoc "Equity" account-alist)))
+ (aapl (cdr (assoc "AAPL" account-alist)))
+ (msft (cdr (assoc "MSFT" account-alist)))
+ (tsla (cdr (assoc "TSLA" account-alist)))
+ (YEAR (gnc:time64-get-year (gnc:get-today))))
+
+ ;; Set account commodities
+ (gnc-commodity-table-insert comm-table AAPL)
+ (gnc-commodity-table-insert comm-table MSFT)
+ (gnc-commodity-table-insert comm-table TSLA)
+ (xaccAccountSetCommodity aapl AAPL)
+ (xaccAccountSetCommodity msft MSFT)
+ (xaccAccountSetCommodity tsla TSLA)
+
+ (env-transfer env 01 01 1980 equity bank 10000 #:description "seed money")
+
+ (env-create-multisplit-transaction
+ env 01 02 1980
+ (list (vector bank -100 -100)
+ (vector aapl 100 1))
+ #:description "buy 1 AAPL @ $100")
+
+ (env-create-multisplit-transaction
+ env 01 03 1980
+ (list (vector bank -200 -200)
+ (vector aapl 200 1))
+ #:description "buy 1 AAPL @ $200")
+
+ (env-create-multisplit-transaction
+ env 01 05 1980
+ (list (vector bank 390 390)
+ (vector aapl -400 -1)
+ (vector inco -300 -300)
+ (vector expe 10 10)
+ (vector aapl 300 0))
+ #:description "sell 1 AAPL @ $400 FIFO, brokerage fee = $10, into bank = $390")
+
+ ;; until 1.5.1980 the account has usual buy/sell txns only, no stock splits
+ ;; there's only 1 AAPL left, price $400
+
+ ;; on 1.10.1980: stock split, 1 AAPL -> 10 AAPL
+ ;; prev price was $400, now is $40
+ (stock-split aapl
+ (gnc-dmy2time64 1 10 1980)
+ 9 "first 1:10 stock split"
+ 40 (gnc-account-get-currency-or-parent aapl)
+ #f #f #f #f)
+
+ ;; on 1.11.1980: another stock split, 10 AAPL -> 100 AAPL
+ ;; prev price was $40, now is $4
+ (stock-split aapl
+ (gnc-dmy2time64 1 11 1980)
+ 90 "another 1:10 stock split"
+ 4 (gnc-account-get-currency-or-parent aapl)
+ #f #f #f #f)
+
+ ;; on 1.12.1980: 3:1 stock split, 100 AAPL -> 33 AAPL
+ ;; prev price was $4, now is $12, with cash-in-lieu $4
+ (stock-split aapl
+ (gnc-dmy2time64 1 12 1980)
+ -67 "3:1 stock split with cash-in-lieu $4"
+ 12 (gnc-account-get-currency-or-parent aapl)
+ 4 "cash-in-lieu" inco bank)
+
+ (env-create-multisplit-transaction
+ env 01 01 1981
+ (list (vector bank -500 -500)
+ (vector aapl 500 10))
+ #:description "buy 10 AAPL @ $5")
+
+ (env-create-multisplit-transaction
+ env 1 3 1981
+ (list (vector bank 3 3)
+ (vector aapl -3 -1/2)
+ (vector inco -5/2 -5/2)
+ (vector aapl 5/2 0))
+ #:description "sell 1/2 AAPL @ $6 FIFO, capgain = $2.50 into bank = $200")
+
+ ;; FIXME: spin off $150 from AAPL is coded correctly? there's no
+ ;; INCOME split?
+ (env-create-multisplit-transaction
+ env 1 4 1981
+ (list (vector bank 150 150)
+ (vector aapl -150 0))
+ #:description "spin-off $150")
+
+ account-alist))
+
commit 298724dd93c475e2b730679a66acbcdcd94bbb5e
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue Sep 24 23:03:27 2019 +0800
[portfolio] there's no report-currency. use currency.
diff --git a/gnucash/report/standard-reports/portfolio.scm b/gnucash/report/standard-reports/portfolio.scm
index 7e985eb3c..1aedcf1ef 100644
--- a/gnucash/report/standard-reports/portfolio.scm
+++ b/gnucash/report/standard-reports/portfolio.scm
@@ -196,7 +196,7 @@
(if (not (null? accounts))
(let* ((commodity-list (gnc:accounts-get-commodities
(gnc:accounts-and-all-descendants accounts)
- report-currency))
+ currency))
(pricedb (gnc-pricedb-get-db (gnc-get-current-book)))
(exchange-fn (gnc:case-exchange-fn price-source currency to-date))
(price-fn
Summary of changes:
gnucash/report/standard-reports/portfolio.scm | 2 +-
.../report/standard-reports/test/CMakeLists.txt | 1 +
.../standard-reports/test/test-portfolios.scm | 127 +++++++++++++++
libgnucash/engine/test/test-extras.scm | 177 +++++++++++++++++++++
4 files changed, 306 insertions(+), 1 deletion(-)
create mode 100644 gnucash/report/standard-reports/test/test-portfolios.scm
More information about the gnucash-changes
mailing list