mirror of
https://github.com/Gnucash/gnucash.git
synced 2024-11-27 11:20:27 -06:00
[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
This commit is contained in:
Christopher Lam
parent
298724dd93
commit
22cdd237f1
@ -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
|
||||
|
||||
127
gnucash/report/standard-reports/test/test-portfolios.scm
Normal file
127
gnucash/report/standard-reports/test/test-portfolios.scm
Normal file
@ -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)))
|
||||
@ -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))
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user