IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

[test-extras] for tests: (env-create-multisplit-transaction)

Browse Source 
This is the general case for any transaction creation.  Rewrite other
transaction creation routines to use it.  All tests still work
unchanged, which confirms this function works well.

This will allow tests to create multisplit transactions, of an
arbitrary number of splits. If the list-of-split's values are not
balanced (i.e. total 0), the engine will create an Imbalance-CUR
split.

The motivation is to allow creation of complex multisplit
multicommodity transactions eg USD50 + GBP20 (USD25) = EUR66 (USD75)
as well as their prices GBP/USD = 25/20 and EUR/USD = 75/66.

* USD -50
* USD -25 = GBP -20
* USD +75 = EUR +66

This will be useful in creating tests for stock-based reports, whereby
stock sales need splits in STOCK/ASSET/INCOME accounts.
This commit is contained in:
Christopher Lam 2019-02-15 14:13:05 +08:00
parent 82edec26fc
commit 918321aafa
2 changed files with 85 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
gnucash/report/standard-reports/test/test-transaction.scm
View File

@ -214,28 +214,13 @@
;; $100 from bank ;; $100 from bank
;; $80 to expenses ;; $80 to expenses
;; $20 to wallet ;; $20 to wallet
(let ((txn (xaccMallocTransaction (gnc-get-current-book))) (env-create-multisplit-transaction
(split-1 (xaccMallocSplit (gnc-get-current-book))) env 14 02 1971
(split-2 (xaccMallocSplit (gnc-get-current-book))) (list (vector bank -100 -100)
(split-3 (xaccMallocSplit (gnc-get-current-book)))) (vector expense 80 80)
(xaccTransBeginEdit txn) (vector wallet 20 20))
(xaccTransSetDescription txn "$100bank -> $80expenses + $20wallet") #:description "$100bank -> $80expenses + $20wallet"
(xaccTransSetCurrency txn (xaccAccountGetCommodity bank)) #:notes "multisplit")
(xaccTransSetDate txn 14 02 1971)
(xaccSplitSetParent split-1 txn)
(xaccSplitSetParent split-2 txn)
(xaccSplitSetParent split-3 txn)
(xaccSplitSetAccount split-1 bank)
(xaccSplitSetAccount split-2 expense)
(xaccSplitSetAccount split-3 wallet)
(xaccSplitSetValue split-1 -100)
(xaccSplitSetValue split-2 80)
(xaccSplitSetValue split-3 20)
(xaccSplitSetAmount split-1 -100)
(xaccSplitSetAmount split-2 80)
(xaccSplitSetAmount split-3 20)
(xaccTransSetNotes txn "multisplit")
(xaccTransCommitEdit txn))
;; A single closing transaction ;; A single closing transaction
(let ((closing-txn (env-transfer env 31 12 1999 expense equity 111 #:description "Closing"))) (let ((closing-txn (env-transfer env 31 12 1999 expense equity 111 #:description "Closing")))

120
libgnucash/engine/test/test-extras.scm
View File

@ -41,6 +41,7 @@
(export env-any-date) (export env-any-date)
(export env-transfer) (export env-transfer)
(export env-transfer-foreign) (export env-transfer-foreign)
(export env-create-multisplit-transaction)
(export env-create-transaction) (export env-create-transaction)
(export env-create-account) (export env-create-account)
(export env-create-root-account) (export env-create-root-account)
@ -183,44 +184,17 @@
notes ; string: notes (def = null) notes ; string: notes (def = null)
memo ; string: memo (def = null) memo ; string: memo (def = null)
) )
(let ((txn (xaccMallocTransaction (gnc-get-current-book))) (env-create-multisplit-transaction
(split-1 (xaccMallocSplit (gnc-get-current-book))) env
(split-2 (xaccMallocSplit (gnc-get-current-book)))) DD MM YY
(xaccTransBeginEdit txn) (list (vector debit (- amount1) (- amount1))
(xaccTransSetDescription txn (or description "ponies")) (vector credit amount1 amount2))
(xaccTransSetCurrency txn (xaccAccountGetCommodity debit)) #:description description
(xaccTransSetDate txn DD MM YY) #:void-reason void-reason
(xaccSplitSetParent split-1 txn) #:reconcile reconcile
(xaccSplitSetParent split-2 txn) #:num num
(xaccSplitSetAccount split-1 debit) #:memo memo
(xaccSplitSetAccount split-2 credit) #:notes notes))
(xaccSplitSetValue split-1 (- amount1))
(xaccSplitSetValue split-2 amount1)
(xaccSplitSetAmount split-1 (- amount1))
(xaccSplitSetAmount split-2 amount2)
(if reconcile
(begin
(xaccSplitSetReconcile split-1 (car reconcile))
(xaccSplitSetReconcile split-2 (car reconcile))
(xaccSplitSetDateReconciledSecs split-1 (cdr reconcile))
(xaccSplitSetDateReconciledSecs split-2 (cdr reconcile))))
(if num
(begin
(gnc-set-num-action txn split-1 num num)
(gnc-set-num-action txn split-2 num num)))
(if void-reason (xaccTransVoid txn void-reason))
(if notes (xaccTransSetNotes txn notes))
(if memo
(begin
(xaccSplitSetMemo split-1 memo)
(xaccSplitSetMemo split-2 memo)))
(if (> amount2 0)
(gnc-pricedb-create (xaccAccountGetCommodity debit)
(xaccAccountGetCommodity credit)
(gnc-dmy2time64 DD MM YY)
(/ amount1 amount2)))
(xaccTransCommitEdit txn)
txn))
(define* (env-transfer (define* (env-transfer
env env
@ -234,10 +208,13 @@
reconcile ; char : reconciled (default = n) reconcile ; char : reconciled (default = n)
num ; string: num field (def = null) num ; string: num field (def = null)
notes ; string: notes (def = null) notes ; string: notes (def = null)
memo ; string: memo (def = null) memo) ; string: memo (def = null)
) (env-create-multisplit-transaction
(env-transfer-foreign env
env DD MM YY debit credit amount amount DD MM YY
(list
(vector debit (- amount) (- amount))
(vector credit amount amount))
#:description description #:description description
#:void-reason void-reason #:void-reason void-reason
#:reconcile reconcile #:reconcile reconcile
@ -245,6 +222,65 @@
#:memo memo #:memo memo
#:notes notes)) #:notes notes))
;; creates multisplit transaction.
;;
;; input: DD/MM/YY - posting date of transaction
;;
;; list-of-splits, a list of vectors, whose components are
;; (vector account value amount). The total of sum of values
;; must be zero, otherwise an imbalance split will be
;; created. It must contain at least 1 split. The transaction
;; currency is set as currency of the first split.
;;
;; returns: the transaction created, or #f
(define* (env-create-multisplit-transaction
env DD MM YY list-of-splits
#:key ; - the following are optional -
description ; string: description (def = "ponies")
(pricedb? #t) ; boolean: add pricedb entry?
void-reason ; string: void-reason (def = not-voided)
reconcile ; pair : (cons reconciled reconciled-date)
num ; string: num field (def = null)
notes ; string: notes (def = null)
memo) ; string: memo (def = null)
(and (pair? list-of-splits)
(let* ((book (gnc-get-current-book))
(txn (xaccMallocTransaction book))
(first-split (vector-ref (car list-of-splits) 0)))
(xaccTransBeginEdit txn)
(xaccTransSetDescription txn (or description (env-string env "ponies")))
(xaccTransSetCurrency txn (xaccAccountGetCommodity first-split))
(xaccTransSetDate txn DD MM YY)
(for-each
(lambda (split)
(let ((acc (vector-ref split 0))
(val (vector-ref split 1))
(amt (vector-ref split 2))
(newsplit (xaccMallocSplit book)))
(xaccSplitSetParent newsplit txn)
(xaccSplitSetAccount newsplit acc)
(xaccSplitSetValue newsplit val)
(xaccSplitSetAmount newsplit amt)
(if num (gnc-set-num-action txn newsplit num num))
(if memo (xaccSplitSetMemo newsplit memo))
(when reconcile
(xaccSplitSetReconcile newsplit (car reconcile))
(xaccSplitSetDateReconciledSecs newsplit (cdr reconcile)))
(if (and pricedb?
(positive? amt)
(not (gnc-commodity-equiv
(xaccAccountGetCommodity first-split)
(xaccAccountGetCommodity acc))))
(gnc-pricedb-create (xaccAccountGetCommodity first-split)
(xaccAccountGetCommodity acc)
(gnc-dmy2time64 DD MM YY)
(/ val amt)))))
list-of-splits)
(if void-reason (xaccTransVoid txn void-reason))
(if notes (xaccTransSetNotes txn notes))
(xaccTransCommitEdit txn)
txn)))
(define (env-create-root-account env type commodity) (define (env-create-root-account env type commodity)
(env-create-account env type commodity (gnc-get-current-root-account))) (env-create-account env type commodity (gnc-get-current-root-account)))