mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
Merge old tests with their support files.
It bothered me that these old tests have 2 scheme files per test. It was always confusing.
This commit is contained in:
Christopher Lam
parent
a78e8b1035
commit
186ac71fcf
@ -13,12 +13,6 @@ set(scm_test_with_srfi64_SOURCES
|
||||
test-income-gst.scm
|
||||
)
|
||||
|
||||
set(scm_test_report_SUPPORT
|
||||
test-generic-category-report.scm
|
||||
test-generic-net-barchart.scm
|
||||
test-generic-net-linechart.scm
|
||||
)
|
||||
|
||||
set(GUILE_DEPENDS
|
||||
scm-gnc-module
|
||||
scm-app-utils
|
||||
@ -37,16 +31,10 @@ endif (HAVE_SRFI64)
|
||||
|
||||
gnc_add_scheme_tests("${scm_test_standard_reports_SOURCES}")
|
||||
|
||||
gnc_add_scheme_targets(scm-test-standard-support
|
||||
"${scm_test_report_SUPPORT}"
|
||||
"gnucash/report/standard-reports/test"
|
||||
"${GUILE_DEPENDS}"
|
||||
FALSE
|
||||
)
|
||||
gnc_add_scheme_targets(scm-test-standard-reports
|
||||
"${scm_test_standard_reports_SOURCES}"
|
||||
gnucash/report/standard-reports/test
|
||||
"scm-test-standard-support"
|
||||
"${GUILE_DEPENDS}"
|
||||
FALSE
|
||||
)
|
||||
|
||||
@ -54,4 +42,4 @@ add_dependencies(check scm-test-standard-reports)
|
||||
|
||||
set_dist_list(test_standard_reports_DIST CMakeLists.txt
|
||||
${scm_test_with_srfi64_SOURCES}
|
||||
${scm_test_standard_reports_SOURCES} ${scm_test_report_SUPPORT})
|
||||
${scm_test_standard_reports_SOURCES})
|
||||
|
||||
@ -1,292 +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@gnu.org
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define-module (gnucash report standard-reports test test-generic-category-report))
|
||||
|
||||
(use-modules (ice-9 format))
|
||||
(use-modules (ice-9 streams))
|
||||
(use-modules (srfi srfi-1))
|
||||
|
||||
(use-modules (gnucash gnc-module))
|
||||
(gnc:module-load "gnucash/report/report-system" 0)
|
||||
|
||||
(use-modules (gnucash utilities))
|
||||
(use-modules (gnucash report report-system))
|
||||
(use-modules (gnucash app-utils))
|
||||
(use-modules (gnucash engine))
|
||||
(use-modules (sw_engine))
|
||||
(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))
|
||||
|
||||
(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>))
|
||||
|
||||
;(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 (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))
|
||||
|
||||
(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))
|
||||
|
||||
;; 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
|
||||
)))
|
||||
|
||||
|
||||
(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))))))))
|
||||
|
||||
(define (list-leaves list)
|
||||
(if (not (pair? list))
|
||||
(cons list '())
|
||||
(fold (lambda (next acc)
|
||||
(append (list-leaves next)
|
||||
acc))
|
||||
'()
|
||||
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 ((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)))))))
|
||||
|
||||
(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)))))))
|
||||
@ -1,366 +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@gnu.org
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define-module (gnucash report standard-reports test test-generic-net-barchart))
|
||||
|
||||
(use-modules (ice-9 format))
|
||||
(use-modules (ice-9 streams))
|
||||
(use-modules (srfi srfi-1))
|
||||
|
||||
(use-modules (gnucash gnc-module))
|
||||
(gnc:module-load "gnucash/report/report-system" 0)
|
||||
(use-modules (gnucash report stylesheets))
|
||||
|
||||
(use-modules (gnucash engine test test-extras))
|
||||
(use-modules (gnucash report report-system test test-extras))
|
||||
|
||||
(export run-net-asset-income-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 (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))
|
||||
|
||||
;; 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
|
||||
)))
|
||||
|
||||
(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))
|
||||
))))))
|
||||
|
||||
|
||||
(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))))
|
||||
(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))
|
||||
))))))
|
||||
|
||||
|
||||
(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))))
|
||||
(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))
|
||||
))))))
|
||||
|
||||
(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 ((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))
|
||||
))))))
|
||||
|
||||
|
||||
(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)
|
||||
|
||||
(let ((closing-txn (env-create-transaction env date-2 my-asset-account my-equity-account
|
||||
300/1)))
|
||||
(xaccTransSetIsClosingTxn closing-txn #t))
|
||||
|
||||
(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 ((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))
|
||||
))))))
|
||||
|
||||
@ -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@gnu.org
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define-module (gnucash report standard-reports test test-generic-net-linechart))
|
||||
|
||||
(use-modules (ice-9 format))
|
||||
(use-modules (ice-9 streams))
|
||||
(use-modules (srfi srfi-1))
|
||||
|
||||
(use-modules (gnucash gnc-module))
|
||||
(gnc:module-load "gnucash/report/report-system" 0)
|
||||
(use-modules (gnucash report stylesheets))
|
||||
|
||||
(use-modules (gnucash report report-system test test-extras))
|
||||
(use-modules (gnucash engine test test-extras))
|
||||
|
||||
(export run-net-asset-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 (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)))
|
||||
|
||||
;; 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
|
||||
)))
|
||||
|
||||
(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)))))))))
|
||||
|
||||
|
||||
(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)))))))))
|
||||
|
||||
|
||||
(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)))))))))
|
||||
|
||||
@ -36,11 +36,16 @@
|
||||
(use-modules (gnucash engine))
|
||||
(use-modules (sw_engine))
|
||||
(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))
|
||||
|
||||
(use-modules (gnucash report standard-reports test test-generic-category-report))
|
||||
(use-modules (gnucash report standard-reports category-barchart))
|
||||
|
||||
;; Explicitly set locale to make the report output predictable
|
||||
(setlocale LC_ALL "C")
|
||||
@ -48,3 +53,257 @@
|
||||
(define (run-test)
|
||||
(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>))
|
||||
|
||||
;(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 (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))
|
||||
|
||||
(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))
|
||||
|
||||
;; 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
|
||||
)))
|
||||
|
||||
|
||||
(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))))))))
|
||||
|
||||
(define (list-leaves list)
|
||||
(if (not (pair? list))
|
||||
(cons list '())
|
||||
(fold (lambda (next acc)
|
||||
(append (list-leaves next)
|
||||
acc))
|
||||
'()
|
||||
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 ((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)))))))
|
||||
|
||||
(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)))))))
|
||||
|
||||
@ -18,18 +18,17 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(debug-set! stack 50000)
|
||||
;(use-modules (gnucash report new-reports reports-2))
|
||||
|
||||
(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 (gnucash report stylesheets))
|
||||
(use-modules (gnucash engine test test-extras))
|
||||
(use-modules (gnucash report report-system test test-extras))
|
||||
|
||||
(use-modules (gnucash report standard-reports test test-generic-net-barchart))
|
||||
(use-modules (gnucash report standard-reports net-charts))
|
||||
|
||||
;; Explicitly set locale to make the report output predictable
|
||||
@ -38,3 +37,334 @@
|
||||
(define (run-test)
|
||||
(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 (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))
|
||||
|
||||
;; 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
|
||||
)))
|
||||
|
||||
(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))
|
||||
))))))
|
||||
|
||||
|
||||
(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))))
|
||||
(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))
|
||||
))))))
|
||||
|
||||
|
||||
(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))))
|
||||
(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))
|
||||
))))))
|
||||
|
||||
(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 ((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))
|
||||
))))))
|
||||
|
||||
|
||||
(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)
|
||||
|
||||
(let ((closing-txn (env-create-transaction env date-2 my-asset-account my-equity-account
|
||||
300/1)))
|
||||
(xaccTransSetIsClosingTxn closing-txn #t))
|
||||
|
||||
(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 ((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))
|
||||
))))))
|
||||
|
||||
|
||||
@ -18,24 +18,17 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(debug-set! stack 50000)
|
||||
;(use-modules (gnucash report new-reports reports-2))
|
||||
|
||||
(use-modules (gnucash gnc-module))
|
||||
|
||||
;; Guile 2 needs to load external modules at compile time
|
||||
;; otherwise the N_ syntax-rule won't be found at compile time
|
||||
;; causing the test to fail
|
||||
;; That's what the wrapper below is meant for:
|
||||
(define-syntax-rule (begin-for-syntax form ...)
|
||||
(eval-when (load compile eval expand) (begin form ...)))
|
||||
|
||||
(begin-for-syntax (gnc:module-load "gnucash/report/report-system" 0))
|
||||
(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 (gnucash report stylesheets))
|
||||
(use-modules (gnucash engine test test-extras))
|
||||
(use-modules (gnucash report report-system test test-extras))
|
||||
|
||||
(use-modules (gnucash report standard-reports test test-generic-net-linechart))
|
||||
(use-modules (gnucash report standard-reports net-charts))
|
||||
|
||||
;; Explicitly set locale to make the report output predictable
|
||||
@ -44,3 +37,194 @@
|
||||
(define (run-test)
|
||||
(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 (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)))
|
||||
|
||||
;; 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
|
||||
)))
|
||||
|
||||
(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)))))))))
|
||||
|
||||
|
||||
(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)))))))))
|
||||
|
||||
|
||||
(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)))))))))
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user