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-engine-extras] augment book data generators

Browse Source 
* txn-currency can be specified explicitly instead of currency of
first split
* split memos can be specified

Note test-register.scm gets some changes because the Trans Num field
was erroneously saved into Split Action fields. Now the num field is
only copied into the TransNum field.
This commit is contained in:
Christopher Lam 2020-08-22 00:10:56 +08:00
parent c38740fcd9
commit 14c523e4f1
2 changed files with 27 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
bindings/guile/test/test-engine-extras.scm
View File

@ -182,6 +182,7 @@
num ; string: num field (def = null)
notes ; string: notes (def = null)
memo ; string: memo (def = null)
currency ; commodity (def = commodity of 1st split)
)
(env-create-multisplit-transaction
env
@ -193,6 +194,7 @@
#:reconcile reconcile
#:num num
#:memo memo
#:currency currency
#:notes notes))
(define* (env-transfer
@ -239,42 +241,46 @@
(pricedb? #t) ; boolean: add pricedb entry?
void-reason ; string: void-reason (def = not-voided)
reconcile ; pair : (cons reconciled reconciled-date)
currency ; currency
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)))
(first-split (vector-ref (car list-of-splits) 0))
(txn-curr (or currency (xaccAccountGetCommodity first-split))))
(xaccTransBeginEdit txn)
(xaccTransSetDescription txn (or description (env-string env "ponies")))
(xaccTransSetCurrency txn (xaccAccountGetCommodity first-split))
(xaccTransSetCurrency txn txn-curr)
(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))
(action (and (> (vector-length split) 3)
(vector-ref split 3)))
(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))
(if memo (xaccSplitSetMemo newsplit memo))
(if action (xaccSplitSetAction newsplit action))
(when reconcile
(xaccSplitSetReconcile newsplit (car reconcile))
(xaccSplitSetDateReconciledSecs newsplit (cdr reconcile)))
(if (and pricedb?
(not (zero? amt))
(not (gnc-commodity-equiv
(xaccAccountGetCommodity first-split)
(xaccAccountGetCommodity acc))))
(gnc-pricedb-create (xaccAccountGetCommodity first-split)
txn-curr (xaccAccountGetCommodity acc))))
(gnc-pricedb-create txn-curr
(xaccAccountGetCommodity acc)
(gnc-dmy2time64 DD MM YY)
(/ val amt)))))
list-of-splits)
(if num (xaccTransSetNum txn num))
(if void-reason (xaccTransVoid txn void-reason))
(if notes (xaccTransSetNotes txn notes))
(xaccTransCommitEdit txn)

20
gnucash/report/reports/standard/test/test-register.scm
View File

@ -66,6 +66,8 @@
(set-option options "__reg" "query" (gnc-query2scm query)))
(let ((sxml (options->sxml options "basic")))
;; this is a simplistic test - counts the number of populated
;; html-table-cells in the register table.
(test-equal "table has 232 cells"
232
(length (sxml->table-row-col sxml 1 #f #f)))
@ -80,8 +82,10 @@
(set-option options "__reg" "journal" #t)
(let ((sxml (options->sxml options "journal")))
(test-equal "table has 339 cells"
339
;; this is a simplistic test - counts the number of populated
;; html-table-cells in the register table.
(test-equal "table has 329 cells"
329
(length (sxml->table-row-col sxml 1 #f #f)))
(test-equal "total debit = #6"
@ -102,8 +106,10 @@
(set-option options "__reg" "ledger-type" #t)
(let ((sxml (options->sxml options "ledger-type")))
(test-equal "table has 343 cells"
343
;; this is a simplistic test - counts the number of populated
;; html-table-cells in the register table.
(test-equal "table has 333 cells"
333
(length (sxml->table-row-col sxml 1 #f #f)))
(test-equal "total debit = #6"
@ -132,8 +138,10 @@
(set-option options "__reg" "double" #t)
(let ((sxml (options->sxml options "double")))
(test-equal "table has 347 cells"
347
;; this is a simplistic test - counts the number of populated
;; html-table-cells in the register table.
(test-equal "table has 337 cells"
337
(length (sxml->table-row-col sxml 1 #f #f)))
(test-equal "total debit = #6"