gnucash maint: Multiple changes pushed
John Ralls
jralls at code.gnucash.org
Sat Dec 29 13:20:23 EST 2018
Updated via https://github.com/Gnucash/gnucash/commit/d3dd8163 (commit)
via https://github.com/Gnucash/gnucash/commit/af6103ba (commit)
via https://github.com/Gnucash/gnucash/commit/14577986 (commit)
via https://github.com/Gnucash/gnucash/commit/83f48352 (commit)
via https://github.com/Gnucash/gnucash/commit/b071022d (commit)
via https://github.com/Gnucash/gnucash/commit/d099a753 (commit)
via https://github.com/Gnucash/gnucash/commit/62d8a65b (commit)
via https://github.com/Gnucash/gnucash/commit/c3253f91 (commit)
via https://github.com/Gnucash/gnucash/commit/2423aeda (commit)
via https://github.com/Gnucash/gnucash/commit/267c3863 (commit)
via https://github.com/Gnucash/gnucash/commit/ecb3b518 (commit)
via https://github.com/Gnucash/gnucash/commit/c13085f3 (commit)
via https://github.com/Gnucash/gnucash/commit/f5f24eb9 (commit)
from https://github.com/Gnucash/gnucash/commit/0d4575da (commit)
commit d3dd81632dfd3e603cd3448393238d62deb19a5b
Merge: 0d4575d af6103b
Author: John Ralls <jralls at ceridwen.us>
Date: Sat Dec 29 10:19:58 2018 -0800
Merge Chris Lam's 'scheme-progress' into maint.
commit af6103ba1db03032bffccdff3700f86f6630dc38
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Dec 30 00:57:07 2018 +0800
Bug 796994 - Unable to generate Tax Report because of pricedb error
Fix typo in fee589b28cb0c554109cb934c24fa573c1dd9757
diff --git a/gnucash/report/locale-specific/us/taxtxf.scm b/gnucash/report/locale-specific/us/taxtxf.scm
index 67b5a67..58e7b43 100644
--- a/gnucash/report/locale-specific/us/taxtxf.scm
+++ b/gnucash/report/locale-specific/us/taxtxf.scm
@@ -712,7 +712,7 @@
(begin ;; do so
(set! missing-pricedb-entry? #f)
(set! pricedb-lookup-price
- (let ((price (gnc-pricedb-lookup-nearest-in-time-t64
+ (let ((price (gnc-pricedb-lookup-nearest-in-time64
pricedb
account-commodity
USD-currency
commit 145779866cf56768d26d77fe67761b6f87d88888
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat Dec 29 08:17:50 2018 +0800
[report-system] deprecate (gnc:account-get-total-flow)
This function is only used in equity-statement.scm -- best move it
there and deprecate the exported function.
diff --git a/gnucash/report/report-system/report-system.scm b/gnucash/report/report-system/report-system.scm
index 1be878f..91a1656 100644
--- a/gnucash/report/report-system/report-system.scm
+++ b/gnucash/report/report-system/report-system.scm
@@ -723,7 +723,7 @@
(export gnc:monetaries-add)
(export gnc:account-get-trans-type-balance-interval)
(export gnc:account-get-trans-type-balance-interval-with-closing)
-(export gnc:account-get-total-flow)
+(export gnc:account-get-total-flow) ;deprecated
(export gnc:account-get-pos-trans-total-interval)
(export gnc:account-get-trans-type-splits-interval)
(export gnc:double-col) ;deprecated
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index e44455a..de91cc4 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -731,6 +731,8 @@ flawed. see report-utilities.scm. please update reports.")
;; returns a commodity collector
;; does NOT do currency exchanges
(define (gnc:account-get-total-flow direction target-account-list from-date to-date)
+ (issue-deprecation-warning
+ "(gnc:account-get-total-flow) is deprecated.")
(let ((total-flow (gnc:make-commodity-collector)))
(for-each
(lambda (target-account)
diff --git a/gnucash/report/report-system/test/test-report-utilities.scm b/gnucash/report/report-system/test/test-report-utilities.scm
index 2ad33af..cc24938 100644
--- a/gnucash/report/report-system/test/test-report-utilities.scm
+++ b/gnucash/report/report-system/test/test-report-utilities.scm
@@ -432,22 +432,6 @@
44
(gnc:accounts-count-splits (list expense income)))
- (test-equal "gnc:account-get-total-flow 'in"
- '(("GBP" . 14) ("USD" . 2544))
- (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"
- '(("USD" . -296))
- (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)
diff --git a/gnucash/report/standard-reports/equity-statement.scm b/gnucash/report/standard-reports/equity-statement.scm
index 9d1e617..a687bd0 100644
--- a/gnucash/report/standard-reports/equity-statement.scm
+++ b/gnucash/report/standard-reports/equity-statement.scm
@@ -181,6 +181,24 @@
options))
+(define (account-get-total-flow direction target-account-list from-date to-date)
+ (let ((total-flow (gnc:make-commodity-collector)))
+ (for-each
+ (lambda (target-account)
+ (for-each
+ (lambda (target-account-split)
+ (let* ((transaction (xaccSplitGetParent target-account-split))
+ (split-value (xaccSplitGetAmount target-account-split)))
+ (if (and (<= from-date (xaccTransGetDate transaction) to-date)
+ (or (and (eq? direction 'in)
+ (positive? split-value))
+ (and (eq? direction 'out)
+ (negative? split-value))))
+ (total-flow 'add (xaccTransGetCurrency transaction) split-value))))
+ (xaccAccountGetSplitList target-account)))
+ target-account-list)
+ total-flow))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; equity-statement-renderer
;; set up the document and add the table
@@ -542,7 +560,7 @@
(net-investment 'minusmerge neg-pre-closing-equity #f);; > 0
(net-investment 'merge neg-start-equity-balance #f) ;; net increase
- (set! withdrawals (gnc:account-get-total-flow 'in equity-accounts start-date end-date))
+ (set! withdrawals (account-get-total-flow 'in equity-accounts start-date end-date))
(set! investments (gnc:make-commodity-collector))
(investments 'merge net-investment #f)
commit 83f48352b1cbba09f2f30f96dba4f990ea42b764
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat Dec 29 08:04:29 2018 +0800
[report-utilities] deprecate (gnc:double-col) function
this is only used in trial-balance. best move it back there and
deprecate the exported function.
diff --git a/gnucash/report/report-system/report-system.scm b/gnucash/report/report-system/report-system.scm
index 756b5bf..1be878f 100644
--- a/gnucash/report/report-system/report-system.scm
+++ b/gnucash/report/report-system/report-system.scm
@@ -726,7 +726,7 @@
(export gnc:account-get-total-flow)
(export gnc:account-get-pos-trans-total-interval)
(export gnc:account-get-trans-type-splits-interval)
-(export gnc:double-col)
+(export gnc:double-col) ;deprecated
(export gnc:budget-get-start-date)
(export gnc:budget-get-end-date)
(export gnc:budget-account-get-net)
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index 206c8e3..e44455a 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -852,14 +852,12 @@ flawed. see report-utilities.scm. please update reports.")
(qof-query-destroy query)
splits))))
-;; utility to assist with double-column balance tables
-;; a request is made with the <req> argument
-;; <req> may currently be 'entry|'debit-q|'credit-q|'zero-q|'debit|'credit
-;; 'debit-q|'credit-q|'zero-q tests the sign of the balance
-;; 'side returns 'debit or 'credit, the column in which to display
-;; 'debt|'credit return the entry, if appropriate, or #f
+;; the following function is only used in trial-balance. best move it
+;; back there, and deprecate this exported function.
(define (gnc:double-col
req signed-balance report-commodity exchange-fn show-comm?)
+ (issue-deprecation-warning
+ "(gnc:double-col) is deprecated.")
(let* ((sum (and signed-balance
(gnc:sum-collector-commodity
signed-balance
diff --git a/gnucash/report/standard-reports/trial-balance.scm b/gnucash/report/standard-reports/trial-balance.scm
index b0042cf..73693ea 100644
--- a/gnucash/report/standard-reports/trial-balance.scm
+++ b/gnucash/report/standard-reports/trial-balance.scm
@@ -134,6 +134,47 @@
(define optname-show-rates (N_ "Show Exchange Rates"))
(define opthelp-show-rates (N_ "Show the exchange rates used."))
+
+;; utility to assist with double-column balance tables
+;; a request is made with the <req> argument
+;; <req> may currently be 'entry|'debit-q|'credit-q|'zero-q|'debit|'credit
+;; 'debit-q|'credit-q|'zero-q tests the sign of the balance
+;; 'side returns 'debit or 'credit, the column in which to display
+;; 'debt|'credit return the entry, if appropriate, or #f
+(define (double-col
+ req signed-balance report-commodity exchange-fn show-comm?)
+ (let* ((sum (and signed-balance
+ (gnc:sum-collector-commodity
+ signed-balance
+ report-commodity
+ exchange-fn)))
+ (amt (and sum (gnc:gnc-monetary-amount sum)))
+ (neg? (and amt (negative? amt)))
+ (bal (if neg?
+ (let ((bal (gnc:make-commodity-collector)))
+ (bal 'minusmerge signed-balance #f)
+ bal)
+ signed-balance))
+ (bal-sum (gnc:sum-collector-commodity
+ bal
+ report-commodity
+ exchange-fn))
+ (balance
+ (if (gnc:uniform-commodity? bal report-commodity)
+ (if (zero? amt) #f bal-sum)
+ (if show-comm?
+ (gnc-commodity-table bal report-commodity exchange-fn)
+ bal-sum))))
+ (car (assoc-ref
+ (list
+ (list 'entry balance)
+ (list 'debit (if neg? #f balance))
+ (list 'credit (if neg? balance #f))
+ (list 'zero-q (if neg? #f (if balance #f #t)))
+ (list 'debit-q (if neg? #f (if balance #t #f)))
+ (list 'credit-q (if neg? #t #f)))
+ req))))
+
;; options generator
(define (trial-balance-options-generator)
(let* ((options (gnc:new-options))
@@ -441,10 +482,10 @@
;; with the proper arguments.
;; (This is used to fill in the Trial Balance columns.)
(define (add-line table label signed-balance)
- (let* ((entry (gnc:double-col
+ (let* ((entry (double-col
'entry signed-balance
report-commodity exchange-fn show-fcur?))
- (credit? (gnc:double-col
+ (credit? (double-col
'credit-q signed-balance
report-commodity exchange-fn show-fcur?))
)
@@ -769,7 +810,7 @@
)
(debit 'merge pos-adjusting #f)
(credit 'merge neg-adjusting #f)
- (if (gnc:double-col
+ (if (double-col
'credit-q pre-adjusting-bal
report-commodity exchange-fn show-fcur?)
(credit 'merge pre-adjusting-bal #f)
@@ -839,10 +880,10 @@
neg-unrealized-gain-collector))
(let* ((ug-row (+ header-rows
(gnc:html-acct-table-num-rows acct-table)))
- (credit? (gnc:double-col
+ (credit? (double-col
'credit-q neg-unrealized-gain-collector
report-commodity exchange-fn show-fcur?))
- (entry (gnc:double-col
+ (entry (double-col
'entry neg-unrealized-gain-collector
report-commodity exchange-fn show-fcur?))
)
@@ -908,14 +949,14 @@
(gross-bal? (list? bal))
(entry (and bal
(not gross-bal?)
- (gnc:double-col
+ (double-col
'entry bal
report-commodity
exchange-fn
show-fcur?)))
(credit? (and bal
(or gross-bal?
- (gnc:double-col
+ (double-col
'credit-q bal
report-commodity
exchange-fn
@@ -936,7 +977,7 @@
))
(debit-entry
(and gross-bal?
- (gnc:double-col
+ (double-col
'entry debit
report-commodity
exchange-fn
@@ -944,7 +985,7 @@
)
(credit-entry
(and gross-bal?
- (gnc:double-col
+ (double-col
'entry credit
report-commodity
exchange-fn
@@ -1050,19 +1091,19 @@
(net-bs 'merge bs-debits #f)
(net-bs 'minusmerge bs-credits #f)
(set! is-entry
- (gnc:double-col
+ (double-col
'entry net-is report-commodity
exchange-fn show-fcur?))
(set! is-credit?
- (gnc:double-col
+ (double-col
'credit-q net-is report-commodity
exchange-fn show-fcur?))
(set! bs-entry
- (gnc:double-col
+ (double-col
'entry net-bs report-commodity
exchange-fn show-fcur?))
(set! bs-credit?
- (gnc:double-col
+ (double-col
'credit-q net-bs report-commodity
exchange-fn show-fcur?))
(gnc:html-table-add-labeled-amount-line!
commit b071022dee7e8ac6a78c8cee114d61e85113cd99
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Dec 28 11:06:21 2018 +0800
[test-cashflow-barchart] upgrade to srfi-64 and sxml
diff --git a/gnucash/report/standard-reports/test/CMakeLists.txt b/gnucash/report/standard-reports/test/CMakeLists.txt
index a3f6e73..d9bf767 100644
--- a/gnucash/report/standard-reports/test/CMakeLists.txt
+++ b/gnucash/report/standard-reports/test/CMakeLists.txt
@@ -1,12 +1,12 @@
set(scm_test_standard_reports_SOURCES
test-cash-flow.scm
- test-cashflow-barchart.scm
)
set(scm_test_with_srfi64_SOURCES
test-standard-category-report.scm
test-standard-net-linechart.scm
test-standard-net-barchart.scm
+ test-cashflow-barchart.scm
test-charts.scm
test-transaction.scm
test-balsheet-pnl.scm
diff --git a/gnucash/report/standard-reports/test/test-cashflow-barchart.scm b/gnucash/report/standard-reports/test/test-cashflow-barchart.scm
index ecb3493..6c251b2 100644
--- a/gnucash/report/standard-reports/test/test-cashflow-barchart.scm
+++ b/gnucash/report/standard-reports/test/test-cashflow-barchart.scm
@@ -24,33 +24,34 @@
(use-modules (gnucash engine))
(use-modules (sw_engine))
-
(use-modules (gnucash engine test test-extras))
+(use-modules (gnucash engine test srfi64-extras))
(use-modules (gnucash report report-system))
(use-modules (gnucash report report-system test test-extras))
(use-modules (gnucash report standard-reports cashflow-barchart))
(use-modules (gnucash report stylesheets))
-
-(use-modules (ice-9 format))
-(use-modules (ice-9 streams))
(use-modules (srfi srfi-1))
+(use-modules (srfi srfi-64))
;; Explicitly set locale to make the report output predictable
(setlocale LC_ALL "C")
(define (run-test)
- (and (test-in-txn)
- (test-out-txn)
- (test-null-txn)))
-
-
-(define (set-option report page tag value)
- ((gnc:option-setter (gnc:lookup-option (gnc:report-options report)
- page tag)) value))
-
-
-(define constructor (record-constructor <report>))
-
+ (test-runner-factory gnc:test-runner)
+ (test-in-txn)
+ (test-out-txn)
+ (test-null-txn))
+
+(define (set-option options page tag value)
+ ((gnc:option-setter (gnc:lookup-option options page tag)) value))
+
+(define (str->num str)
+ (string->number
+ (string-filter
+ (lambda (c)
+ (or (char-numeric? c)
+ (memv c '(#\- #\.))))
+ str)))
(define structure
(list "Root" (list (cons 'type ACCT-TYPE-ASSET))
@@ -60,234 +61,138 @@
(list "Expenses" (list (cons 'type ACCT-TYPE-EXPENSE)))
(list "Income" (list (cons 'type ACCT-TYPE-INCOME)))))
-
;; Test two transactions from income to two different assets in two different days
(define (test-in-txn)
- (let* ((template (gnc:find-report-template cashflow-barchart-uuid))
- (options (gnc:make-report-options cashflow-barchart-uuid))
- (report (constructor cashflow-barchart-uuid "bar" options
- #t #t #f #f ""))
- (renderer (gnc:report-template-renderer template)))
- (let* ((env (create-test-env))
- (account-alist (env-create-account-structure-alist env structure))
- (bank-account (cdr (assoc "Bank" account-alist)))
- (wallet-account (cdr (assoc "Wallet" account-alist)))
- (expense-account (cdr (assoc "Expenses" account-alist)))
- (income-account (cdr (assoc "Income" account-alist)))
- (date-0 (gnc:get-start-this-month))
- (date-1 (gnc:time64-next-day date-0))
- (date-2 (gnc:time64-next-day date-1)))
- (env-create-transaction env
- date-1
- bank-account
- income-account
- 1/1)
- (env-create-transaction env
- date-2
- wallet-account
- income-account
- 5/1)
- (begin
- (set-option report gnc:pagename-display "Show Table" #t)
- (set-option report gnc:pagename-general "Start Date" (cons 'absolute date-0))
- (set-option report gnc:pagename-general "End Date" (cons 'absolute date-2))
- (set-option report gnc:pagename-general "Step Size" 'DayDelta)
- (set-option report gnc:pagename-general "Price Source" 'pricedb-nearest)
- (set-option report gnc:pagename-general "Report's currency" (gnc-default-report-currency))
- (set-option report gnc:pagename-accounts "Accounts" (list wallet-account bank-account))
- ;; (format #t "Create first transaction on ~a~%" (gnc-ctime date-1))
- ;; (format #t "Create second transaction on ~a~%" (gnc-ctime date-2))
- (let ((doc (renderer report)))
- (gnc:html-document-set-style-sheet! doc (gnc:report-stylesheet report))
- (let* ((result (gnc:html-document-render doc #f))
- (tbl (stream->list
- (pattern-streamer "<tr>"
- (list (list "<td>([0-9]+)/([0-9]+)/([0-9]+)</td>"
- 1 2 3)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
- result)))
- (total (stream->list
- (pattern-streamer "<tr><td>Total</td>"
- (list (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
- result))))
- ;; (format #t "Report Result ~a~%" result)
- (and (every (lambda (row) ; test in=net & out=0 in all rows (all days)
- (and (or (equal? (second row) (fourth row))
- (begin (format #t "Failed, ~a and ~a differ~%" (second row) (fourth row)) #f))
- (or (= 0 (string->number (car (third row))))
- (begin (format #t "Failed ~d isn't 0~%" (car (third row))) #f))))
- tbl)
- (or (= 0 (tbl-ref->number tbl 0 1))
- (begin (format #t "Failed refnum ~g isn't 0~%" (tbl-ref->number tbl 0 1)) #f)) ; 1st day in =0
- (or (= 1 (tbl-ref->number tbl 1 1)) (begin (format #t "Failed refnum ~g isn't 1~%" (tbl-ref->number tbl 1 1)) #f)) ; 2nd day in =1
- (or (= 5 (tbl-ref->number tbl 2 1)) (begin (format #t "Failed refnum ~g isn't 5~%" (tbl-ref->number tbl 2 1)) #f)) ; 3rd day in =5
- (or (= (tbl-ref->number total 0 0) (tbl-ref->number total 0 2)) (begin (format #t "Failed refnums ~g and ~g differ ~%" (tbl-ref->number total 0 0) (tbl-ref->number total 0 2)) #f)); total in=total net
- (or (= 0 (tbl-ref->number total 0 1)) (begin (format #t "Failed refnum ~g isn't 0~%" (tbl-ref->number total 0 1)) #f)) ; total out=0
- (or (= 3 (tbl-row-count tbl)) (begin (format #t "Failed row count ~g isn't 3~%" (tbl-row-count tbl)) #f))
- (or (= 4 (tbl-column-count tbl)) (begin (format #t "Failed column count ~g isn't 4~%" (tbl-column-count tbl)) #f))))
- )
- )
- )
- )
-)
+ (let* ((options (gnc:make-report-options cashflow-barchart-uuid))
+ (env (create-test-env))
+ (account-alist (env-create-account-structure-alist env structure))
+ (bank-account (cdr (assoc "Bank" account-alist)))
+ (wallet-account (cdr (assoc "Wallet" account-alist)))
+ (expense-account (cdr (assoc "Expenses" account-alist)))
+ (income-account (cdr (assoc "Income" account-alist)))
+ (date-0 (gnc:get-start-this-month))
+ (date-1 (gnc:time64-next-day date-0))
+ (date-2 (gnc:time64-next-day date-1)))
+ (env-create-transaction env date-1 bank-account income-account 1)
+ (env-create-transaction env date-2 wallet-account income-account 5)
+ (set-option options gnc:pagename-display "Show Table" #t)
+ (set-option options gnc:pagename-general "Start Date" (cons 'absolute date-0))
+ (set-option options gnc:pagename-general "End Date" (cons 'absolute date-2))
+ (set-option options gnc:pagename-general "Step Size" 'DayDelta)
+ (set-option options gnc:pagename-general "Price Source" 'pricedb-nearest)
+ (set-option options gnc:pagename-general "Report's currency" (gnc-default-report-currency))
+ (set-option options gnc:pagename-accounts "Accounts" (list wallet-account bank-account))
+
+ (let ((sxml (gnc:options->sxml cashflow-barchart-uuid options "test-cashflow-barchart"
+ "test-in-txn" #:strip-tag "script")))
+ (test-begin "test-in-txn")
+ (test-assert "in = net, out=0"
+ (every (lambda (in out net)
+ (and (= in net) (zero? out)))
+ (map str->num (sxml->table-row-col sxml 1 #f 2))
+ (map str->num (sxml->table-row-col sxml 1 #f 3))
+ (map str->num (sxml->table-row-col sxml 1 #f 4))))
+ (test-equal "day in"
+ '(0.0 1.0 5.0 6.0)
+ (map str->num (sxml->table-row-col sxml 1 #f 2)))
+ (test-equal "4 columns"
+ 4
+ (length (sxml->table-row-col sxml 1 1 #f)))
+ (test-equal "4 rows"
+ 4
+ (length (sxml->table-row-col sxml 1 #f 1)))
+ (test-end "test-in-txn"))))
;; Test two transactions from two different assets to expense in two different days
(define (test-out-txn)
- (let* ((template (gnc:find-report-template cashflow-barchart-uuid))
- (options (gnc:make-report-options cashflow-barchart-uuid))
- (report (constructor cashflow-barchart-uuid "bar" options
- #t #t #f #f ""))
- (renderer (gnc:report-template-renderer template)))
- (let* ((env (create-test-env))
- (account-alist (env-create-account-structure-alist env structure))
- (bank-account (cdr (assoc "Bank" account-alist)))
- (wallet-account (cdr (assoc "Wallet" account-alist)))
- (expense-account (cdr (assoc "Expenses" account-alist)))
- (income-account (cdr (assoc "Income" account-alist)))
- (date-0 (gnc:get-start-this-month))
- (date-1 (gnc:time64-next-day date-0))
- (date-2 (gnc:time64-next-day date-1)))
- (env-create-transaction env
- date-1
- bank-account
- income-account
- 100/1) ; large in txn to avoid negative net (hard to parse)
- (env-create-transaction env
- date-1
- expense-account
- bank-account
- 1/1)
- (env-create-transaction env
- date-2
- wallet-account
- income-account
- 100/1) ; large in txn to avoid negative net (hard to parse)
- (env-create-transaction env
- date-2
- expense-account
- wallet-account
- 5/1)
- (begin
- (set-option report gnc:pagename-display "Show Table" #t)
- (set-option report gnc:pagename-general "Start Date" (cons 'absolute date-0))
- (set-option report gnc:pagename-general "End Date" (cons 'absolute date-2))
- (set-option report gnc:pagename-general "Step Size" 'DayDelta)
- (set-option report gnc:pagename-general "Price Source" 'pricedb-nearest)
- (set-option report gnc:pagename-general "Report's currency" (gnc-default-report-currency))
- (set-option report gnc:pagename-accounts "Accounts" (list wallet-account bank-account))
-
- (let ((doc (renderer report)))
- (gnc:html-document-set-style-sheet! doc (gnc:report-stylesheet report))
- (let* ((result (gnc:html-document-render doc #f))
- (tbl (stream->list
- (pattern-streamer "<tr>"
- (list (list "<td>([0-9]+)/([0-9]+)/([0-9]+)</td>"
- 1 2 3)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
- result)))
- (total (stream->list
- (pattern-streamer "<tr><td>Total</td>"
- (list (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
- result))))
- (and (every (lambda (row) ; test in-out=net in all rows (all days)
- (let ((in (string->number (car (second row))))
- (out (string->number (car (third row))))
- (net (string->number (car (fourth row)))))
- (= (- in out) net)))
- tbl)
- (= 0 (tbl-ref->number tbl 0 2)) ; 1st day out =0
- (= 1 (tbl-ref->number tbl 1 2)) ; 2nd day out =1
- (= 5 (tbl-ref->number tbl 2 2)) ; 3rd day out =5
- (= (- (tbl-ref->number total 0 0) (tbl-ref->number total 0 1)) ; total in-total out=total net
- (tbl-ref->number total 0 2))
- (= 6 (tbl-ref->number total 0 1)) ; total out=6
- (= 3 (tbl-row-count tbl))
- (= 4 (tbl-column-count tbl)))))
- )
- )
- )
- )
+ (let* ((options (gnc:make-report-options cashflow-barchart-uuid))
+ (env (create-test-env))
+ (account-alist (env-create-account-structure-alist env structure))
+ (bank-account (cdr (assoc "Bank" account-alist)))
+ (wallet-account (cdr (assoc "Wallet" account-alist)))
+ (expense-account (cdr (assoc "Expenses" account-alist)))
+ (income-account (cdr (assoc "Income" account-alist)))
+ (date-0 (gnc:get-start-this-month))
+ (date-1 (gnc:time64-next-day date-0))
+ (date-2 (gnc:time64-next-day date-1)))
+ ;; large in txn to avoid negative net (hard to parse):
+ (env-create-transaction env date-1 bank-account income-account 100)
+ (env-create-transaction env date-1 expense-account bank-account 1)
+ ;; large in txn to avoid negative net (hard to parse):
+ (env-create-transaction env date-2 wallet-account income-account 100)
+ (env-create-transaction env date-2 expense-account wallet-account 5)
+
+ (set-option options gnc:pagename-display "Show Table" #t)
+ (set-option options gnc:pagename-general "Start Date" (cons 'absolute date-0))
+ (set-option options gnc:pagename-general "End Date" (cons 'absolute date-2))
+ (set-option options gnc:pagename-general "Step Size" 'DayDelta)
+ (set-option options gnc:pagename-general "Price Source" 'pricedb-nearest)
+ (set-option options gnc:pagename-general "Report's currency" (gnc-default-report-currency))
+ (set-option options gnc:pagename-accounts "Accounts" (list wallet-account bank-account))
+
+ (let ((sxml (gnc:options->sxml cashflow-barchart-uuid options "test-cashflow-barchart"
+ "test-out-txn" #:strip-tag "script")))
+ (test-begin "test-out-txn")
+ (test-assert "in - out = net"
+ (every (lambda (in out net)
+ (= (- in out) net))
+ (map str->num (sxml->table-row-col sxml 1 #f 2))
+ (map str->num (sxml->table-row-col sxml 1 #f 3))
+ (map str->num (sxml->table-row-col sxml 1 #f 4))))
+ (test-equal "money out"
+ '(0.0 1.0 5.0 6.0)
+ (map str->num (sxml->table-row-col sxml 1 #f 3)))
+ (test-equal "4 columns"
+ 4
+ (length (sxml->table-row-col sxml 1 1 #f)))
+ (test-equal "4 rows"
+ 4
+ (length (sxml->table-row-col sxml 1 #f 1)))
+ (test-end "test-out-txn"))))
;; Test null transaction (transaction between assets)
;; This test is identical to test-in-txn but with an extra transaction between assets
(define (test-null-txn)
- (let* ((template (gnc:find-report-template cashflow-barchart-uuid))
- (options (gnc:make-report-options cashflow-barchart-uuid))
- (report (constructor cashflow-barchart-uuid "bar" options
- #t #t #f #f ""))
- (renderer (gnc:report-template-renderer template)))
- (let* ((env (create-test-env))
- (account-alist (env-create-account-structure-alist env structure))
- (bank-account (cdr (assoc "Bank" account-alist)))
- (wallet-account (cdr (assoc "Wallet" account-alist)))
- (expense-account (cdr (assoc "Expenses" account-alist)))
- (income-account (cdr (assoc "Income" account-alist)))
- (date-0 (gnc:get-start-this-month))
- (date-1 (gnc:time64-next-day date-0))
- (date-2 (gnc:time64-next-day date-1)))
- (env-create-transaction env
- date-1
- bank-account
- income-account
- 1/1)
- (env-create-transaction env
- date-1
- bank-account
- wallet-account
- 20/1) ; this transaction should not be counted
- (env-create-transaction env
- date-2
- wallet-account
- income-account
- 5/1)
-
- (begin
- (set-option report gnc:pagename-display "Show Table" #t)
- (set-option report gnc:pagename-general "Start Date" (cons 'absolute date-0))
- (set-option report gnc:pagename-general "End Date" (cons 'absolute date-2))
- (set-option report gnc:pagename-general "Step Size" 'DayDelta)
- (set-option report gnc:pagename-general "Price Source" 'pricedb-nearest)
- (set-option report gnc:pagename-general "Report's currency" (gnc-default-report-currency))
- (set-option report gnc:pagename-accounts "Accounts" (list wallet-account bank-account))
-
- (let ((doc (renderer report)))
- (gnc:html-document-set-style-sheet! doc (gnc:report-stylesheet report))
- (let* ((result (gnc:html-document-render doc #f))
- (tbl (stream->list
- (pattern-streamer "<tr>"
- (list (list "<td>([0-9]+)/([0-9]+)/([0-9]+)</td>"
- 1 2 3)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
- result)))
- (total (stream->list
- (pattern-streamer "<tr><td>Total</td>"
- (list (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
- result))))
- (and (every (lambda (row) ; test in=net & out=0 in all rows (all days)
- (and (equal? (second row) (fourth row))
- (= 0 (string->number (car (third row))))))
- tbl)
- (= 0 (tbl-ref->number tbl 0 1)) ; 1st day in =0
- (= 1 (tbl-ref->number tbl 1 1)) ; 2nd day in =1
- (= 5 (tbl-ref->number tbl 2 1)) ; 3rd day in =5
- (= (tbl-ref->number total 0 0) (tbl-ref->number total 0 2)) ; total in=total net
- (= 0 (tbl-ref->number total 0 1)) ; total out=0
- (= 3 (tbl-row-count tbl))
- (= 4 (tbl-column-count tbl)))))
- )
- )
- )
- )
+ (let* ((options (gnc:make-report-options cashflow-barchart-uuid))
+ (env (create-test-env))
+ (account-alist (env-create-account-structure-alist env structure))
+ (bank-account (cdr (assoc "Bank" account-alist)))
+ (wallet-account (cdr (assoc "Wallet" account-alist)))
+ (expense-account (cdr (assoc "Expenses" account-alist)))
+ (income-account (cdr (assoc "Income" account-alist)))
+ (date-0 (gnc:get-start-this-month))
+ (date-1 (gnc:time64-next-day date-0))
+ (date-2 (gnc:time64-next-day date-1)))
+ (env-create-transaction env date-1 bank-account income-account 1)
+ ;; the following transaction should not be counted
+ (env-create-transaction env date-1 bank-account wallet-account 20)
+ (env-create-transaction env date-2 wallet-account income-account 5)
+
+ (set-option options gnc:pagename-display "Show Table" #t)
+ (set-option options gnc:pagename-general "Start Date" (cons 'absolute date-0))
+ (set-option options gnc:pagename-general "End Date" (cons 'absolute date-2))
+ (set-option options gnc:pagename-general "Step Size" 'DayDelta)
+ (set-option options gnc:pagename-general "Price Source" 'pricedb-nearest)
+ (set-option options gnc:pagename-general "Report's currency" (gnc-default-report-currency))
+ (set-option options gnc:pagename-accounts "Accounts" (list wallet-account bank-account))
+
+ (let ((sxml (gnc:options->sxml cashflow-barchart-uuid options "test-cashflow-barchart"
+ "test-null-txn" #:strip-tag "script")))
+ (test-begin "test-null-txn")
+ (test-assert "in = net, out=0"
+ (every (lambda (in out net)
+ (and (= in net) (zero? out)))
+ (map str->num (sxml->table-row-col sxml 1 #f 2))
+ (map str->num (sxml->table-row-col sxml 1 #f 3))
+ (map str->num (sxml->table-row-col sxml 1 #f 4))))
+ (test-equal "day in"
+ '(0.0 1.0 5.0 6.0)
+ (map str->num (sxml->table-row-col sxml 1 #f 2)))
+ (test-equal "4 columns"
+ 4
+ (length (sxml->table-row-col sxml 1 1 #f)))
+ (test-equal "4 rows"
+ 4
+ (length (sxml->table-row-col sxml 1 #f 1)))
+ (test-end "test-null-txn"))))
commit d099a75381a16eedf9286d4c557748b671ec3f9b
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Dec 27 17:48:56 2018 +0800
[test-standard-net-barchart] upgrade to srfi-64 and sxml
diff --git a/gnucash/report/standard-reports/test/CMakeLists.txt b/gnucash/report/standard-reports/test/CMakeLists.txt
index a764470..a3f6e73 100644
--- a/gnucash/report/standard-reports/test/CMakeLists.txt
+++ b/gnucash/report/standard-reports/test/CMakeLists.txt
@@ -1,12 +1,12 @@
set(scm_test_standard_reports_SOURCES
test-cash-flow.scm
test-cashflow-barchart.scm
- test-standard-net-barchart.scm
)
set(scm_test_with_srfi64_SOURCES
test-standard-category-report.scm
test-standard-net-linechart.scm
+ test-standard-net-barchart.scm
test-charts.scm
test-transaction.scm
test-balsheet-pnl.scm
diff --git a/gnucash/report/standard-reports/test/test-standard-net-barchart.scm b/gnucash/report/standard-reports/test/test-standard-net-barchart.scm
index d62cb69..e189293 100644
--- a/gnucash/report/standard-reports/test/test-standard-net-barchart.scm
+++ b/gnucash/report/standard-reports/test/test-standard-net-barchart.scm
@@ -17,17 +17,15 @@
;; Boston, MA 02110-1301, USA gnu at gnu.org
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(debug-set! stack 50000)
-
(use-modules (gnucash gnc-module))
(gnc:module-begin-syntax (gnc:module-load "gnucash/report/report-system" 0))
(use-modules (gnucash engine))
(use-modules (sw_engine))
-(use-modules (ice-9 format))
-(use-modules (ice-9 streams))
(use-modules (srfi srfi-1))
+(use-modules (srfi srfi-64))
(use-modules (gnucash report stylesheets))
(use-modules (gnucash engine test test-extras))
+(use-modules (gnucash engine test srfi64-extras))
(use-modules (gnucash report report-system test test-extras))
(use-modules (gnucash report standard-reports net-charts))
@@ -35,336 +33,272 @@
(setlocale LC_ALL "C")
(define (run-test)
+ (test-runner-factory gnc:test-runner)
(run-net-asset-income-test net-worth-barchart-uuid income-expense-barchart-uuid))
-(define (set-option report page tag value)
- ((gnc:option-setter (gnc:lookup-option (gnc:report-options report)
- page tag)) value))
-
-(define constructor (record-constructor <report>))
+(define (set-option options page tag value)
+ ((gnc:option-setter (gnc:lookup-option options page tag)) value))
(define (run-net-asset-income-test asset-report-uuid income-report-uuid)
- (and (two-txn-test asset-report-uuid)
- (two-txn-test-2 asset-report-uuid)
- (two-txn-test-income income-report-uuid)
-
- (null-test asset-report-uuid)
- (null-test income-report-uuid)
- (single-txn-test asset-report-uuid)
- (closing-test income-report-uuid)
- #t))
+ (null-test asset-report-uuid)
+ (null-test income-report-uuid)
+ (single-txn-test asset-report-uuid)
+ (two-txn-test asset-report-uuid)
+ (two-txn-test-2 asset-report-uuid)
+ (two-txn-test-income income-report-uuid)
+ (closing-test income-report-uuid))
;; Just prove that the report exists.
(define (null-test uuid)
- (let* ((template (gnc:find-report-template uuid))
- (options (gnc:make-report-options uuid))
- (report (constructor uuid "bar" options
- #t #t #f #f ""))
- (renderer (gnc:report-template-renderer template)))
-
- (let ((doc (renderer report)))
- (gnc:html-document-set-style-sheet! doc
- (gnc:report-stylesheet report))
- ;;(format #t "render: ~a\n" (gnc:html-document-render doc #f))
- #t
- )))
+ (let* ((options (gnc:make-report-options uuid)))
+ (gnc:options->render uuid options "test-standard-net-barchart" "null-test")))
(define (single-txn-test uuid)
- (let* ((template (gnc:find-report-template uuid))
- (options (gnc:make-report-options uuid))
- (report (constructor uuid "bar" options
- #t #t #f #f ""))
- (renderer (gnc:report-template-renderer template)))
- (let* ((env (create-test-env))
- (my-asset-account (env-create-root-account env ACCT-TYPE-ASSET
- (gnc-default-report-currency)))
- (my-expense-account (env-create-root-account env ACCT-TYPE-EXPENSE
- (gnc-default-report-currency)))
- (my-income-account (env-create-root-account env ACCT-TYPE-INCOME
- (gnc-default-report-currency))))
- (env-create-transaction env
- (gnc:get-start-this-month)
- my-income-account
- my-asset-account
- -1/1)
- (begin
- (set-option report gnc:pagename-display "Show table" #t)
- (set-option report gnc:pagename-general "Start Date"
- (cons 'absolute (gnc:get-start-this-month)))
- (set-option report gnc:pagename-general "End Date"
- (cons 'absolute (gnc:get-start-this-month)))
- (set-option report gnc:pagename-general "Step Size" 'DayDelta)
- (set-option report gnc:pagename-general "Price Source" 'pricedb-nearest)
- (set-option report gnc:pagename-general "Report's currency" (gnc-default-report-currency))
- (set-option report gnc:pagename-accounts "Accounts" (list my-asset-account))
-
- (let ((doc (renderer report)))
- (gnc:html-document-set-style-sheet! doc
- (gnc:report-stylesheet report))
- (let* ((result (gnc:html-document-render doc #f))
- (tbl (stream->list
- (pattern-streamer "<tr>"
- (list (list "<td>([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
- 1 2 3)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
- result))))
- (or (and (= 1 (tbl-ref->number tbl 0 1))
- (= 0 (tbl-ref->number tbl 0 2))
- (= 1 (tbl-ref->number tbl 0 3))
- (= 1 (tbl-row-count tbl))
- (= 4 (tbl-column-count tbl)))
- (begin (format #t "Single-txn test ~a failed~%" uuid) #f))
- ))))))
+ (let* ((options (gnc:make-report-options uuid))
+ (env (create-test-env))
+ (my-asset-account (env-create-root-account env ACCT-TYPE-ASSET
+ (gnc-default-report-currency)))
+ (my-expense-account (env-create-root-account env ACCT-TYPE-EXPENSE
+ (gnc-default-report-currency)))
+ (my-income-account (env-create-root-account env ACCT-TYPE-INCOME
+ (gnc-default-report-currency))))
+ (env-create-transaction env
+ (gnc:get-start-this-month)
+ my-income-account
+ my-asset-account
+ -1/1)
+ (set-option options gnc:pagename-display "Show table" #t)
+ (set-option options gnc:pagename-general "Start Date"
+ (cons 'absolute (gnc:get-start-this-month)))
+ (set-option options gnc:pagename-general "End Date"
+ (cons 'absolute (gnc:get-start-this-month)))
+ (set-option options gnc:pagename-general "Step Size" 'DayDelta)
+ (set-option options gnc:pagename-general "Price Source" 'pricedb-nearest)
+ (set-option options gnc:pagename-general "Report's currency" (gnc-default-report-currency))
+ (set-option options gnc:pagename-accounts "Accounts" (list my-asset-account))
+ (let ((sxml (gnc:options->sxml uuid options "test-standard-net-barchart"
+ "single-txn-test" #:strip-tag "script")))
+ (test-begin "single-txn-test")
+ (test-equal "assets $1.00"
+ '("$1.00")
+ (sxml->table-row-col sxml 1 1 2))
+ (test-equal "liability $0.00"
+ '("$0.00")
+ (sxml->table-row-col sxml 1 1 3))
+ (test-equal "net $0.00"
+ '("$1.00")
+ (sxml->table-row-col sxml 1 1 4))
+ (test-equal "1 rows"
+ 1
+ (length (sxml->table-row-col sxml 1 #f 1)))
+ (test-equal "4 columns"
+ 4
+ (length (sxml->table-row-col sxml 1 1 #f)))
+ (test-end "single-txn-test"))))
(define (two-txn-test uuid)
- (let* ((template (gnc:find-report-template uuid))
- (options (gnc:make-report-options uuid))
- (report (constructor uuid "bar" options
- #t #t #f #f ""))
- (renderer (gnc:report-template-renderer template)))
- (let* ((env (create-test-env))
- (my-asset-account (env-create-root-account env ACCT-TYPE-ASSET
- (gnc-default-report-currency)))
- (my-expense-account (env-create-root-account env ACCT-TYPE-EXPENSE
- (gnc-default-report-currency)))
- (my-income-account (env-create-root-account env ACCT-TYPE-INCOME
- (gnc-default-report-currency)))
- (date-0 (gnc:get-start-this-month))
- (date-1 (gnc:time64-next-day date-0))
- (date-2 (gnc:time64-next-day date-1)))
- (env-create-transaction env
- date-1
- my-income-account
- my-asset-account
- -1/1)
- (env-create-transaction env
- date-2
- my-income-account
- my-asset-account
- -5/1)
- (begin
- (set-option report gnc:pagename-display "Show table" #t)
- (set-option report gnc:pagename-general "Start Date" (cons 'absolute date-0))
- (set-option report gnc:pagename-general "End Date" (cons 'absolute date-2))
- (set-option report gnc:pagename-general "Step Size" 'DayDelta)
- (set-option report gnc:pagename-general "Price Source" 'pricedb-nearest)
- (set-option report gnc:pagename-general "Report's currency" (gnc-default-report-currency))
- (set-option report gnc:pagename-accounts "Accounts" (list my-asset-account))
+ (let* ((options (gnc:make-report-options uuid))
+ (env (create-test-env))
+ (my-asset-account (env-create-root-account env ACCT-TYPE-ASSET
+ (gnc-default-report-currency)))
+ (my-expense-account (env-create-root-account env ACCT-TYPE-EXPENSE
+ (gnc-default-report-currency)))
+ (my-income-account (env-create-root-account env ACCT-TYPE-INCOME
+ (gnc-default-report-currency)))
+ (date-0 (gnc:get-start-this-month))
+ (date-1 (gnc:time64-next-day date-0))
+ (date-2 (gnc:time64-next-day date-1)))
+ (env-create-transaction env
+ date-1
+ my-income-account
+ my-asset-account
+ -1/1)
+ (env-create-transaction env
+ date-2
+ my-income-account
+ my-asset-account
+ -5/1)
+ (set-option options gnc:pagename-display "Show table" #t)
+ (set-option options gnc:pagename-general "Start Date" (cons 'absolute date-0))
+ (set-option options gnc:pagename-general "End Date" (cons 'absolute date-2))
+ (set-option options gnc:pagename-general "Step Size" 'DayDelta)
+ (set-option options gnc:pagename-general "Price Source" 'pricedb-nearest)
+ (set-option options gnc:pagename-general "Report's currency" (gnc-default-report-currency))
+ (set-option options gnc:pagename-accounts "Accounts" (list my-asset-account))
- (let ((doc (renderer report)))
- (gnc:html-document-set-style-sheet! doc
- (gnc:report-stylesheet report))
- (let* ((result (gnc:html-document-render doc #f))
- (tbl (stream->list
- (pattern-streamer "<tr>"
- (list (list "<td>([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
- 1 2 3)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
- result))))
- (or (and (every (lambda (row)
- (and (or (equal? (second row) (fourth row))
- (begin (format "Second Element ~g != fourth element ~g~%" (second row) (fourth row)) #f))
- (or (= 0 (string->number (car (third row))))
- (begin (format "third row element ~a not 0~%" (car (third row))) #f))))
- tbl)
- (or (= 0 (tbl-ref->number tbl 0 1))
- (begin (format #t "Item 1 failed: ~g not 0~%" (tbl-ref->number tbl 0 1)) #f))
- (or (= 1 (tbl-ref->number tbl 1 1))
- (begin (format #t "Item 1 failed: ~g not 1~%" (tbl-ref->number tbl 1 1)) #f))
- (or (= 6 (tbl-ref->number tbl 2 1))
- (begin (format #t "Item 2 failed: ~g not 6~%" (tbl-ref->number tbl 2 1)) #f))
- (or (= 3 (tbl-row-count tbl))
- (begin (format #t "Item 3 failed: ~g not 3~%" (tbl-row-count tbl)) #f))
- (or (= 4 (tbl-column-count tbl))
- (begin (format #t "Item 4 failed: ~g not 4~%" (tbl-column-count tbl)) #f)))
- (begin (format #t "Two-txn test ~a failed~%" uuid) #f))
- ))))))
+ (let ((sxml (gnc:options->sxml uuid options "test-standard-net-barchart"
+ "two-txn-test" #:strip-tag "script")))
+ (test-begin "two-txn-test")
+ (test-equal "asset $0.00"
+ '("$0.00")
+ (sxml->table-row-col sxml 1 1 2))
+ (test-equal "asset $1.00"
+ '("$1.00")
+ (sxml->table-row-col sxml 1 2 2))
+ (test-equal "asset $6.00"
+ '("$6.00")
+ (sxml->table-row-col sxml 1 3 2))
+ (test-equal "4 columns"
+ 4
+ (length (sxml->table-row-col sxml 1 1 #f)))
+ (test-equal "3 rows"
+ 3
+ (length (sxml->table-row-col sxml 1 #f 1)))
+ (test-end "two-txn-test")
+ sxml)))
(define (two-txn-test-2 uuid)
- (let* ((template (gnc:find-report-template uuid))
- (options (gnc:make-report-options uuid))
- (report (constructor uuid "bar" options
- #t #t #f #f ""))
- (renderer (gnc:report-template-renderer template)))
- (let* ((env (create-test-env))
- (my-asset-account (env-create-root-account env ACCT-TYPE-ASSET
- (gnc-default-report-currency)))
- (my-liability-account (env-create-root-account env ACCT-TYPE-LIABILITY
- (gnc-default-report-currency)))
- (my-expense-account (env-create-root-account env ACCT-TYPE-EXPENSE
- (gnc-default-report-currency)))
- (my-income-account (env-create-root-account env ACCT-TYPE-INCOME
- (gnc-default-report-currency)))
- (date-0 (gnc:get-start-this-month))
- (date-1 (gnc:time64-next-day date-0))
- (date-2 (gnc:time64-next-day date-1)))
- (env-create-transaction env date-1 my-income-account my-asset-account -1/1)
- (env-create-transaction env date-1 my-expense-account my-liability-account -1/1)
- (env-create-transaction env date-2 my-income-account my-asset-account -5/1)
- (env-create-transaction env date-2 my-expense-account my-liability-account -5/1)
- (begin
- (set-option report gnc:pagename-display "Show table" #t)
- (set-option report gnc:pagename-general "Start Date" (cons 'absolute date-0))
- (set-option report gnc:pagename-general "End Date" (cons 'absolute date-2))
- (set-option report gnc:pagename-general "Step Size" 'DayDelta)
- (set-option report gnc:pagename-general "Price Source" 'pricedb-nearest)
- (set-option report gnc:pagename-general "Report's currency" (gnc-default-report-currency))
- (set-option report gnc:pagename-accounts "Accounts" (list my-asset-account my-liability-account))
+ (let* ((options (gnc:make-report-options uuid))
+ (env (create-test-env))
+ (my-asset-account (env-create-root-account env ACCT-TYPE-ASSET
+ (gnc-default-report-currency)))
+ (my-liability-account (env-create-root-account env ACCT-TYPE-LIABILITY
+ (gnc-default-report-currency)))
+ (my-expense-account (env-create-root-account env ACCT-TYPE-EXPENSE
+ (gnc-default-report-currency)))
+ (my-income-account (env-create-root-account env ACCT-TYPE-INCOME
+ (gnc-default-report-currency)))
+ (date-0 (gnc:get-start-this-month))
+ (date-1 (gnc:time64-next-day date-0))
+ (date-2 (gnc:time64-next-day date-1)))
+ (env-create-transaction env date-1 my-income-account my-asset-account -1/1)
+ (env-create-transaction env date-1 my-expense-account my-liability-account -1/1)
+ (env-create-transaction env date-2 my-income-account my-asset-account -5/1)
+ (env-create-transaction env date-2 my-expense-account my-liability-account -5/1)
+ (begin
+ (set-option options gnc:pagename-display "Show table" #t)
+ (set-option options gnc:pagename-general "Start Date" (cons 'absolute date-0))
+ (set-option options gnc:pagename-general "End Date" (cons 'absolute date-2))
+ (set-option options gnc:pagename-general "Step Size" 'DayDelta)
+ (set-option options gnc:pagename-general "Price Source" 'pricedb-nearest)
+ (set-option options gnc:pagename-general "Report's currency" (gnc-default-report-currency))
+ (set-option options gnc:pagename-accounts "Accounts" (list my-asset-account my-liability-account))
- (let ((doc (renderer report)))
- (gnc:html-document-set-style-sheet! doc
- (gnc:report-stylesheet report))
- (let* ((result (gnc:html-document-render doc #f))
- (tbl (stream->list
- (pattern-streamer "<tr>"
- (list (list "<td>([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
- 1 2 3)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
- result))))
- (or (and (every (lambda (row)
- (and (= (string->number (car (fourth row)))
- (+ (string->number (car (second row)))
- (string->number (car (third row)))))
- ;; txns added in pairs, so assets = liability
- (equal? (second row) (third row))))
- tbl)
- (= 0 (tbl-ref->number tbl 0 1))
- (= 1 (tbl-ref->number tbl 1 1))
- (= 6 (tbl-ref->number tbl 2 1))
- (= 3 (tbl-row-count tbl))
- (= 4 (tbl-column-count tbl)))
- (begin (format #t "two-txn test 2 ~a failed~%" uuid) #f))
- ))))))
+ (let ((sxml (gnc:options->sxml uuid options "test-standard-net-barchart"
+ "two-txn-test-2" #:strip-tag "script")))
+ (test-begin "two-txn-test")
+ (test-equal "asset $0.00"
+ '("$0.00")
+ (sxml->table-row-col sxml 1 1 2))
+ (test-equal "asset $1.00"
+ '("$1.00")
+ (sxml->table-row-col sxml 1 2 2))
+ (test-equal "asset $6.00"
+ '("$6.00")
+ (sxml->table-row-col sxml 1 3 2))
+ (test-equal "4 columns"
+ 4
+ (length (sxml->table-row-col sxml 1 1 #f)))
+ (test-equal "3 rows"
+ 3
+ (length (sxml->table-row-col sxml 1 #f 1)))
+ (test-end "two-txn-test")
+ sxml))))
(define (two-txn-test-income uuid)
- (let* ((template (gnc:find-report-template uuid))
- (options (gnc:make-report-options uuid))
- (report (constructor uuid "bar" options
- #t #t #f #f ""))
- (renderer (gnc:report-template-renderer template)))
- (let* ((env (create-test-env))
- (my-asset-account (env-create-root-account env ACCT-TYPE-ASSET
- (gnc-default-report-currency)))
- (my-liability-account (env-create-root-account env ACCT-TYPE-LIABILITY
- (gnc-default-report-currency)))
- (my-expense-account (env-create-root-account env ACCT-TYPE-EXPENSE
- (gnc-default-report-currency)))
- (my-income-account (env-create-root-account env ACCT-TYPE-INCOME
- (gnc-default-report-currency)))
- (date-0 (gnc:get-start-this-month))
- (date-1 (gnc:time64-next-day date-0))
- (date-2 (gnc:time64-next-day date-1)))
- (env-create-transaction env date-1 my-income-account my-asset-account -1/1)
- (env-create-transaction env date-1 my-expense-account my-liability-account -1/1)
- (env-create-transaction env date-2 my-income-account my-asset-account -5/1)
- (env-create-transaction env date-2 my-expense-account my-liability-account -5/1)
- (begin
- (set-option report gnc:pagename-display "Show table" #t)
- (set-option report gnc:pagename-general "Start Date" (cons 'absolute date-0))
- (set-option report gnc:pagename-general "End Date" (cons 'absolute date-2))
- (set-option report gnc:pagename-general "Step Size" 'DayDelta)
- (set-option report gnc:pagename-general "Price Source" 'pricedb-nearest)
- (set-option report gnc:pagename-general "Report's currency" (gnc-default-report-currency))
- (set-option report gnc:pagename-accounts "Accounts" (list my-income-account my-expense-account))
+ (let* ((options (gnc:make-report-options uuid))
+ (env (create-test-env))
+ (my-asset-account (env-create-root-account env ACCT-TYPE-ASSET
+ (gnc-default-report-currency)))
+ (my-liability-account (env-create-root-account env ACCT-TYPE-LIABILITY
+ (gnc-default-report-currency)))
+ (my-expense-account (env-create-root-account env ACCT-TYPE-EXPENSE
+ (gnc-default-report-currency)))
+ (my-income-account (env-create-root-account env ACCT-TYPE-INCOME
+ (gnc-default-report-currency)))
+ (date-0 (gnc:get-start-this-month))
+ (date-1 (gnc:time64-next-day date-0))
+ (date-2 (gnc:time64-next-day date-1)))
+ (env-create-transaction env date-1 my-income-account my-asset-account -1/1)
+ (env-create-transaction env date-1 my-expense-account my-liability-account -1/1)
+ (env-create-transaction env date-2 my-income-account my-asset-account -5/1)
+ (env-create-transaction env date-2 my-expense-account my-liability-account -5/1)
- (let ((doc (renderer report)))
- (gnc:html-document-set-style-sheet! doc
- (gnc:report-stylesheet report))
- (let* ((result (gnc:html-document-render doc #f))
- (tbl (stream->list
- (pattern-streamer "<tr>"
- (list (list "<td>([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
- 1 2 3)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
- result))))
- (or (and (every (lambda (row)
- (and (= (string->number (car (fourth row)))
- (+ (string->number (car (second row)))
- (string->number (car (third row)))))
- ;; txns added in pairs, so assets = liability
- (equal? (second row) (third row))))
- tbl)
- (= 0 (tbl-ref->number tbl 0 1))
- (= 1 (tbl-ref->number tbl 1 1))
- (= 5 (tbl-ref->number tbl 2 1))
- (= 3 (tbl-row-count tbl))
- (= 4 (tbl-column-count tbl)))
- (begin (format #t "two-txn-income test ~a failed~%" uuid) #f))
- ))))))
+ (set-option options gnc:pagename-display "Show table" #t)
+ (set-option options gnc:pagename-general "Start Date" (cons 'absolute date-0))
+ (set-option options gnc:pagename-general "End Date" (cons 'absolute date-2))
+ (set-option options gnc:pagename-general "Step Size" 'DayDelta)
+ (set-option options gnc:pagename-general "Price Source" 'pricedb-nearest)
+ (set-option options gnc:pagename-general "Report's currency" (gnc-default-report-currency))
+ (set-option options gnc:pagename-accounts "Accounts" (list my-income-account my-expense-account))
+ (let ((sxml (gnc:options->sxml uuid options "test-standard-net-barchart"
+ "two-txn-test-2" #:strip-tag "script")))
+ (test-begin "two-txn-test-2")
+ (test-equal "income $0.00"
+ '("$0.00")
+ (sxml->table-row-col sxml 1 1 2))
+ (test-equal "income $1.00"
+ '("$1.00")
+ (sxml->table-row-col sxml 1 2 2))
+ (test-equal "income $5.00"
+ '("$5.00")
+ (sxml->table-row-col sxml 1 3 2))
+ (test-equal "4 columns"
+ 4
+ (length (sxml->table-row-col sxml 1 1 #f)))
+ (test-equal "3 rows"
+ 3
+ (length (sxml->table-row-col sxml 1 #f 1)))
+ (test-end "two-txn-test-2")
+ sxml)))
-(define (closing-test uuid)
- (let* ((template (gnc:find-report-template uuid))
- (options (gnc:make-report-options uuid))
- (report (constructor uuid "bar" options
- #t #t #f #f ""))
- (renderer (gnc:report-template-renderer template)))
- (let* ((env (create-test-env))
- (my-asset-account (env-create-root-account env ACCT-TYPE-ASSET
- (gnc-default-report-currency)))
- (my-liability-account (env-create-root-account env ACCT-TYPE-LIABILITY
- (gnc-default-report-currency)))
- (my-expense-account (env-create-root-account env ACCT-TYPE-EXPENSE
- (gnc-default-report-currency)))
- (my-income-account (env-create-root-account env ACCT-TYPE-INCOME
- (gnc-default-report-currency)))
- (my-equity-account (env-create-root-account env ACCT-TYPE-EQUITY
- (gnc-default-report-currency)))
- (date-0 (gnc:get-start-this-month))
- (date-1 (gnc:time64-next-day date-0))
- (date-2 (gnc:time64-next-day date-1))
- (date-3 (gnc:time64-next-day date-2)))
- (env-create-transaction env date-1 my-income-account my-asset-account -1/1)
- (env-create-transaction env date-2 my-income-account my-asset-account -2/1)
- (env-create-transaction env date-3 my-income-account my-asset-account -3/1)
+(define (closing-test uuid)
+ (let* ((options (gnc:make-report-options uuid))
+ (env (create-test-env))
+ (my-asset-account (env-create-root-account env ACCT-TYPE-ASSET
+ (gnc-default-report-currency)))
+ (my-liability-account (env-create-root-account env ACCT-TYPE-LIABILITY
+ (gnc-default-report-currency)))
+ (my-expense-account (env-create-root-account env ACCT-TYPE-EXPENSE
+ (gnc-default-report-currency)))
+ (my-income-account (env-create-root-account env ACCT-TYPE-INCOME
+ (gnc-default-report-currency)))
+ (my-equity-account (env-create-root-account env ACCT-TYPE-EQUITY
+ (gnc-default-report-currency)))
+ (date-0 (gnc:get-start-this-month))
+ (date-1 (gnc:time64-next-day date-0))
+ (date-2 (gnc:time64-next-day date-1))
+ (date-3 (gnc:time64-next-day date-2)))
- (let ((closing-txn (env-create-transaction env date-2 my-asset-account my-equity-account
- 300/1)))
- (xaccTransSetIsClosingTxn closing-txn #t))
+ (env-create-transaction env date-1 my-income-account my-asset-account -1/1)
+ (env-create-transaction env date-2 my-income-account my-asset-account -2/1)
+ (env-create-transaction env date-3 my-income-account my-asset-account -3/1)
- (begin
- (set-option report gnc:pagename-display "Show table" #t)
- (set-option report gnc:pagename-general "Start Date" (cons 'absolute date-0))
- (set-option report gnc:pagename-general "End Date" (cons 'absolute date-3))
- (set-option report gnc:pagename-general "Step Size" 'DayDelta)
- (set-option report gnc:pagename-general "Price Source" 'pricedb-nearest)
- (set-option report gnc:pagename-general "Report's currency" (gnc-default-report-currency))
- (set-option report gnc:pagename-accounts "Accounts" (list my-income-account my-expense-account))
+ (let ((closing-txn (env-create-transaction env date-2 my-asset-account my-equity-account 300)))
+ (xaccTransSetIsClosingTxn closing-txn #t))
- (let ((doc (renderer report)))
- (gnc:html-document-set-style-sheet! doc
- (gnc:report-stylesheet report))
- (let* ((result (gnc:html-document-render doc #f))
- (tbl (stream->list
- (pattern-streamer "<tr>"
- (list (list "<td>([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
- 1 2 3)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
- result))))
- (or (and (every (lambda (row)
- (and (= (string->number (car (fourth row)))
- (+ (string->number (car (second row)))
- (string->number (car (third row)))))))
- tbl)
- (= 0 (tbl-ref->number tbl 0 1))
- (= 1 (tbl-ref->number tbl 1 1))
- (= 2 (tbl-ref->number tbl 2 1))
- (= 3 (tbl-ref->number tbl 3 1))
- (= 4 (tbl-row-count tbl))
- (= 4 (tbl-column-count tbl)))
- (begin (format #t "Closing-txn test ~a failed~%" uuid) #f))
- ))))))
+ (set-option options gnc:pagename-display "Show table" #t)
+ (set-option options gnc:pagename-general "Start Date" (cons 'absolute date-0))
+ (set-option options gnc:pagename-general "End Date" (cons 'absolute date-3))
+ (set-option options gnc:pagename-general "Step Size" 'DayDelta)
+ (set-option options gnc:pagename-general "Price Source" 'pricedb-nearest)
+ (set-option options gnc:pagename-general "Report's currency" (gnc-default-report-currency))
+ (set-option options gnc:pagename-accounts "Accounts" (list my-income-account my-expense-account))
+ (let ((sxml (gnc:options->sxml uuid options "test-standard-net-barchart"
+ "closing-test" #:strip-tag "script")))
+ (test-begin "closing-test")
+ (test-equal "income $0.00"
+ '("$0.00")
+ (sxml->table-row-col sxml 1 1 2))
+ (test-equal "income $1.00"
+ '("$1.00")
+ (sxml->table-row-col sxml 1 2 2))
+ (test-equal "income $2.00"
+ '("$2.00")
+ (sxml->table-row-col sxml 1 3 2))
+ (test-equal "income $3.00"
+ '("$3.00")
+ (sxml->table-row-col sxml 1 4 2))
+ (test-equal "4 columns"
+ 4
+ (length (sxml->table-row-col sxml 1 1 #f)))
+ (test-equal "4 rows"
+ 4
+ (length (sxml->table-row-col sxml 1 #f 1)))
+ (test-end "closing-test")
+ sxml)))
commit 62d8a65b9951cffa7460952b942d3e0b86a96915
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Dec 26 23:35:50 2018 +0800
[test-standard-net-linechart] upgrade to srfi-64 and sxml
diff --git a/gnucash/report/standard-reports/test/CMakeLists.txt b/gnucash/report/standard-reports/test/CMakeLists.txt
index 82c1593..a764470 100644
--- a/gnucash/report/standard-reports/test/CMakeLists.txt
+++ b/gnucash/report/standard-reports/test/CMakeLists.txt
@@ -2,11 +2,11 @@ set(scm_test_standard_reports_SOURCES
test-cash-flow.scm
test-cashflow-barchart.scm
test-standard-net-barchart.scm
- test-standard-net-linechart.scm
)
set(scm_test_with_srfi64_SOURCES
test-standard-category-report.scm
+ test-standard-net-linechart.scm
test-charts.scm
test-transaction.scm
test-balsheet-pnl.scm
diff --git a/gnucash/report/standard-reports/test/test-standard-net-linechart.scm b/gnucash/report/standard-reports/test/test-standard-net-linechart.scm
index 9adab00..4d56e2f 100644
--- a/gnucash/report/standard-reports/test/test-standard-net-linechart.scm
+++ b/gnucash/report/standard-reports/test/test-standard-net-linechart.scm
@@ -17,17 +17,15 @@
;; Boston, MA 02110-1301, USA gnu at gnu.org
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(debug-set! stack 50000)
-
(use-modules (gnucash gnc-module))
(gnc:module-begin-syntax (gnc:module-load "gnucash/report/report-system" 0))
(use-modules (gnucash engine))
(use-modules (sw_engine))
-(use-modules (ice-9 format))
-(use-modules (ice-9 streams))
(use-modules (srfi srfi-1))
+(use-modules (srfi srfi-64))
(use-modules (gnucash report stylesheets))
(use-modules (gnucash engine test test-extras))
+(use-modules (gnucash engine test srfi64-extras))
(use-modules (gnucash report report-system test test-extras))
(use-modules (gnucash report standard-reports net-charts))
@@ -35,196 +33,162 @@
(setlocale LC_ALL "C")
(define (run-test)
+ (test-runner-factory gnc:test-runner)
(run-net-asset-test net-worth-linechart-uuid))
-(define (set-option report page tag value)
- ((gnc:option-setter (gnc:lookup-option (gnc:report-options report)
- page tag)) value))
-
-
-(define constructor (record-constructor <report>))
+(define (set-option options page tag value)
+ ((gnc:option-setter (gnc:lookup-option options page tag)) value))
(define (run-net-asset-test asset-report-uuid)
- (and (two-txn-test asset-report-uuid)
- (two-txn-test-2 asset-report-uuid)
-
- (null-test asset-report-uuid)
- (single-txn-test asset-report-uuid)))
+ (null-test asset-report-uuid)
+ (single-txn-test asset-report-uuid)
+ (two-txn-test asset-report-uuid)
+ (two-txn-test-2 asset-report-uuid))
;; Just prove that the report exists.
(define (null-test uuid)
- (let* ((template (gnc:find-report-template uuid))
- (options (gnc:make-report-options uuid))
- (report (constructor uuid "bar" options
- #t #t #f #f ""))
- (renderer (gnc:report-template-renderer template)))
-
- (let ((doc (renderer report)))
- (gnc:html-document-set-style-sheet! doc
- (gnc:report-stylesheet report))
- ;;(format #t "render: ~a\n" (gnc:html-document-render doc #f))
- #t
- )))
+ (let ((options (gnc:make-report-options uuid)))
+ (gnc:options->render uuid options "test-standard-net-linechart" "null-test")))
(define (single-txn-test uuid)
- (let* ((template (gnc:find-report-template uuid))
- (options (gnc:make-report-options uuid))
- (report (constructor uuid "bar" options
- #t #t #f #f ""))
- (renderer (gnc:report-template-renderer template)))
- (let* ((env (create-test-env))
- (my-asset-account (env-create-root-account env ACCT-TYPE-ASSET
- (gnc-default-report-currency)))
- (my-expense-account (env-create-root-account env ACCT-TYPE-EXPENSE
- (gnc-default-report-currency)))
- (my-income-account (env-create-root-account env ACCT-TYPE-INCOME
- (gnc-default-report-currency))))
- (env-create-transaction env
- (gnc:get-start-this-month)
- my-income-account
- my-asset-account
- -1/1)
- (begin
- (set-option report gnc:pagename-display "Show table" #t)
- (set-option report gnc:pagename-general "Start Date"
- (cons 'absolute (gnc:get-start-this-month)))
- (set-option report gnc:pagename-general "End Date"
- (cons 'absolute (gnc:get-start-this-month)))
- (set-option report gnc:pagename-general "Step Size" 'DayDelta)
- (set-option report gnc:pagename-general "Price Source" 'pricedb-nearest)
- (set-option report gnc:pagename-general "Report's currency" (gnc-default-report-currency))
- (set-option report gnc:pagename-accounts "Accounts" (list my-asset-account))
-
- (let ((doc (renderer report)))
- (gnc:html-document-set-style-sheet! doc
- (gnc:report-stylesheet report))
- (let* ((result (gnc:html-document-render doc #f))
- (tbl (stream->list
- (pattern-streamer "<tr>"
- (list (list "<td>([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
- 1 2 3)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
- result))))
- (and (= 1 (tbl-ref->number tbl 0 1))
- (= 0 (tbl-ref->number tbl 0 2))
- (= 1 (tbl-ref->number tbl 0 3))
- (= 1 (tbl-row-count tbl))
- (= 4 (tbl-column-count tbl)))))))))
+ (let* ((options (gnc:make-report-options uuid))
+ (env (create-test-env))
+ (my-asset-account (env-create-root-account env ACCT-TYPE-ASSET
+ (gnc-default-report-currency)))
+ (my-expense-account (env-create-root-account env ACCT-TYPE-EXPENSE
+ (gnc-default-report-currency)))
+ (my-income-account (env-create-root-account env ACCT-TYPE-INCOME
+ (gnc-default-report-currency))))
+ (env-create-transaction env
+ (gnc:get-start-this-month)
+ my-income-account
+ my-asset-account
+ -1/1)
+ (set-option options gnc:pagename-display "Show table" #t)
+ (set-option options gnc:pagename-general "Start Date"
+ (cons 'absolute (gnc:get-start-this-month)))
+ (set-option options gnc:pagename-general "End Date"
+ (cons 'absolute (gnc:get-start-this-month)))
+ (set-option options gnc:pagename-general "Step Size" 'DayDelta)
+ (set-option options gnc:pagename-general "Price Source" 'pricedb-nearest)
+ (set-option options gnc:pagename-general "Report's currency" (gnc-default-report-currency))
+ (set-option options gnc:pagename-accounts "Accounts" (list my-asset-account))
+
+ (let ((sxml (gnc:options->sxml uuid options "test-standard-net-linechart"
+ "single-txn-test" #:strip-tag "script")))
+ (test-begin "single-txn-test")
+ (test-equal "assets $1.00"
+ '("$1.00")
+ (sxml->table-row-col sxml 1 1 2))
+ (test-equal "liability $0.00"
+ '("$0.00")
+ (sxml->table-row-col sxml 1 1 3))
+ (test-equal "net $0.00"
+ '("$1.00")
+ (sxml->table-row-col sxml 1 1 4))
+ (test-equal "4 columns"
+ 4
+ (length (sxml->table-row-col sxml 1 1 #f)))
+ (test-end "single-txn-test"))))
(define (two-txn-test uuid)
- (let* ((template (gnc:find-report-template uuid))
- (options (gnc:make-report-options uuid))
- (report (constructor uuid "bar" options
- #t #t #f #f ""))
- (renderer (gnc:report-template-renderer template)))
- (let* ((env (create-test-env))
- (my-asset-account (env-create-root-account env ACCT-TYPE-ASSET
- (gnc-default-report-currency)))
- (my-expense-account (env-create-root-account env ACCT-TYPE-EXPENSE
- (gnc-default-report-currency)))
- (my-income-account (env-create-root-account env ACCT-TYPE-INCOME
- (gnc-default-report-currency)))
- (date-0 (gnc:get-start-this-month))
- (date-1 (gnc:time64-next-day date-0))
- (date-2 (gnc:time64-next-day date-1)))
- (env-create-transaction env
- date-1
- my-income-account
- my-asset-account
- -1/1)
- (env-create-transaction env
- date-2
- my-income-account
- my-asset-account
- -5/1)
- (begin
- (set-option report gnc:pagename-display "Show table" #t)
- (set-option report gnc:pagename-general "Start Date" (cons 'absolute date-0))
- (set-option report gnc:pagename-general "End Date" (cons 'absolute date-2))
- (set-option report gnc:pagename-general "Step Size" 'DayDelta)
- (set-option report gnc:pagename-general "Price Source" 'pricedb-nearest)
- (set-option report gnc:pagename-general "Report's currency" (gnc-default-report-currency))
- (set-option report gnc:pagename-accounts "Accounts" (list my-asset-account))
-
- (let ((doc (renderer report)))
- (gnc:html-document-set-style-sheet! doc
- (gnc:report-stylesheet report))
- (let* ((result (gnc:html-document-render doc #f))
- (tbl (stream->list
- (pattern-streamer "<tr>"
- (list (list "<td>([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
- 1 2 3)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
- result))))
- (and (every (lambda (row)
- (and (equal? (second row) (fourth row))
- (= 0 (string->number (car (third row))))))
- tbl)
- (= 0 (tbl-ref->number tbl 0 1))
- (= 1 (tbl-ref->number tbl 1 1))
- (= 6 (tbl-ref->number tbl 2 1))
- (= 3 (tbl-row-count tbl))
- (= 4 (tbl-column-count tbl)))))))))
+ (let* ((options (gnc:make-report-options uuid))
+ (env (create-test-env))
+ (my-asset-account (env-create-root-account env ACCT-TYPE-ASSET
+ (gnc-default-report-currency)))
+ (my-expense-account (env-create-root-account env ACCT-TYPE-EXPENSE
+ (gnc-default-report-currency)))
+ (my-income-account (env-create-root-account env ACCT-TYPE-INCOME
+ (gnc-default-report-currency)))
+ (date-0 (gnc:get-start-this-month))
+ (date-1 (gnc:time64-next-day date-0))
+ (date-2 (gnc:time64-next-day date-1)))
+ (env-create-transaction env
+ date-1
+ my-income-account
+ my-asset-account
+ -1/1)
+ (env-create-transaction env
+ date-2
+ my-income-account
+ my-asset-account
+ -5/1)
+
+ (set-option options gnc:pagename-display "Show table" #t)
+ (set-option options gnc:pagename-general "Start Date" (cons 'absolute date-0))
+ (set-option options gnc:pagename-general "End Date" (cons 'absolute date-2))
+ (set-option options gnc:pagename-general "Step Size" 'DayDelta)
+ (set-option options gnc:pagename-general "Price Source" 'pricedb-nearest)
+ (set-option options gnc:pagename-general "Report's currency" (gnc-default-report-currency))
+ (set-option options gnc:pagename-accounts "Accounts" (list my-asset-account))
+
+ (let ((sxml (gnc:options->sxml uuid options "test-standard-net-linechart"
+ "two-txn-test" #:strip-tag "script")))
+ (test-begin "two-txn-test")
+ (test-equal "asset $0.00"
+ '("$0.00")
+ (sxml->table-row-col sxml 1 1 2))
+ (test-equal "asset $1.00"
+ '("$1.00")
+ (sxml->table-row-col sxml 1 2 2))
+ (test-equal "asset $6.00"
+ '("$6.00")
+ (sxml->table-row-col sxml 1 3 2))
+ (test-equal "4 columns"
+ 4
+ (length (sxml->table-row-col sxml 1 1 #f)))
+ (test-equal "3 rows"
+ 3
+ (length (sxml->table-row-col sxml 1 #f 1)))
+ (test-end "two-txn-test")
+ sxml)))
(define (two-txn-test-2 uuid)
- (let* ((template (gnc:find-report-template uuid))
- (options (gnc:make-report-options uuid))
- (report (constructor uuid "bar" options
- #t #t #f #f ""))
- (renderer (gnc:report-template-renderer template)))
- (let* ((env (create-test-env))
- (my-asset-account (env-create-root-account env ACCT-TYPE-ASSET
- (gnc-default-report-currency)))
- (my-liability-account (env-create-root-account env ACCT-TYPE-LIABILITY
- (gnc-default-report-currency)))
- (my-expense-account (env-create-root-account env ACCT-TYPE-EXPENSE
- (gnc-default-report-currency)))
- (my-income-account (env-create-root-account env ACCT-TYPE-INCOME
- (gnc-default-report-currency)))
- (date-0 (gnc:get-start-this-month))
- (date-1 (gnc:time64-next-day date-0))
- (date-2 (gnc:time64-next-day date-1)))
- (env-create-transaction env date-1 my-income-account my-asset-account -1/1)
- (env-create-transaction env date-1 my-expense-account my-liability-account -1/1)
- (env-create-transaction env date-2 my-income-account my-asset-account -5/1)
- (env-create-transaction env date-2 my-expense-account my-liability-account -5/1)
- (begin
- (set-option report gnc:pagename-display "Show table" #t)
- (set-option report gnc:pagename-general "Start Date" (cons 'absolute date-0))
- (set-option report gnc:pagename-general "End Date" (cons 'absolute date-2))
- (set-option report gnc:pagename-general "Step Size" 'DayDelta)
- (set-option report gnc:pagename-general "Price Source" 'pricedb-nearest)
- (set-option report gnc:pagename-general "Report's currency" (gnc-default-report-currency))
- (set-option report gnc:pagename-accounts "Accounts" (list my-asset-account my-liability-account))
-
- (let ((doc (renderer report)))
- (gnc:html-document-set-style-sheet! doc
- (gnc:report-stylesheet report))
- (let* ((result (gnc:html-document-render doc #f))
- (tbl (stream->list
- (pattern-streamer "<tr>"
- (list (list "<td>([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
- 1 2 3)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
- result))))
- (and (every (lambda (row)
- (and (= (string->number (car (fourth row)))
- (+ (string->number (car (second row)))
- (string->number (car (third row)))))
- ;; txns added in pairs, so assets = liability
- (equal? (second row) (third row))))
- tbl)
- (= 0 (tbl-ref->number tbl 0 1))
- (= 1 (tbl-ref->number tbl 1 1))
- (= 6 (tbl-ref->number tbl 2 1))
- (= 3 (tbl-row-count tbl))
- (= 4 (tbl-column-count tbl)))))))))
+ (let* ((options (gnc:make-report-options uuid))
+ (env (create-test-env))
+ (my-asset-account (env-create-root-account env ACCT-TYPE-ASSET
+ (gnc-default-report-currency)))
+ (my-liability-account (env-create-root-account env ACCT-TYPE-LIABILITY
+ (gnc-default-report-currency)))
+ (my-expense-account (env-create-root-account env ACCT-TYPE-EXPENSE
+ (gnc-default-report-currency)))
+ (my-income-account (env-create-root-account env ACCT-TYPE-INCOME
+ (gnc-default-report-currency)))
+ (date-0 (gnc:get-start-this-month))
+ (date-1 (gnc:time64-next-day date-0))
+ (date-2 (gnc:time64-next-day date-1)))
+ (env-create-transaction env date-1 my-income-account my-asset-account -1/1)
+ (env-create-transaction env date-1 my-expense-account my-liability-account -1/1)
+ (env-create-transaction env date-2 my-income-account my-asset-account -5/1)
+ (env-create-transaction env date-2 my-expense-account my-liability-account -5/1)
+
+ (set-option options gnc:pagename-display "Show table" #t)
+ (set-option options gnc:pagename-general "Start Date" (cons 'absolute date-0))
+ (set-option options gnc:pagename-general "End Date" (cons 'absolute date-2))
+ (set-option options gnc:pagename-general "Step Size" 'DayDelta)
+ (set-option options gnc:pagename-general "Price Source" 'pricedb-nearest)
+ (set-option options gnc:pagename-general "Report's currency" (gnc-default-report-currency))
+ (set-option options gnc:pagename-accounts "Accounts" (list my-asset-account my-liability-account))
+
+ (let ((sxml (gnc:options->sxml uuid options "test-standard-net-linechart"
+ "two-txn-test-2" #:strip-tag "script")))
+ (test-begin "two-txn-test-2")
+ (test-equal "asset $0.00"
+ '("$0.00")
+ (sxml->table-row-col sxml 1 1 2))
+ (test-equal "asset $1.00"
+ '("$1.00")
+ (sxml->table-row-col sxml 1 2 2))
+ (test-equal "asset $6.00"
+ '("$6.00")
+ (sxml->table-row-col sxml 1 3 2))
+ (test-equal "4 columns"
+ 4
+ (length (sxml->table-row-col sxml 1 1 #f)))
+ (test-equal "3 rows"
+ 3
+ (length (sxml->table-row-col sxml 1 #f 1)))
+ (test-end "two-txn-test-2"))))
commit c3253f9189bbf1ca53c578123921be2b02afbd4a
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Dec 26 22:47:26 2018 +0800
[test-standard-category-report] upgrade to srfi-64 and sxml
diff --git a/gnucash/report/standard-reports/test/CMakeLists.txt b/gnucash/report/standard-reports/test/CMakeLists.txt
index 651a06b..82c1593 100644
--- a/gnucash/report/standard-reports/test/CMakeLists.txt
+++ b/gnucash/report/standard-reports/test/CMakeLists.txt
@@ -1,12 +1,12 @@
set(scm_test_standard_reports_SOURCES
test-cash-flow.scm
test-cashflow-barchart.scm
- test-standard-category-report.scm
test-standard-net-barchart.scm
test-standard-net-linechart.scm
)
set(scm_test_with_srfi64_SOURCES
+ test-standard-category-report.scm
test-charts.scm
test-transaction.scm
test-balsheet-pnl.scm
diff --git a/gnucash/report/standard-reports/test/test-standard-category-report.scm b/gnucash/report/standard-reports/test/test-standard-category-report.scm
index ace0e9b..fc2e63e 100644
--- a/gnucash/report/standard-reports/test/test-standard-category-report.scm
+++ b/gnucash/report/standard-reports/test/test-standard-category-report.scm
@@ -17,11 +17,11 @@
;; Boston, MA 02110-1301, USA gnu at gnu.org
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(debug-set! stack 50000)
-(use-modules (ice-9 format))
-(use-modules (ice-9 streams))
(use-modules (srfi srfi-1))
+(use-modules (srfi srfi-14))
+(use-modules (srfi srfi-64))
(use-modules (gnucash gnc-module))
+(use-modules (gnucash engine test srfi64-extras))
;; Guile 2 needs to load external modules at compile time
;; otherwise the N_ syntax-rule won't be found at compile time
@@ -38,109 +38,82 @@
(use-modules (gnucash report standard-reports net-charts))
(use-modules (gnucash report report-system test test-extras))
(use-modules (gnucash report standard-reports category-barchart))
-(use-modules (ice-9 format))
-(use-modules (ice-9 streams))
-(use-modules (srfi srfi-1))
(use-modules (gnucash report stylesheets))
-(use-modules (gnucash report report-system collectors))
(use-modules (gnucash engine test test-extras))
(use-modules (gnucash report report-system test test-extras))
-
;; Explicitly set locale to make the report output predictable
(setlocale LC_ALL "C")
(define (run-test)
+ (test-runner-factory gnc:test-runner)
(run-category-income-expense-test category-barchart-income-uuid category-barchart-expense-uuid)
(run-category-asset-liability-test category-barchart-asset-uuid category-barchart-liability-uuid))
(export run-category-income-expense-test)
(export run-category-asset-liability-test)
-(define (set-option report page tag value)
- ((gnc:option-setter (gnc:lookup-option (gnc:report-options report)
- page tag)) value))
-
-
-(define constructor (record-constructor <report>))
+(define (set-option options page tag value)
+ ((gnc:option-setter (gnc:lookup-option options page tag)) value))
-;(set-option income-report gnc:pagename-general "Start Date" (cons 'relative 'start-prev-year))
-;(set-option income-report gnc:pagename-general "End Date" (cons 'relative 'end-this-month))
-;(set-option income-report gnc:pagename-general "Show table" #t)
-;(set-option income-report gnc:pagename-general "Price Source" 'pricedb-nearest)
-;(set-option income-report gnc:pagename-general "Report's currency" (gnc-default-report-currency))
+(define (str->num str)
+ (string->number
+ (string-filter
+ (lambda (c)
+ (or (char-numeric? c)
+ (memv c '(#\- #\.))))
+ str)))
(define (run-category-income-expense-test income-report-uuid expense-report-uuid)
- (and (null-test income-report-uuid)
- (null-test expense-report-uuid)
- (single-txn-test income-report-uuid)
- (multi-acct-test expense-report-uuid)
- #t))
+ (null-test income-report-uuid)
+ (null-test expense-report-uuid)
+ (single-txn-test income-report-uuid)
+ (multi-acct-test expense-report-uuid))
(define (run-category-asset-liability-test asset-report-uuid liability-report-uuid)
- (and (null-test asset-report-uuid)
- (null-test liability-report-uuid)
- (asset-test asset-report-uuid)
- (liability-test liability-report-uuid)
- #t))
+ (null-test asset-report-uuid)
+ (null-test liability-report-uuid)
+ (asset-test asset-report-uuid)
+ (liability-test liability-report-uuid))
;; No real test here, just confirm that no exceptions are thrown
(define (null-test uuid)
- (let* ((template (gnc:find-report-template uuid))
- (options (gnc:make-report-options uuid))
- (report (constructor uuid "bar" options
- #t #t #f #f ""))
- (renderer (gnc:report-template-renderer template)))
-
- (let ((doc (renderer report)))
- (gnc:html-document-set-style-sheet! doc
- (gnc:report-stylesheet report))
- #t
- )))
-
+ (let ((options (gnc:make-report-options uuid)))
+ (gnc:options->render uuid options "test-standard-category-report" "null-test")))
(define (single-txn-test uuid)
- (let* ((income-template (gnc:find-report-template uuid))
- (income-options (gnc:make-report-options uuid))
- (income-report (constructor uuid "bar" income-options
- #t #t #f #f ""))
- (income-renderer (gnc:report-template-renderer income-template)))
- (let* ((env (create-test-env))
- (my-asset-account (env-create-root-account env ACCT-TYPE-ASSET
- (gnc-default-report-currency)))
- (my-expense-account (env-create-root-account env ACCT-TYPE-EXPENSE
- (gnc-default-report-currency)))
- (my-income-account (env-create-root-account env ACCT-TYPE-INCOME
- (gnc-default-report-currency))))
- (env-create-daily-transactions env
- (gnc:get-start-this-month)
- (gnc:get-end-this-month)
- my-asset-account my-income-account)
- (begin
- (set-option income-report gnc:pagename-display "Show table" #t)
- (set-option income-report gnc:pagename-general "Start Date" (cons 'relative 'start-this-month))
- (set-option income-report gnc:pagename-general "End Date" (cons 'relative 'end-this-month))
- (set-option income-report gnc:pagename-general "Step Size" 'DayDelta)
- (set-option income-report gnc:pagename-general "Price Source" 'pricedb-nearest)
- (set-option income-report gnc:pagename-general "Report's currency" (gnc-default-report-currency))
- (set-option income-report gnc:pagename-accounts "Accounts" (list my-income-account))
- (set-option income-report gnc:pagename-accounts "Show Accounts until level" 'all)
-
- (let ((doc (income-renderer income-report)))
- (gnc:html-document-set-style-sheet! doc
- (gnc:report-stylesheet income-report))
- (let* ((result (gnc:html-document-render doc #f))
- (tbl (stream->list
- (pattern-streamer "<tr>"
- (list (list "<td>([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>" 1 2 3)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
- result))))
- (every (lambda (date value-list)
- (let ((day (second date))
- (value (first value-list)))
- (= (string->number day) (string->number value))))
- (map first tbl)
- (map second tbl))))))))
+ (let* ((income-options (gnc:make-report-options uuid))
+ (env (create-test-env))
+ (my-asset-account (env-create-root-account env ACCT-TYPE-ASSET
+ (gnc-default-report-currency)))
+ (my-expense-account (env-create-root-account env ACCT-TYPE-EXPENSE
+ (gnc-default-report-currency)))
+ (my-income-account (env-create-root-account env ACCT-TYPE-INCOME
+ (gnc-default-report-currency))))
+ (env-create-daily-transactions env
+ (gnc:get-start-this-month)
+ (gnc:get-end-this-month)
+ my-asset-account my-income-account)
+ (set-option income-options gnc:pagename-display "Show table" #t)
+ (set-option income-options gnc:pagename-general "Start Date" (cons 'relative 'start-this-month))
+ (set-option income-options gnc:pagename-general "End Date" (cons 'relative 'end-this-month))
+ (set-option income-options gnc:pagename-general "Step Size" 'DayDelta)
+ (set-option income-options gnc:pagename-general "Price Source" 'pricedb-nearest)
+ (set-option income-options gnc:pagename-general "Report's currency" (gnc-default-report-currency))
+ (set-option income-options gnc:pagename-accounts "Accounts" (list my-income-account))
+ (set-option income-options gnc:pagename-accounts "Show Accounts until level" 'all)
+
+ (let ((sxml (gnc:options->sxml uuid income-options "test-standard-category-report"
+ "single-txn-test" #:strip-tag "script")))
+ (test-begin "single-txn-test")
+ (test-assert "day=value"
+ (every =
+ (map
+ (lambda (s)
+ (str->num (cadr (string-split s #\/))))
+ (sxml->table-row-col sxml 1 #f 1))
+ (map str->num (sxml->table-row-col sxml 1 #f 2))))
+ (test-end "single-txn-test"))))
(define (list-leaves list)
(if (not (pair? list))
@@ -152,158 +125,124 @@
list)))
(define (multi-acct-test expense-report-uuid)
- (let* ((expense-template (gnc:find-report-template expense-report-uuid))
- (expense-options (gnc:make-report-options expense-report-uuid))
- (expense-report (constructor expense-report-uuid "bar" expense-options
- #t #t #f #f ""))
- (expense-renderer (gnc:report-template-renderer expense-template)))
- (let* ((env (create-test-env))
- (expense-accounts (env-expense-account-structure env))
- (asset-accounts (env-create-account-structure
- env
- (list "Assets"
- (list (cons 'type ACCT-TYPE-ASSET))
- (list "Bank"))))
- (leaf-expense-accounts (list-leaves expense-accounts))
- (bank-account (car (car (cdr asset-accounts)))))
- (for-each (lambda (expense-account)
- (env-create-daily-transactions env
- (gnc:get-start-this-month)
- (gnc:get-end-this-month)
- expense-account
- bank-account))
- leaf-expense-accounts)
- (begin
- (set-option expense-report gnc:pagename-display "Show table" #t)
- (set-option expense-report gnc:pagename-general "Start Date" (cons 'relative 'start-this-month))
- (set-option expense-report gnc:pagename-general "End Date" (cons 'relative 'end-this-month))
- (set-option expense-report gnc:pagename-general "Step Size" 'DayDelta)
- (set-option expense-report gnc:pagename-general "Price Source" 'pricedb-nearest)
- (set-option expense-report gnc:pagename-general "Report's currency" (gnc-default-report-currency))
- (set-option expense-report gnc:pagename-accounts "Accounts" leaf-expense-accounts)
- (set-option expense-report gnc:pagename-accounts "Show Accounts until level" 2)
+ (let* ((expense-options (gnc:make-report-options expense-report-uuid))
+ (env (create-test-env))
+ (expense-accounts (env-expense-account-structure env))
+ (asset-accounts (env-create-account-structure
+ env
+ (list "Assets"
+ (list (cons 'type ACCT-TYPE-ASSET))
+ (list "Bank"))))
+ (leaf-expense-accounts (list-leaves expense-accounts))
+ (bank-account (car (car (cdr asset-accounts)))))
+ (for-each (lambda (expense-account)
+ (env-create-daily-transactions env
+ (gnc:get-start-this-month)
+ (gnc:get-end-this-month)
+ expense-account
+ bank-account))
+ leaf-expense-accounts)
+ (set-option expense-options gnc:pagename-display "Show table" #t)
+ (set-option expense-options gnc:pagename-general "Start Date" (cons 'relative 'start-this-month))
+ (set-option expense-options gnc:pagename-general "End Date" (cons 'relative 'end-this-month))
+ (set-option expense-options gnc:pagename-general "Step Size" 'DayDelta)
+ (set-option expense-options gnc:pagename-general "Price Source" 'pricedb-nearest)
+ (set-option expense-options gnc:pagename-general "Report's currency" (gnc-default-report-currency))
+ (set-option expense-options gnc:pagename-accounts "Accounts" leaf-expense-accounts)
+ (set-option expense-options gnc:pagename-accounts "Show Accounts until level" 2)
+ (let ((sxml (gnc:options->sxml expense-report-uuid expense-options "test-standard-category-report"
+ "multi--test" #:strip-tag "script")))
+ (test-begin "multi-acct-test")
+ (test-equal "6 columns"
+ 6
+ (length (sxml->table-row-col sxml 1 0 #f)))
+ (test-equal "date"
+ '("Date")
+ (sxml->table-row-col sxml 1 0 1))
+ (test-equal "auto"
+ '("Auto")
+ (sxml->table-row-col sxml 1 0 2))
+ (test-end "multi-acct-test"))))
- (let ((doc (expense-renderer expense-report)))
- (gnc:html-document-set-style-sheet! doc
- (gnc:report-stylesheet expense-report))
- (let* ((html-document (gnc:html-document-render doc #f))
- (columns (columns-from-report-document html-document))
- (tbl (stream->list
- (pattern-streamer "<tr>"
- (list (list "<td>([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>" 1 2 3)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
- html-document))))
- ;(format #t "~a" html-document)
- (and (= 6 (length columns))
- (equal? "Date" (first columns))
- (equal? "Auto" (second columns))
- ;; maybe should try to check actual values
- )))))))
-
-(define (columns-from-report-document doc)
- (let ((columns (stream->list (pattern-streamer "<th>"
- (list (list "<th>([^<]*)</" 1))
- doc))))
- (map caar columns)))
-
-;;
-;;
-;;
(define (asset-test uuid)
- (let* ((asset-template (gnc:find-report-template uuid))
- (asset-options (gnc:make-report-options uuid))
- (asset-report (constructor uuid "bar" asset-options
- #t #t #f #f ""))
- (asset-renderer (gnc:report-template-renderer asset-template)))
- (let* ((env (create-test-env))
- (my-asset-account (env-create-root-account env ACCT-TYPE-ASSET
- (gnc-default-report-currency)))
- (my-expense-account (env-create-root-account env ACCT-TYPE-EXPENSE
- (gnc-default-report-currency)))
- (my-income-account (env-create-root-account env ACCT-TYPE-INCOME
- (gnc-default-report-currency))))
- (env-create-daily-transactions env
- (gnc:get-start-this-month)
- (gnc:get-end-this-month)
- my-asset-account my-income-account)
- (begin
- (set-option asset-report gnc:pagename-display "Show table" #t)
- (set-option asset-report gnc:pagename-general "Start Date" (cons 'relative 'start-this-month))
- (set-option asset-report gnc:pagename-general "End Date" (cons 'relative 'end-this-month))
- (set-option asset-report gnc:pagename-general "Step Size" 'DayDelta)
- (set-option asset-report gnc:pagename-general "Price Source" 'pricedb-nearest)
- (set-option asset-report gnc:pagename-general "Price Source" 'pricedb-nearest)
- (set-option asset-report gnc:pagename-general "Report's currency" (gnc-default-report-currency))
- (set-option asset-report gnc:pagename-accounts "Accounts" (list my-asset-account))
- (set-option asset-report gnc:pagename-accounts "Show Accounts until level" 'all)
-
- (let ((doc (asset-renderer asset-report)))
- (gnc:html-document-set-style-sheet! doc
- (gnc:report-stylesheet asset-report))
- (let* ((html-document (gnc:html-document-render doc #f))
- (columns (columns-from-report-document html-document))
- (tbl (stream->list
- (pattern-streamer "<tr>"
- (list (list "<td>([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>" 1 2 3)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
- html-document)))
- (row-count (tbl-row-count tbl)))
- (and (member "account-1" columns)
- (= 2 (length columns))
- (= 1 (string->number (car (tbl-ref tbl 0 1))))
- (= (/ (* row-count (+ row-count 1)) 2)
- (string->number (car (tbl-ref tbl (- row-count 1) 1))))
- #t)))))))
+ (let* ((asset-options (gnc:make-report-options uuid))
+ (env (create-test-env))
+ (my-asset-account (env-create-root-account env ACCT-TYPE-ASSET
+ (gnc-default-report-currency)))
+ (my-expense-account (env-create-root-account env ACCT-TYPE-EXPENSE
+ (gnc-default-report-currency)))
+ (my-income-account (env-create-root-account env ACCT-TYPE-INCOME
+ (gnc-default-report-currency))))
+ (env-create-daily-transactions env
+ (gnc:get-start-this-month)
+ (gnc:get-end-this-month)
+ my-asset-account my-income-account)
+ (set-option asset-options gnc:pagename-display "Show table" #t)
+ (set-option asset-options gnc:pagename-general "Start Date" (cons 'relative 'start-this-month))
+ (set-option asset-options gnc:pagename-general "End Date" (cons 'relative 'end-this-month))
+ (set-option asset-options gnc:pagename-general "Step Size" 'DayDelta)
+ (set-option asset-options gnc:pagename-general "Price Source" 'pricedb-nearest)
+ (set-option asset-options gnc:pagename-general "Price Source" 'pricedb-nearest)
+ (set-option asset-options gnc:pagename-general "Report's currency" (gnc-default-report-currency))
+ (set-option asset-options gnc:pagename-accounts "Accounts" (list my-asset-account))
+ (set-option asset-options gnc:pagename-accounts "Show Accounts until level" 'all)
+ (let ((sxml (gnc:options->sxml uuid asset-options "test-standard-category-report"
+ "asset-test" #:strip-tag "script")))
+ (test-begin "asset-renderer")
+ (test-equal "2 columns"
+ 2
+ (length (sxml->table-row-col sxml 1 0 #f)))
+ (test-equal "account-1"
+ '("account-1")
+ (sxml->table-row-col sxml 1 0 2))
+ (test-equal "first row $1.00"
+ '("$1.00")
+ (sxml->table-row-col sxml 1 1 2))
+ (test-equal "28th row $406.00"
+ '("$406.00")
+ (sxml->table-row-col sxml 1 28 2))
+ (test-end "asset-renderer"))))
(define (liability-test uuid)
- ;; this test is tailored for bug 793278
- ;; except we can't use $10,000 because the string->number
- ;; function cannot handle thousand separators. Use $100.
- (let* ((liability-template (gnc:find-report-template uuid))
- (liability-options (gnc:make-report-options uuid))
- (liability-report (constructor uuid "bar" liability-options
- #t #t #f #f ""))
- (liability-renderer (gnc:report-template-renderer liability-template)))
- (let* ((env (create-test-env))
- (asset--acc (env-create-root-account env ACCT-TYPE-ASSET (gnc-default-report-currency)))
- (liabil-acc (env-create-root-account env ACCT-TYPE-CREDIT (gnc-default-report-currency)))
- (income-acc (env-create-root-account env ACCT-TYPE-INCOME (gnc-default-report-currency))))
- (env-create-transaction env (gnc-dmy2time64 01 10 2016) asset--acc liabil-acc 100) ;loan
- (env-create-transaction env (gnc-dmy2time64 01 01 2017) asset--acc income-acc 10) ;salary#1
- (env-create-transaction env (gnc-dmy2time64 02 01 2017) liabil-acc asset--acc 9) ;repay#1
- (env-create-transaction env (gnc-dmy2time64 01 02 2017) asset--acc income-acc 10) ;salary#2
- (env-create-transaction env (gnc-dmy2time64 02 02 2017) liabil-acc asset--acc 9) ;repay#2
- (env-create-transaction env (gnc-dmy2time64 01 03 2017) asset--acc income-acc 10) ;salary#3
- (env-create-transaction env (gnc-dmy2time64 02 03 2017) liabil-acc asset--acc 9) ;repay#3
- (env-create-transaction env (gnc-dmy2time64 01 04 2017) asset--acc income-acc 10) ;salary#4
- (env-create-transaction env (gnc-dmy2time64 02 04 2017) liabil-acc asset--acc 9) ;repay#4
- (env-create-transaction env (gnc-dmy2time64 01 05 2017) asset--acc income-acc 10) ;salary#5
- (env-create-transaction env (gnc-dmy2time64 02 05 2017) liabil-acc asset--acc 9) ;repay#5
- (begin
- (set-option liability-report gnc:pagename-display "Show table" #t)
- (set-option liability-report gnc:pagename-general "Start Date" (cons 'absolute (gnc-dmy2time64 01 01 2017)))
- (set-option liability-report gnc:pagename-general "End Date" (cons 'absolute (gnc-dmy2time64 31 12 2018)))
- (set-option liability-report gnc:pagename-general "Step Size" 'MonthDelta)
- (set-option liability-report gnc:pagename-general "Price Source" 'pricedb-nearest)
- (set-option liability-report gnc:pagename-general "Report's currency" (gnc-default-report-currency))
- (set-option liability-report gnc:pagename-accounts "Accounts" (list liabil-acc))
- (set-option liability-report gnc:pagename-accounts "Show Accounts until level" 'all)
- (let ((doc (liability-renderer liability-report)))
- (gnc:html-document-set-style-sheet! doc (gnc:report-stylesheet liability-report))
- (let* ((html-document (gnc:html-document-render doc #f))
- (columns (columns-from-report-document html-document))
- (tbl (stream->list
- (pattern-streamer "<tr>"
- (list (list "<td>([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>" 1 2 3)
- (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
- html-document)))
- (row-count (tbl-row-count tbl)))
- (and (= 2 (length columns))
- (= 100 (string->number (car (tbl-ref tbl 0 1))))
- (= 55 (string->number (car (tbl-ref tbl (- row-count 1) 1))))
- #t)))))))
+ (let* ((liability-options (gnc:make-report-options uuid))
+ (env (create-test-env))
+ (asset--acc (env-create-root-account env ACCT-TYPE-ASSET (gnc-default-report-currency)))
+ (liabil-acc (env-create-root-account env ACCT-TYPE-CREDIT (gnc-default-report-currency)))
+ (income-acc (env-create-root-account env ACCT-TYPE-INCOME (gnc-default-report-currency))))
+ (env-create-transaction env (gnc-dmy2time64 01 10 2016) asset--acc liabil-acc 100) ;loan
+ (env-create-transaction env (gnc-dmy2time64 01 01 2017) asset--acc income-acc 10) ;salary#1
+ (env-create-transaction env (gnc-dmy2time64 02 01 2017) liabil-acc asset--acc 9) ;repay#1
+ (env-create-transaction env (gnc-dmy2time64 01 02 2017) asset--acc income-acc 10) ;salary#2
+ (env-create-transaction env (gnc-dmy2time64 02 02 2017) liabil-acc asset--acc 9) ;repay#2
+ (env-create-transaction env (gnc-dmy2time64 01 03 2017) asset--acc income-acc 10) ;salary#3
+ (env-create-transaction env (gnc-dmy2time64 02 03 2017) liabil-acc asset--acc 9) ;repay#3
+ (env-create-transaction env (gnc-dmy2time64 01 04 2017) asset--acc income-acc 10) ;salary#4
+ (env-create-transaction env (gnc-dmy2time64 02 04 2017) liabil-acc asset--acc 9) ;repay#4
+ (env-create-transaction env (gnc-dmy2time64 01 05 2017) asset--acc income-acc 10) ;salary#5
+ (env-create-transaction env (gnc-dmy2time64 02 05 2017) liabil-acc asset--acc 9) ;repay#5
+ (set-option liability-options gnc:pagename-display "Show table" #t)
+ (set-option liability-options gnc:pagename-general "Start Date" (cons 'absolute (gnc-dmy2time64 01 01 2017)))
+ (set-option liability-options gnc:pagename-general "End Date" (cons 'absolute (gnc-dmy2time64 31 12 2018)))
+ (set-option liability-options gnc:pagename-general "Step Size" 'MonthDelta)
+ (set-option liability-options gnc:pagename-general "Price Source" 'pricedb-nearest)
+ (set-option liability-options gnc:pagename-general "Report's currency" (gnc-default-report-currency))
+ (set-option liability-options gnc:pagename-accounts "Accounts" (list liabil-acc))
+ (set-option liability-options gnc:pagename-accounts "Show Accounts until level" 'all)
+
+ (let ((sxml (gnc:options->sxml uuid liability-options "test-standard-category-report"
+ "liability-test" #:strip-tag "script")))
+ (test-begin "liability-renderer")
+ (test-equal "2 columns"
+ 2
+ (length (sxml->table-row-col sxml 1 0 #f)))
+ (test-equal "account-2"
+ '("account-2")
+ (sxml->table-row-col sxml 1 0 2))
+ (test-equal "first row $100.00"
+ '("$100.00")
+ (sxml->table-row-col sxml 1 1 2))
+ (test-equal "last row $55.00"
+ '("$55.00")
+ (sxml->table-row-col sxml 1 -1 2))
+ (test-end "liability-renderer"))))
commit 2423aeda42b13c267d8b785e8a66e852d48be7db
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Dec 28 16:46:55 2018 +0800
[engine/test-test-extras] remove duplicated test file
diff --git a/libgnucash/engine/test/CMakeLists.txt b/libgnucash/engine/test/CMakeLists.txt
index a19c1fb..5acda90 100644
--- a/libgnucash/engine/test/CMakeLists.txt
+++ b/libgnucash/engine/test/CMakeLists.txt
@@ -217,7 +217,6 @@ gnc_add_test_with_guile(test-scm-query test-scm-query.cpp ENGINE_TEST_INCLUDE_DI
set(engine_test_SCHEME
test-account.scm
test-create-account.scm
- test-test-extras.scm
test-split.scm
)
@@ -315,7 +314,6 @@ set(test_engine_SCHEME_DIST
test-extras.scm
test-scm-query-import.scm
test-split.scm
- test-test-extras.scm
)
set(test_engine_EXTRA_DIST
diff --git a/libgnucash/engine/test/test-test-extras.scm b/libgnucash/engine/test/test-test-extras.scm
deleted file mode 100644
index cc70e6f..0000000
--- a/libgnucash/engine/test/test-test-extras.scm
+++ /dev/null
@@ -1,45 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2 of
-;; the License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this program; if not, contact:
-;;
-;; Free Software Foundation Voice: +1-617-542-5942
-;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
-;; Boston, MA 02110-1301, USA gnu at gnu.org
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(debug-set! stack 50000)
-(use-modules (gnucash gnc-module))
-(gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
-(use-modules (gnucash engine test test-extras))
-(use-modules (ice-9 streams))
-(use-modules (gnucash engine))
-(use-modules (sw_engine))
-
-(define (run-test)
- (test-create-account-structure))
-
-(define (test-create-account-structure)
- (let ((env (create-test-env)))
- (let ((accounts (env-create-account-structure env (list "Assets"
- (list (cons 'type ACCT-TYPE-ASSET))
- (list "Bank Account")
- (list "Savings"
- (list "Instant")
- (list "30 day notice"))))))
- (and (= 3 (length accounts))
- (equal? "Assets" (xaccAccountGetName (car accounts)))
- ))))
-
-
-
-
commit 267c3863d85b9b0a19627d20eed96b6f66039d3e
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Dec 26 12:16:23 2018 +0800
[collectors] deprecate collectors and report-collectors
diff --git a/gnucash/report/report-system/collectors.scm b/gnucash/report/report-system/collectors.scm
index 5470d93..1731c0e 100644
--- a/gnucash/report/report-system/collectors.scm
+++ b/gnucash/report/report-system/collectors.scm
@@ -18,6 +18,10 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-module (gnucash report report-system collectors))
+
+(issue-deprecation-warning
+ "(gnucash report report-system collectors) is deprecated.")
+
(use-modules (srfi srfi-1))
(export make-filter)
diff --git a/gnucash/report/report-system/report-collectors.scm b/gnucash/report/report-system/report-collectors.scm
index 1e0b3a6..90375c5 100644
--- a/gnucash/report/report-system/report-collectors.scm
+++ b/gnucash/report/report-system/report-collectors.scm
@@ -19,6 +19,9 @@
(define-module (gnucash report report-system report-collectors))
+(issue-deprecation-warning
+ "(gnucash report report-system report-collectors) is deprecated.")
+
(use-modules (gnucash gnc-module))
(gnc:module-load "gnucash/report/report-system" 0)
diff --git a/gnucash/report/report-system/test/test-collectors.scm b/gnucash/report/report-system/test/test-collectors.scm
deleted file mode 100644
index 40651be..0000000
--- a/gnucash/report/report-system/test/test-collectors.scm
+++ /dev/null
@@ -1,225 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2 of
-;; the License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this program; if not, contact:
-;;
-;; Free Software Foundation Voice: +1-617-542-5942
-;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
-;; Boston, MA 02110-1301, USA gnu at gnu.org
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(debug-set! stack 50000)
-(use-modules (gnucash gnc-module))
-(gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
-(use-modules (srfi srfi-1))
-
-(use-modules (gnucash report report-system collectors))
-(use-modules (gnucash engine test test-extras))
-
-(define (run-test)
- (and (test test-empty)
- (test test-one)
- (test test-two)
- (test test-make-eq-set)
- (test test-make-extreme-collector)
- (test test-collector-split)
- (test test-make-mapper-collector)
- (test test-make-list-collector)
- (test test-slotset)
- (test test-collector-from-slotset)
- (test test-binary-search-lt)
- (test test-collector-into-list)
- (test test-function-state->collector)
- (test test-collector-do)
- #t))
-
-
-(define (test-slotset)
- (let* ((values '(2 4 6))
- (slotset (make-slotset (lambda (x) (* 2 x)) values)))
- (and (equal? values (slotset-slots slotset))
- (equal? 2 (slotset-slot slotset 1)))))
-
-(define (test-empty)
- (let ((c (empty-collector)))
- (let ((empty (collector-end c)))
- (and (equal? 4 (length empty))
- (equal? 0 (collector-add-all (collector-accumulate-from 0)
- (map cdr empty)))))))
-
-(define (test-one)
- (define c (empty-collector))
- (set! c (collector-add c 1))
- (and (equal? 1 (collector-add-all (collector-accumulate-from 0)
-
- (map cdr (collector-end c))))
- (equal? 4 (length (collector-end c)))))
-
-(define (test-two)
- (define c (empty-collector))
- (set! c (collector-add c 2))
- (and (equal? 2 (collector-add-all (collector-accumulate-from 0)
- (map cdr (collector-end c))))
- (equal? 4 (length (collector-end c)))))
-
-(define (empty-collector)
- (define (equal-predicate a)
- (lambda (x)
- (equal? a x)))
- (collector-per-property '(1 2 3 4)
- make-equal-filter
- (lambda (value) (collector-accumulate-from 0))))
-
-(define (test-make-eq-set)
- (let ((c (make-eq-set-collector '())))
- (and (null-list? (collector-end c))
- (let ((c1 (collector-add c 1)))
- (equal? '(1) (collector-end c1)))
- (equal? '(1) (collector-add-all c '(1 1 1)))
- (let ((result (collector-add-all c '(1 2))))
- (and (member 1 result)
- (member 2 result)
- (= (length result) 2))))))
-
-(define (test-make-extreme-collector)
- (let ((c (make-extreme-collector > 0)))
- (and (equal? 0 (collector-end c))
- (equal? 0 (collector-add-all c '(-1)))
- (equal? 1 (collector-add-all c '(1)))
- (equal? 5 (collector-add-all c '(5)))
- (equal? 5 (collector-add-all c '(1 5)))
- (equal? 5 (collector-add-all c '(5 1)))
- #t)))
-
-(define (test-collector-split)
- (let* ((c (collector-split (lambda (x) x)
- (lambda (x) (collector-count-from 0))))
- (all (collector-add-all c '(1 2 3 4 5 1 2))))
- (and (equal? 5 (length all))
- #t)))
-
-(define (test-make-mapper-collector)
- (let ((double-and-add (make-mapper-collector (lambda (x) (* x 2))
- (collector-accumulate-from 0))))
- (and (equal? 0 (collector-end double-and-add))
- (equal? 2 (collector-add-all double-and-add '(1)))
- #t)))
-
-(define (test-make-list-collector)
- (let ((c1 (collector-accumulate-from 0))
- (c2 (collector-count-from 0)))
- (and (equal? '(10 4) (collector-add-all (make-list-collector (list c1 c2)) '(1 2 3 4))))))
-
-
-(define (test-collector-into-list)
- (define (check l)
- (equal? l (collector-add-all (collector-into-list) l)))
- (and (check '())
- (check '(1))
- (check '(1 2))
- (check '(1 2 3))
- (check '(1 2 3 4))))
-
-(define (test-collector-from-slotset)
- ;;(define (add-trace name collector)
- ;; (collector-print #t name collector))
-
- (define (make-slotset-counter values)
- (let ((slotset (make-slotset (lambda (x) x) values)))
- (labelled-collector-from-slotset slotset
- (lambda (n)
- (collector-count-from 0)))))
- (and (let ((values '(1 2)))
- (equal? '((1 . 0) (2 . 0))
- (collector-add-all (make-slotset-counter values)
- '())))
- (let ((values '(1 2)))
- (equal? '((1 . 1) (2 . 1))
- (collector-add-all (make-slotset-counter values)
- '(1 2))))
- (let ((values '(1 2)))
- (equal? '((1 . 3) (2 . 2))
- (collector-add-all (make-slotset-counter values)
- '(1 2 1 2 1))))))
-
-
-(use-modules (ice-9 streams))
-
-(define (stream-range from to)
- (make-stream (lambda (current)
- (if (> current to) '()
- (cons current (+ current 1))))
- from))
-
-(define (slow-search <= value vector)
- (define (search n)
- (if (= n (vector-length vector)) (- n 1)
- (if (<= (vector-ref vector n) value)
- (search (+ n 1))
- (if (= n 0) #f (- n 1)))))
- (if (= 0 (vector-length vector)) #f
- (search 0)))
-
-(define (test-binary-search-lt)
- (define (search value vector)
- (let ((binary-value (binary-search-lt <= value vector))
- (slow-value (slow-search <= value vector))
- (length (vector-length vector)))
- (if (equal? binary-value slow-value) binary-value
- (begin (format #t "Mismatch ~a ~a, expected ~a, found ~a\n" value vector slow-value binary-value)
- (throw 'mismatch)))
- binary-value))
- (and (and (equal? #f (search 1 #()))
- (equal? #f (search 0 #(1)))
- (equal? 0 (search 1 #(1)))
- (equal? 0 (search 2 #(1)))
- (equal? #f (search 0 #(1 3)))
- (equal? 0 (search 1 #(1 3)))
- (equal? 0 (search 2 #(1 3)))
- (equal? 1 (search 3 #(1 3)))
- (equal? 1 (search 4 #(1 3))))
- (let* ((values (stream-range 0 20))
- (vectors (stream-map (lambda (n)
- (let ((vector (make-vector n)))
- (stream-for-each (lambda (index)
- (vector-set! vector index (+ (* index 2) 1)))
- (stream-range 0 (- n 1)))
- vector))
- values))
- (tested-vectors (stream-map (lambda (vector)
- (stream-for-each
- (lambda (value)
- (search value vector))
- (stream-range 0 (+ (* (vector-length vector) 2) 1))))
- vectors)))
- (stream-for-each (lambda (x) x) tested-vectors))))
-
-(define (test-function-state->collector)
- (define (count v current-count) (+ current-count 1))
- (define (check-count l)
- (= (length l) (collector-add-all (function-state->collector count 0) l)))
- (check-count '())
- (check-count '(1))
- (check-count '(1 2 3)))
-
-(define (test-collector-do)
- (let ((count 0))
- (let ((add-to-list-and-count (collector-do (collector-into-list)
- (function-state->collector (lambda (v n)
- (set! count (+ n 1))
- (+ n 1))
- 0))))
- (let* ((orig '(one two three))
- (collected (collector-add-all add-to-list-and-count orig)))
- (format #t "~a ~a ~a\n" count collected orig)
- (and (equal? orig collected)
- (= count (length orig)))))))
commit ecb3b518e5669a7e4f7b611d06189373524109d3
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Dec 28 16:31:42 2018 +0800
[report-system/test-extras] cease testing pattern-streamer
pattern-streamer is a built-in module. why test it?
diff --git a/gnucash/report/report-system/test/CMakeLists.txt b/gnucash/report/report-system/test/CMakeLists.txt
index 2b7c080..5b43386 100644
--- a/gnucash/report/report-system/test/CMakeLists.txt
+++ b/gnucash/report/report-system/test/CMakeLists.txt
@@ -58,5 +58,4 @@ set_dist_list(test_report_system_DIST
${scm_test_report_system_SOURCES}
test-extras.scm
test-link-module.c
- test-test-extras.scm
)
diff --git a/gnucash/report/report-system/test/test-test-extras.scm b/gnucash/report/report-system/test/test-test-extras.scm
index 676d130..8787e61 100644
--- a/gnucash/report/report-system/test/test-test-extras.scm
+++ b/gnucash/report/report-system/test/test-test-extras.scm
@@ -17,87 +17,14 @@
;; Boston, MA 02110-1301, USA gnu at gnu.org
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(debug-set! stack 50000)
(use-modules (gnucash report report-system test test-extras))
(use-modules (gnucash engine test test-extras))
-
-(use-modules (ice-9 streams))
-
-(define (run-test)
- (and (test-pattern-streamer)
- (test-create-account-structure)))
-
-(define (test-pattern-streamer)
- (and (test test-pattern-streamer-1)
- (test test-pattern-streamer-2)
- (test test-pattern-streamer-3)
- (test test-pattern-streamer-4)
- #t))
-
-(define (test-pattern-streamer-1)
- (let* ((content (values-for-text "tbl row x 1 y 2 row x 3 y 4 ")))
- (format #t "Values: ~a ~a\n" content (list (list 1 2) (list 3 4)))
- (equal? '((("1") ("2")) (("3") ("4"))) content)))
-
-(define (test-pattern-streamer-2)
- (let* ((text "")
- (content (values-for-text text)))
- (format #t "Values: ~a\n" content)
- (equal? (list) content)))
-
-(define (values-for-text text)
- (let* ((content-stream (pattern-streamer "row" (list (list "x ([0-9]*) " 1)
- (list "y ([0-9]*) " 1))
- text))
- (content (stream->list content-stream)))
- content))
-
-(define (test-pattern-streamer-4)
- (let* ((text "tbl row x 11 v 12 v 13 row x 21 v 22 v 23 ")
- (content-stream (pattern-streamer "row"
- (list (list "x ([0-9]*) " 1)
- (list "v ([0-9]*) " 1)
- (list "v ([0-9]*) " 1))
- text))
- (content (stream->list content-stream)))
- (= 11 (tbl-ref->number content 0 0))
- (= 23 (tbl-ref->number content 1 2))))
-
-
-(define stuff "<table>
-<tr>
-<th><string> Date</th>
-
-<th><string> Auto</th>
-
-<th><string> Groceries</th>
-
-<th><string> Rent</th>
-
-<th><string> Expenses</th>
-
-<th><string> Grand Total</th>
-</tr>
-
-")
-(define (test-pattern-streamer-3)
- (let ((columns (stream->list (pattern-streamer "<th>"
- (list (list "<string> ([^<]*)</" 1))
- stuff))))
- (format #t "columns ~a\n" columns)
- (= 6 (length columns))))
-
-;;
-;;
-;;
-
-;(use-modules (gnucash engine))
-;(use-modules (gnucash utilities))
-;(use-modules (gnucash report report-system))
-;(use-modules (gnucash app-utils))
(use-modules (gnucash engine))
(use-modules (sw_engine))
+(define (run-test)
+ (test-create-account-structure))
+
(define (test-create-account-structure)
(let ((env (create-test-env)))
(let ((accounts (env-create-account-structure env (list "Assets"
@@ -110,7 +37,3 @@
(and (= 3 (length accounts))
(equal? "Assets" (xaccAccountGetName (car accounts)))
))))
-
-
-
-
commit c13085f3611cb3be64e771e122a6fc6fb7cf0f75
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Dec 26 23:41:49 2018 +0800
[test-collectors] cease testing collectors.scm
diff --git a/gnucash/report/report-system/test/CMakeLists.txt b/gnucash/report/report-system/test/CMakeLists.txt
index bfe51be..2b7c080 100644
--- a/gnucash/report/report-system/test/CMakeLists.txt
+++ b/gnucash/report/report-system/test/CMakeLists.txt
@@ -11,7 +11,6 @@ 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-test-extras.scm
)
diff --git a/gnucash/report/report-system/test/test-extras.scm b/gnucash/report/report-system/test/test-extras.scm
index acfaa61..41e15b8 100644
--- a/gnucash/report/report-system/test/test-extras.scm
+++ b/gnucash/report/report-system/test/test-extras.scm
@@ -25,64 +25,6 @@
(use-modules (sxml simple))
(use-modules (sxml xpath))
-(export pattern-streamer)
-
-(export tbl-column-count)
-(export tbl-row-count)
-(export tbl-ref)
-(export tbl-ref->number)
-
-;;
-;; Table parsing
-;;
-(use-modules (ice-9 regex))
-(use-modules (ice-9 streams))
-
-(define (values-for-keywords pos regex-list text)
- (make-stream (lambda (pos-keywords-pair)
- (let ((current-pos (car pos-keywords-pair))
- (regex-list (cdr pos-keywords-pair)))
- (if (null? regex-list)
- '()
- (let ((match (string-match (caar regex-list) text current-pos)))
- (if (not match)
- '()
- (let ((new-state (cons (match:end match)
- (cdr regex-list)))
- (next-value (cons (match:end match)
- (map (lambda (item)
- (match:substring match item))
- (cdar regex-list)))))
- (cons next-value new-state)))))))
- (cons pos regex-list)))
-
-(define (pattern-streamer start-text regex-list text)
- (define (stream-next index)
- ;;(format #t "Next. Index: ~a\n" index)
- (let ((head-index (string-contains text start-text index)))
- ;; (format #t "head index ~a ~a --> ~a\n" start-text index head-index)
- (if (not head-index) '()
- (let ((values (stream->list (values-for-keywords head-index regex-list text))))
- (if (null? values) '()
- (let ((new-state (car (car (last-pair values))))
- (next-value (map cdr values)))
- (cons next-value new-state)))))))
- ;;(format #t "Stream ~a\n" text)
- (make-stream stream-next 0))
-
-;; silly table functions
-(define (tbl-column-count tbl)
- (length (car tbl)))
-
-(define (tbl-row-count tbl)
- (length tbl))
-
-(define (tbl-ref tbl row-index column-index)
- (list-ref (list-ref tbl row-index) column-index))
-
-(define (tbl-ref->number tbl row-index column-index)
- (string->number (car (tbl-ref tbl row-index column-index))))
-
(export gnc:options->render)
(define (gnc:options->render uuid options prefix test-title)
;; uuid - str to locate report uuid
commit f5f24eb9cab3ce1aaf4ca1f9f7523a86fb45fbdd
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Dec 27 00:33:02 2018 +0800
[options-utilities] deprecate unused functions
These functions are never actually used.
diff --git a/gnucash/report/report-system/options-utilities.scm b/gnucash/report/report-system/options-utilities.scm
index 6a0e5ef..43d8bbb 100644
--- a/gnucash/report/report-system/options-utilities.scm
+++ b/gnucash/report/report-system/options-utilities.scm
@@ -122,6 +122,7 @@
;; into the other balances.
(define (gnc:options-add-include-subaccounts!
options pagename optname sort-tag)
+ (issue-deprecation-warning "gnc:options-add-include-subaccounts! is deprecated.")
(gnc:register-option
options
(gnc:make-simple-boolean-option
@@ -132,6 +133,7 @@
;; categories and ahow a subtotal for those.
(define (gnc:options-add-group-accounts!
options pagename optname sort-tag default?)
+ (issue-deprecation-warning "gnc:options-add-group-accounts! is deprecated.")
(gnc:register-option
options
(gnc:make-simple-boolean-option
@@ -154,6 +156,7 @@
(define (gnc:options-add-currency-selection!
options pagename
name-show-foreign name-report-currency sort-tag)
+ (issue-deprecation-warning "gnc:options-add-currency-selection! is deprecated.")
(gnc:register-option
options
(gnc:make-simple-boolean-option
diff --git a/gnucash/report/report-system/report-system.scm b/gnucash/report/report-system/report-system.scm
index 5d068f5..756b5bf 100644
--- a/gnucash/report/report-system/report-system.scm
+++ b/gnucash/report/report-system/report-system.scm
@@ -75,10 +75,10 @@
(export gnc:options-add-interval-choice!)
(export gnc:options-add-account-levels!)
(export gnc:options-add-account-selection!)
-(export gnc:options-add-include-subaccounts!)
-(export gnc:options-add-group-accounts!)
+(export gnc:options-add-include-subaccounts!) ;deprecated
+(export gnc:options-add-group-accounts!) ;deprecated
(export gnc:options-add-currency!)
-(export gnc:options-add-currency-selection!)
+(export gnc:options-add-currency-selection!) ;deprecated
(export gnc:options-add-price-source!)
(export gnc:options-add-plot-size!)
(export gnc:options-add-marker-choice!)
Summary of changes:
gnucash/report/locale-specific/us/taxtxf.scm | 2 +-
gnucash/report/report-system/collectors.scm | 4 +
gnucash/report/report-system/options-utilities.scm | 3 +
gnucash/report/report-system/report-collectors.scm | 3 +
gnucash/report/report-system/report-system.scm | 10 +-
gnucash/report/report-system/report-utilities.scm | 12 +-
gnucash/report/report-system/test/CMakeLists.txt | 2 -
.../report/report-system/test/test-collectors.scm | 225 ---------
gnucash/report/report-system/test/test-extras.scm | 58 ---
.../report-system/test/test-report-utilities.scm | 16 -
.../report/report-system/test/test-test-extras.scm | 83 +--
.../report/standard-reports/equity-statement.scm | 20 +-
.../report/standard-reports/test/CMakeLists.txt | 8 +-
.../test/test-cashflow-barchart.scm | 379 ++++++--------
.../test/test-standard-category-report.scm | 403 +++++++--------
.../test/test-standard-net-barchart.scm | 554 +++++++++------------
.../test/test-standard-net-linechart.scm | 326 ++++++------
gnucash/report/standard-reports/trial-balance.scm | 67 ++-
libgnucash/engine/test/CMakeLists.txt | 2 -
libgnucash/engine/test/test-test-extras.scm | 45 --
20 files changed, 804 insertions(+), 1418 deletions(-)
delete mode 100644 gnucash/report/report-system/test/test-collectors.scm
delete mode 100644 libgnucash/engine/test/test-test-extras.scm
More information about the gnucash-changes
mailing list