From 88229370aa65f33a8865c9d65b7069498b2fdc26 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Fri, 31 Aug 2018 10:56:43 +0800 Subject: [PATCH 1/5] [test-report-utilities] convert to srfi-64 and augment tests --- .../report/report-system/test/CMakeLists.txt | 2 +- .../test/test-report-utilities.scm | 28 +++++++++++++++++-- 2 files changed, 26 insertions(+), 4 deletions(-) diff --git a/gnucash/report/report-system/test/CMakeLists.txt b/gnucash/report/report-system/test/CMakeLists.txt index 6d78a2603c..bfe51be03f 100644 --- a/gnucash/report/report-system/test/CMakeLists.txt +++ b/gnucash/report/report-system/test/CMakeLists.txt @@ -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 ) diff --git a/gnucash/report/report-system/test/test-report-utilities.scm b/gnucash/report/report-system/test/test-report-utilities.scm index 2d5bf07079..6865f95041 100644 --- a/gnucash/report/report-system/test/test-report-utilities.scm +++ b/gnucash/report/report-system/test/test-report-utilities.scm @@ -3,13 +3,19 @@ (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-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 @@ -41,4 +47,20 @@ 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)))))) + +(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")) From 125dcfb0ec8a50a02024486639a6e95279488824 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Fri, 31 Aug 2018 11:36:41 +0800 Subject: [PATCH 2/5] [test-report-utilities] test list, monetary->str, commodity-collector - list-set-safe - gnc:monetary->string - commodity-collector --- .../test/test-report-utilities.scm | 118 +++++++++++++++++- 1 file changed, 116 insertions(+), 2 deletions(-) diff --git a/gnucash/report/report-system/test/test-report-utilities.scm b/gnucash/report/report-system/test/test-report-utilities.scm index 6865f95041..f900d8be21 100644 --- a/gnucash/report/report-system/test/test-report-utilities.scm +++ b/gnucash/report/report-system/test/test-report-utilities.scm @@ -14,14 +14,21 @@ (test-begin "report-utilities") (test-account-get-trans-type-splits-interval) (test-list-ref-safe) - (test-end "report-utilities") - ) + (test-list-set-safe) + (test-gnc:monetary->string) + (test-commodity-collector) + (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) (let* ((env (create-test-env)) (ts-now (gnc-localtime (current-time))) @@ -64,3 +71,110 @@ #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))) From 0b069900d03507ef455f19ccde650b7040d56bba Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Fri, 31 Aug 2018 12:42:25 +0800 Subject: [PATCH 3/5] [test-report-utilities] test account balances --- .../test/test-report-utilities.scm | 261 ++++++++++++++++++ 1 file changed, 261 insertions(+) diff --git a/gnucash/report/report-system/test/test-report-utilities.scm b/gnucash/report/report-system/test/test-report-utilities.scm index f900d8be21..c9e2c2e521 100644 --- a/gnucash/report/report-system/test/test-report-utilities.scm +++ b/gnucash/report/report-system/test/test-report-utilities.scm @@ -17,6 +17,7 @@ (test-list-set-safe) (test-gnc:monetary->string) (test-commodity-collector) + (test-get-account-balances) (test-end "report-utilities")) (define (NDayDelta t64 n) @@ -178,3 +179,263 @@ #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))) From ec1536ad50a1e9cbcef5afa57e2b2bce32076978 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Fri, 31 Aug 2018 23:05:05 +0800 Subject: [PATCH 4/5] [test-report-utilities] encapsulate old test with teardown Wrap old (test-account-get-trans-type-splits-interval) and clean up environment with (teardown). --- gnucash/report/report-system/test/test-report-utilities.scm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/gnucash/report/report-system/test/test-report-utilities.scm b/gnucash/report/report-system/test/test-report-utilities.scm index c9e2c2e521..3995e78d4c 100644 --- a/gnucash/report/report-system/test/test-report-utilities.scm +++ b/gnucash/report/report-system/test/test-report-utilities.scm @@ -31,6 +31,7 @@ (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)) @@ -57,7 +58,8 @@ ;; 10 is the right number (5 days, two splits per tx) (test-equal "length splits = 10" 10 - (length splits)))))) + (length splits))))) + (teardown))) (define (teardown) (gnc-clear-current-session)) From 3e8acf293d26ac2dad59eaf1368e2cc3741a714f Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sun, 9 Sep 2018 19:11:45 +0800 Subject: [PATCH 5/5] [test-report-utilities] structure must be retrieved dynamically --- gnucash/report/report-system/test/test-report-utilities.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnucash/report/report-system/test/test-report-utilities.scm b/gnucash/report/report-system/test/test-report-utilities.scm index 3995e78d4c..042b7efb36 100644 --- a/gnucash/report/report-system/test/test-report-utilities.scm +++ b/gnucash/report/report-system/test/test-report-utilities.scm @@ -188,7 +188,7 @@ (gnc-commodity-get-namespace (gnc-default-report-currency)) sym)) -(define structure +(define (structure) (list "Root" (list (cons 'type ACCT-TYPE-ASSET)) (list "Asset" (list "Bank") @@ -205,7 +205,7 @@ (define (create-test-data) (let* ((env (create-test-env)) - (account-alist (env-create-account-structure-alist env structure)) + (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)))