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

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

View File

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

View File

@ -41,6 +41,7 @@
(export env-any-date)
(export env-transfer)
(export env-transfer-foreign)
(export env-create-multisplit-transaction)
(export env-create-transaction)
(export env-create-account)
(export env-create-root-account)
@ -183,44 +184,17 @@
notes ; string: notes (def = null)
memo ; string: memo (def = null)
)
(let ((txn (xaccMallocTransaction (gnc-get-current-book)))
(split-1 (xaccMallocSplit (gnc-get-current-book)))
(split-2 (xaccMallocSplit (gnc-get-current-book))))
(xaccTransBeginEdit txn)
(xaccTransSetDescription txn (or description "ponies"))
(xaccTransSetCurrency txn (xaccAccountGetCommodity debit))
(xaccTransSetDate txn DD MM YY)
(xaccSplitSetParent split-1 txn)
(xaccSplitSetParent split-2 txn)
(xaccSplitSetAccount split-1 debit)
(xaccSplitSetAccount split-2 credit)
(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))
(env-create-multisplit-transaction
env
DD MM YY
(list (vector debit (- amount1) (- amount1))
(vector credit amount1 amount2))
#:description description
#:void-reason void-reason
#:reconcile reconcile
#:num num
#:memo memo
#:notes notes))
(define* (env-transfer
env
@ -234,10 +208,13 @@
reconcile ; char : reconciled (default = n)
num ; string: num field (def = null)
notes ; string: notes (def = null)
memo ; string: memo (def = null)
)
(env-transfer-foreign
env DD MM YY debit credit amount amount
memo) ; string: memo (def = null)
(env-create-multisplit-transaction
env
DD MM YY
(list
(vector debit (- amount) (- amount))
(vector credit amount amount))
#:description description
#:void-reason void-reason
#:reconcile reconcile
@ -245,6 +222,65 @@
#:memo memo
#: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)
(env-create-account env type commodity (gnc-get-current-root-account)))