mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
Merge Chris Lam's 'test-report-utilities' into maint
This commit is contained in:
John Ralls
commit
f4c0544f1b
@ -12,12 +12,12 @@ gnc_add_test_with_guile(test-link-module-report-system test-link-module.c
|
||||
set(scm_test_report_system_SOURCES
|
||||
test-load-report-system-module.scm
|
||||
test-collectors.scm
|
||||
test-report-utilities.scm
|
||||
test-test-extras.scm
|
||||
)
|
||||
|
||||
set (scm_test_report_system_with_srfi64_SOURCES
|
||||
test-commodity-utils.scm
|
||||
test-report-utilities.scm
|
||||
test-html-utilities-srfi64.scm
|
||||
test-report-system.scm
|
||||
)
|
||||
|
||||
@ -3,20 +3,35 @@
|
||||
(gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
|
||||
(gnc:module-begin-syntax (gnc:module-load "gnucash/report/report-system" 0))
|
||||
|
||||
|
||||
(use-modules (srfi srfi-64))
|
||||
(use-modules (gnucash engine test srfi64-extras))
|
||||
(use-modules (gnucash engine test test-extras))
|
||||
(use-modules (gnucash report report-system test test-extras))
|
||||
(use-modules (gnucash report report-system))
|
||||
|
||||
(define (run-test)
|
||||
(test-account-get-trans-type-splits-interval))
|
||||
(test-runner-factory gnc:test-runner)
|
||||
(test-begin "report-utilities")
|
||||
(test-account-get-trans-type-splits-interval)
|
||||
(test-list-ref-safe)
|
||||
(test-list-set-safe)
|
||||
(test-gnc:monetary->string)
|
||||
(test-commodity-collector)
|
||||
(test-get-account-balances)
|
||||
(test-end "report-utilities"))
|
||||
|
||||
(define (NDayDelta t64 n)
|
||||
(let* ((day-secs (* 60 60 24 n)) ; n days in seconds is n times 60 sec/min * 60 min/h * 24 h/day
|
||||
(new-secs (- t64 day-secs)))
|
||||
new-secs))
|
||||
|
||||
(define (collector->list coll)
|
||||
;; input: collector
|
||||
;; output: list of strings e.g. '("$25.00" "-£15.00")
|
||||
(map gnc:monetary->string (coll 'format gnc:make-gnc-monetary #f)))
|
||||
|
||||
(define (test-account-get-trans-type-splits-interval)
|
||||
(test-group-with-cleanup "test-account-get-trans-type-splits-interval"
|
||||
(let* ((env (create-test-env))
|
||||
(ts-now (gnc-localtime (current-time)))
|
||||
(test-day (tm:mday ts-now))
|
||||
@ -41,4 +56,388 @@
|
||||
ACCT-TYPE-ASSET
|
||||
q-start-date q-end-date)))
|
||||
;; 10 is the right number (5 days, two splits per tx)
|
||||
(or (equal? 10 (length splits)) (begin (format #t "Fail, ~d splits, expected 10~%" (length splits)) #f))))))
|
||||
(test-equal "length splits = 10"
|
||||
10
|
||||
(length splits)))))
|
||||
(teardown)))
|
||||
|
||||
(define (teardown)
|
||||
(gnc-clear-current-session))
|
||||
|
||||
(define (test-list-ref-safe)
|
||||
(test-begin "list-ref-safe")
|
||||
(let ((lst '(1 2)))
|
||||
(test-equal "list-ref-safe normal"
|
||||
1
|
||||
(list-ref-safe lst 0))
|
||||
(test-equal "list-ref-safe out of bounds"
|
||||
#f
|
||||
(list-ref-safe lst 3)))
|
||||
(test-end "list-ref-safe"))
|
||||
|
||||
(define (test-list-set-safe)
|
||||
(test-begin "list-set-safe")
|
||||
(let ((lst (list 1 2)))
|
||||
(list-set-safe! lst 1 3)
|
||||
(test-equal "list-set-safe normal"
|
||||
'(1 3)
|
||||
lst)
|
||||
(list-set-safe! lst 5 1)
|
||||
(test-equal "list-set-safe out-of-bounds"
|
||||
'(1 3 #f #f #f 1)
|
||||
lst))
|
||||
(test-end "list-set-safe"))
|
||||
|
||||
(define (test-gnc:monetary->string)
|
||||
(test-group-with-cleanup "gnc:monetary->string"
|
||||
(let* ((book (gnc-get-current-book))
|
||||
(comm-table (gnc-commodity-table-get-table book))
|
||||
(monetary (gnc:make-gnc-monetary
|
||||
(gnc-commodity-table-lookup comm-table "CURRENCY" "USD")
|
||||
100)))
|
||||
(test-equal "gnc:monetary->string"
|
||||
"$100.00"
|
||||
(gnc:monetary->string monetary)))
|
||||
(teardown)))
|
||||
|
||||
(define (test-commodity-collector)
|
||||
(test-group-with-cleanup "test-commodity-collector"
|
||||
(let* ((book (gnc-get-current-book))
|
||||
(comm-table (gnc-commodity-table-get-table book))
|
||||
(USD (gnc-commodity-table-lookup comm-table "CURRENCY" "USD"))
|
||||
(GBP (gnc-commodity-table-lookup comm-table "CURRENCY" "GBP"))
|
||||
(EUR (gnc-commodity-table-lookup comm-table "CURRENCY" "EUR"))
|
||||
(coll-A (gnc:make-commodity-collector))
|
||||
(coll-B (gnc:make-commodity-collector)))
|
||||
|
||||
(test-equal "commodity-collector empty"
|
||||
'()
|
||||
(collector->list coll-A))
|
||||
|
||||
(coll-A 'add USD 25)
|
||||
(test-equal "coll-A 'add USD25"
|
||||
'("$25.00")
|
||||
(collector->list coll-A))
|
||||
|
||||
(coll-A 'add USD 25)
|
||||
(test-equal "coll-A 'add USD25"
|
||||
'("$50.00")
|
||||
(collector->list coll-A))
|
||||
|
||||
(coll-A 'add GBP 20)
|
||||
(test-equal "coll-A 'add GBP20"
|
||||
'("£20.00" "$50.00")
|
||||
(collector->list coll-A))
|
||||
|
||||
(coll-A 'reset #f #f)
|
||||
(test-equal "coll-A 'reset"
|
||||
'()
|
||||
(collector->list coll-A))
|
||||
|
||||
(coll-A 'add USD 25)
|
||||
(coll-B 'add GBP 20)
|
||||
(test-equal "coll-B 'add GBP20"
|
||||
'("£20.00")
|
||||
(collector->list coll-B))
|
||||
|
||||
(coll-A 'merge coll-B #f)
|
||||
(test-equal "coll-A 'merge coll-B"
|
||||
'("£20.00" "$25.00")
|
||||
(collector->list coll-A))
|
||||
|
||||
(coll-A 'reset #f #f)
|
||||
(coll-A 'add USD 25)
|
||||
(coll-A 'minusmerge coll-B #f)
|
||||
(test-equal "coll-A 'minusmerge coll-B"
|
||||
'("-£20.00" "$25.00")
|
||||
(collector->list coll-A))
|
||||
|
||||
(test-equal "coll-A 'getpair USD"
|
||||
(list USD 25)
|
||||
(coll-A 'getpair USD #f))
|
||||
|
||||
(test-equal "coll-A 'getmonetary USD"
|
||||
(gnc:make-gnc-monetary USD 25)
|
||||
(coll-A 'getmonetary USD #f))
|
||||
|
||||
(test-equal "gnc:commodity-collector-get-negated"
|
||||
'("-$25.00" "£20.00")
|
||||
(collector->list
|
||||
(gnc:commodity-collector-get-negated coll-A)))
|
||||
|
||||
(test-equal "gnc:commodity-collectorlist-get-merged"
|
||||
'("$25.00" "£0.00")
|
||||
(collector->list
|
||||
(gnc:commodity-collectorlist-get-merged (list coll-A coll-B))))
|
||||
|
||||
(test-equal "gnc-commodity-collector-allzero? #f"
|
||||
#f
|
||||
(gnc-commodity-collector-allzero? coll-A))
|
||||
|
||||
;; coll-A has -GBP20 and USD25 for now, bring bal to 0 each
|
||||
(coll-A 'add GBP 20)
|
||||
(coll-A 'add USD -25)
|
||||
(test-equal "gnc-commodity-collector-allzero? #t"
|
||||
#t
|
||||
(gnc-commodity-collector-allzero? coll-A)))
|
||||
(teardown)))
|
||||
|
||||
(define (mnemonic->commodity sym)
|
||||
(gnc-commodity-table-lookup
|
||||
(gnc-commodity-table-get-table (gnc-get-current-book))
|
||||
(gnc-commodity-get-namespace (gnc-default-report-currency))
|
||||
sym))
|
||||
|
||||
(define (structure)
|
||||
(list "Root" (list (cons 'type ACCT-TYPE-ASSET))
|
||||
(list "Asset"
|
||||
(list "Bank")
|
||||
(list "GBP Bank" (list (cons 'commodity (mnemonic->commodity "GBP")))
|
||||
(list "GBP Savings"))
|
||||
(list "Wallet"))
|
||||
(list "Income" (list (cons 'type ACCT-TYPE-INCOME)))
|
||||
(list "Income-GBP" (list (cons 'type ACCT-TYPE-INCOME)
|
||||
(cons 'commodity (mnemonic->commodity "GBP"))))
|
||||
(list "Expenses" (list (cons 'type ACCT-TYPE-EXPENSE)))
|
||||
(list "Liabilities" (list (cons 'type ACCT-TYPE-LIABILITY)))
|
||||
(list "Equity" (list (cons 'type ACCT-TYPE-EQUITY)))
|
||||
))
|
||||
|
||||
(define (create-test-data)
|
||||
(let* ((env (create-test-env))
|
||||
(account-alist (env-create-account-structure-alist env (structure)))
|
||||
(asset (cdr (assoc "Asset" account-alist)))
|
||||
(bank (cdr (assoc "Bank" account-alist)))
|
||||
(gbp-bank (cdr (assoc "GBP Bank" account-alist)))
|
||||
(gbp-savings (cdr (assoc "GBP Savings" account-alist)))
|
||||
(wallet (cdr (assoc "Wallet" account-alist)))
|
||||
(income (cdr (assoc "Income" account-alist)))
|
||||
(gbp-income (cdr (assoc "Income-GBP" account-alist)))
|
||||
(expense (cdr (assoc "Expenses" account-alist)))
|
||||
(liability (cdr (assoc "Liabilities" account-alist)))
|
||||
(equity (cdr (assoc "Equity" account-alist))))
|
||||
;; populate datafile with old transactions
|
||||
(env-transfer env 01 01 1970 bank expense 5 #:description "desc-1" #:num "trn1" #:memo "memo-3")
|
||||
(env-transfer env 31 12 1969 income bank 10 #:description "desc-2" #:num "trn2" #:void-reason "void" #:notes "notes3")
|
||||
(env-transfer env 31 12 1969 income bank 29 #:description "desc-3" #:num "trn3"
|
||||
#:reconcile (cons #\c (gnc-dmy2time64 01 03 1970)))
|
||||
(env-transfer env 01 02 1970 bank expense 15 #:description "desc-4" #:num "trn4" #:notes "notes2" #:memo "memo-1")
|
||||
(env-transfer env 10 01 1970 liability expense 10 #:description "desc-5" #:num "trn5" #:void-reason "any")
|
||||
(env-transfer env 10 01 1970 liability expense 11 #:description "desc-6" #:num "trn6" #:notes "notes1")
|
||||
(env-transfer env 10 02 1970 bank liability 8 #:description "desc-7" #:num "trn7" #:notes "notes1" #:memo "memo-2"
|
||||
#:reconcile (cons #\y (gnc-dmy2time64 01 03 1970)))
|
||||
(env-transfer env 01 01 1975 equity asset 15 #:description "$15 in asset")
|
||||
(env-transfer-foreign env 15 01 2000 gbp-bank bank 10 14 #:description "GBP 10 to USD 14")
|
||||
(env-transfer-foreign env 15 02 2000 bank gbp-bank 9 6 #:description "USD 9 to GBP 6")
|
||||
(env-transfer env 15 03 2000 gbp-bank gbp-savings 5 #:description "GBP 5 from bank to savings")
|
||||
;; A single closing transaction
|
||||
(let ((closing-txn (env-transfer env 31 12 1999 expense equity 111 #:description "Closing")))
|
||||
(xaccTransSetIsClosingTxn closing-txn #t))
|
||||
(for-each (lambda (m)
|
||||
(env-transfer env 08 (1+ m) 1978 gbp-income gbp-bank 51 #:description "#51 income")
|
||||
(env-transfer env 03 (1+ m) 1978 income bank 103 #:description "$103 income")
|
||||
(env-transfer env 15 (1+ m) 1978 bank expense 22 #:description "$22 expense")
|
||||
(env-transfer env 09 (1+ m) 1978 income bank 109 #:description "$109 income"))
|
||||
(iota 12))
|
||||
(let ((mid (floor (/ (+ (gnc-accounting-period-fiscal-start)
|
||||
(gnc-accounting-period-fiscal-end)) 2))))
|
||||
(env-create-transaction env mid bank income 200))))
|
||||
|
||||
|
||||
(define (test-get-account-balances)
|
||||
(define (account-lookup str)
|
||||
(gnc-account-lookup-by-name
|
||||
(gnc-book-get-root-account (gnc-get-current-book))
|
||||
str))
|
||||
|
||||
(create-test-data)
|
||||
|
||||
(test-group-with-cleanup "test-get-account-balances"
|
||||
(let* ((all-accounts (gnc-account-get-descendants
|
||||
(gnc-book-get-root-account (gnc-get-current-book))))
|
||||
(asset (account-lookup "Asset"))
|
||||
(expense (account-lookup "Expenses"))
|
||||
(income (account-lookup "Income"))
|
||||
(bank (account-lookup "Bank"))
|
||||
(gbp-bank (account-lookup "GBP Bank")))
|
||||
(test-equal "gnc:account-get-balance-at-date 1/1/2001 incl children"
|
||||
2301
|
||||
(gnc:account-get-balance-at-date asset (gnc-dmy2time64 01 01 2001) #t))
|
||||
|
||||
(test-equal "gnc:account-get-balance-at-date 1/1/2001 excl children"
|
||||
15
|
||||
(gnc:account-get-balance-at-date asset (gnc-dmy2time64 01 01 2001) #f))
|
||||
|
||||
(test-equal "gnc:account-get-comm-balance-at-date 1/1/2001 incl children"
|
||||
'("£608.00" "$2,301.00")
|
||||
(collector->list
|
||||
(gnc:account-get-comm-balance-at-date asset (gnc-dmy2time64 01 01 2001) #t)))
|
||||
|
||||
(test-equal "gnc:account-get-comm-balance-at-date 1/1/2001 excl children"
|
||||
'("$15.00")
|
||||
(collector->list
|
||||
(gnc:account-get-comm-balance-at-date asset (gnc-dmy2time64 01 01 2001) #f)))
|
||||
|
||||
(test-equal "gnc:account-get-comm-value-interval 1/1/2000-1/1/2001 excl children"
|
||||
'("$9.00" "-£15.00")
|
||||
(collector->list
|
||||
(gnc:account-get-comm-value-interval gbp-bank
|
||||
(gnc-dmy2time64 01 01 2000)
|
||||
(gnc-dmy2time64 01 01 2001)
|
||||
#f)))
|
||||
|
||||
(test-equal "gnc:account-get-comm-value-interval 1/1/2000-1/1/2001 incl children"
|
||||
'("$9.00" "-£10.00")
|
||||
(collector->list
|
||||
(gnc:account-get-comm-value-interval gbp-bank
|
||||
(gnc-dmy2time64 01 01 2000)
|
||||
(gnc-dmy2time64 01 01 2001)
|
||||
#t)))
|
||||
|
||||
(test-equal "gnc:account-get-comm-value-at-date 1/1/2001 excl children"
|
||||
'("$9.00" "£597.00")
|
||||
(collector->list
|
||||
(gnc:account-get-comm-value-at-date gbp-bank
|
||||
(gnc-dmy2time64 01 01 2001)
|
||||
#f)))
|
||||
|
||||
(test-equal "gnc:account-get-comm-value-at-date 1/1/2001 incl children"
|
||||
'("$9.00" "£602.00")
|
||||
(collector->list
|
||||
(gnc:account-get-comm-value-at-date gbp-bank
|
||||
(gnc-dmy2time64 01 01 2001)
|
||||
#t)))
|
||||
|
||||
(test-equal "gnc:accounts-get-comm-total-profit"
|
||||
'("£612.00" "$2,389.00")
|
||||
(collector->list
|
||||
(gnc:accounts-get-comm-total-profit all-accounts
|
||||
(lambda (acct)
|
||||
(gnc:account-get-comm-balance-at-date
|
||||
acct (gnc-dmy2time64 01 01 2001) #f)))))
|
||||
|
||||
(test-equal "gnc:accounts-get-comm-total-income"
|
||||
'("£612.00" "$2,573.00")
|
||||
(collector->list
|
||||
(gnc:accounts-get-comm-total-income all-accounts
|
||||
(lambda (acct)
|
||||
(gnc:account-get-comm-balance-at-date
|
||||
acct (gnc-dmy2time64 01 01 2001) #f)))))
|
||||
|
||||
(test-equal "gnc:accounts-get-comm-total-expense"
|
||||
'("-$184.00")
|
||||
(collector->list
|
||||
(gnc:accounts-get-comm-total-expense all-accounts
|
||||
(lambda (acct)
|
||||
(gnc:account-get-comm-balance-at-date
|
||||
acct (gnc-dmy2time64 01 01 2001) #f)))))
|
||||
|
||||
(test-equal "gnc:accounts-get-comm-total-assets"
|
||||
'("£608.00" "$2,394.00")
|
||||
(collector->list
|
||||
(gnc:accounts-get-comm-total-assets all-accounts
|
||||
(lambda (acct)
|
||||
(gnc:account-get-comm-balance-at-date
|
||||
acct (gnc-dmy2time64 01 01 2001) #f)))))
|
||||
|
||||
(test-equal "gnc:account-get-balance-interval 1/1/60 - 1/1/01 incl children"
|
||||
608
|
||||
(gnc:account-get-balance-interval gbp-bank
|
||||
(gnc-dmy2time64 01 01 1960)
|
||||
(gnc-dmy2time64 01 01 2001)
|
||||
#t))
|
||||
|
||||
(test-equal "gnc:account-get-balance-interval 1/1/60 - 1/1/01 excl children"
|
||||
603
|
||||
(gnc:account-get-balance-interval gbp-bank
|
||||
(gnc-dmy2time64 01 01 1960)
|
||||
(gnc-dmy2time64 01 01 2001)
|
||||
#f))
|
||||
|
||||
(test-equal "gnc:account-comm-balance-interval 1/1/1960-1/1/2001 incl children"
|
||||
'("£608.00")
|
||||
(collector->list
|
||||
(gnc:account-get-comm-balance-interval gbp-bank
|
||||
(gnc-dmy2time64 01 01 1960)
|
||||
(gnc-dmy2time64 01 01 2001)
|
||||
#t)))
|
||||
|
||||
(test-equal "gnc:account-comm-balance-interval 1/1/1960-1/1/2001 excl children"
|
||||
'("£603.00")
|
||||
(collector->list
|
||||
(gnc:account-get-comm-balance-interval gbp-bank
|
||||
(gnc-dmy2time64 01 01 1960)
|
||||
(gnc-dmy2time64 01 01 2001)
|
||||
#f)))
|
||||
|
||||
(test-equal "gnc:accountlist-get-comm-balance-interval"
|
||||
'("$279.00")
|
||||
(collector->list
|
||||
(gnc:accountlist-get-comm-balance-interval (list expense)
|
||||
(gnc-dmy2time64 15 01 1970)
|
||||
(gnc-dmy2time64 01 01 2001))))
|
||||
|
||||
(test-equal "gnc:accountlist-get-comm-balance-interval-with-closing"
|
||||
'("$168.00")
|
||||
(collector->list
|
||||
(gnc:accountlist-get-comm-balance-interval-with-closing (list expense)
|
||||
(gnc-dmy2time64 15 01 1970)
|
||||
(gnc-dmy2time64 01 01 2001))))
|
||||
|
||||
(test-equal "gnc:accountlist-get-comm-balance-at-date"
|
||||
'("$295.00")
|
||||
(collector->list
|
||||
(gnc:accountlist-get-comm-balance-at-date (list expense)
|
||||
(gnc-dmy2time64 01 01 2001))))
|
||||
|
||||
(test-equal "gnc:accountlist-get-comm-balance-interval-with-closing"
|
||||
'("$184.00")
|
||||
(collector->list
|
||||
(gnc:accountlist-get-comm-balance-at-date-with-closing (list expense)
|
||||
(gnc-dmy2time64 01 01 2001))))
|
||||
|
||||
(test-equal "gnc:accounts-count-splits"
|
||||
44
|
||||
(gnc:accounts-count-splits (list expense income)))
|
||||
|
||||
(test-equal "gnc:account-get-total-flow 'in"
|
||||
'("£14.00" "$2,544.00")
|
||||
(collector->list
|
||||
(gnc:account-get-total-flow 'in
|
||||
(list bank)
|
||||
(gnc-dmy2time64 15 01 1970)
|
||||
(gnc-dmy2time64 01 01 2001))))
|
||||
|
||||
(test-equal "gnc:account-get-total-flow 'out"
|
||||
'("-$296.00")
|
||||
(collector->list
|
||||
(gnc:account-get-total-flow 'out
|
||||
(list bank)
|
||||
(gnc-dmy2time64 15 01 1970)
|
||||
(gnc-dmy2time64 01 01 2001))))
|
||||
|
||||
(let ((account-balances (gnc:get-assoc-account-balances
|
||||
(list bank gbp-bank)
|
||||
(lambda (acct)
|
||||
(gnc:account-get-comm-balance-at-date
|
||||
acct (gnc-dmy2time64 01 01 2001) #f)))))
|
||||
|
||||
(test-equal "gnc:get-assoc-account-balances"
|
||||
'("$2,286.00")
|
||||
(collector->list (car (assoc-ref account-balances bank))))
|
||||
|
||||
(test-equal "gnc:select-assoc-account-balance - hit"
|
||||
'("$2,286.00")
|
||||
(collector->list
|
||||
(gnc:select-assoc-account-balance account-balances bank)))
|
||||
|
||||
(test-equal "gnc:select-assoc-account-balance - miss"
|
||||
#f
|
||||
(collector->list
|
||||
(gnc:select-assoc-account-balance account-balances expense)))
|
||||
|
||||
(test-equal "gnc:get-assoc-account-balances-total"
|
||||
'("£603.00" "$2,286.00")
|
||||
(collector->list
|
||||
(gnc:get-assoc-account-balances-total account-balances)))))
|
||||
(teardown)))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user