IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

Merge Chris Lam's 'maint-test-all-charts' into maint.

Browse Source
This commit is contained in:
John Ralls 2018-06-17 14:06:38 -07:00
commit a9f0fe2f93
20 changed files with 1029 additions and 968 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
gnucash/report/business-reports/balsheet-eg.eguile.scm
View File

@ -130,7 +130,6 @@
<meta http-equiv="content-type" content="text-html; charset=utf-8">
<title><?scm:d coyname ?> <?scm:d reportname ?> <?scm:d (qof-print-date opt-date) ?></title>
<?scm (if css? (begin ?>
<link rel="stylesheet" href="<?scm:d opt-css-file ?>" type="text/css">
<!-- Note that the stylesheet file is overridden by some options, i.e.
opt-font-family and opt-font-size -->
@ -149,7 +148,6 @@
<?scm )) ?>
}
</style>
<?scm )) ?>
</head>
<body>

2
gnucash/report/business-reports/receipt.eguile.scm
View File

@ -108,7 +108,6 @@
<meta http-equiv="Content-Type" content="text/html;charset=utf-8" >
<title><?scm:d (_ "Invoice") ?> <?scm:d invoiceid ?></title>
<?scm (if css? (begin ?>
<link rel="stylesheet" href="<?scm:d opt-css-file ?>" type="text/css">
<!-- Note that the external stylesheet file is overridden by this following: -->
<style type="text/css">
@ -122,7 +121,6 @@
<?scm:d opt-heading-font ?>
}
</style>
<?scm )) ?>
</head>
<body>

1
gnucash/report/business-reports/receipt.scm
View File

@ -240,7 +240,6 @@
(opt-amount-due-heading (opt-value headingpage2 optname-amount-due))
(opt-payment-recd-heading (opt-value headingpage2 optname-payment-recd))
(opt-extra-notes (opt-value notespage optname-extra-notes))
(css? #t)
(html (eguile-file-to-string
opt-template-file
(the-environment))))

2
gnucash/report/business-reports/taxinvoice.eguile.scm
View File

@ -130,7 +130,6 @@
<meta http-equiv="Content-Type" content="text/html;charset=utf-8" >
<title><?scm:d (_ "Invoice") ?> <?scm:d invoiceid ?></title>
<?scm (if css? (begin ?>
<link rel="stylesheet" href="<?scm:d (make-file-url opt-css-file) ?>" type="text/css">
<!-- Note that the external stylesheet file is overridden by this following: -->
<style type="text/css">
@ -153,7 +152,6 @@
}
<?scm:d opt-extra-css ?>
</style>
<?scm )) ?>
</head>
<body>

1
gnucash/report/business-reports/taxinvoice.scm
View File

@ -306,7 +306,6 @@
(opt-jobname-text (opt-value headingpage2 optname-jobname-text))
(opt-extra-css (opt-value notespage optname-extra-css))
(opt-extra-notes (opt-value notespage optname-extra-notes))
(css? #t)
(html (eguile-file-to-string
opt-template-file
(the-environment))))

3
gnucash/report/locale-specific/us/taxtxf.scm
View File

@ -3049,8 +3049,6 @@
#f) ;;end of if
#f) ;;end of if
(begin ; else do tax report
(if #t ;does gcn-html-engine-support-css? #t!
(begin ;; this is for webkit
(gnc:html-document-set-style!
doc "header-just-top"
'tag "th"
@ -3092,7 +3090,6 @@
'tag "td"
'attribute (list "class" "number-cell neg")
'attribute (list "valign" "bottom"))
))
(gnc:html-document-set-style!
doc "just-bot"

4
gnucash/report/report-system/eguile-html-utilities.scm
View File

@ -71,9 +71,7 @@
(define-public (foreignstyle item)
;; apply styling for amount in foreign currency
(if css?
(string-append "<span class=\"foreign\">" item "</span>"))
(string-append "<small><i>" item "</i></small>"))
(string-append "<span class=\"foreign\">" item "</span>"))
;; Convert any x into something printable as HTML
(define-public (dump x) (escape-html (object->string x)))

5
gnucash/report/report-system/html-acct-table.scm
View File

@ -1156,7 +1156,10 @@
;; add the account balance in the respective commodity
(gnc:make-html-table-cell/markup
"number-cell" bal)
"&nbsp;"
(let ((spacer (gnc:make-html-table-cell)))
(gnc:html-table-cell-set-style!
spacer "td" 'attribute (list "style" "min-width: 1em"))
spacer)
;; add the account balance in the report commodity
(gnc:make-html-table-cell/markup
"number-cell" (exchange-fn bal report-commodity))

3
gnucash/report/standard-reports/balance-sheet.scm
View File

@ -697,7 +697,8 @@
total-liabilities? liability-balance))
(add-subtotal-line
right-table (_ "Total Liabilities & Equity")
right-table (gnc:html-string-sanitize
(_ "Total Liabilities & Equity"))
#f liability-plus-equity)
(gnc:html-document-add-object!

19
gnucash/report/standard-reports/test/CMakeLists.txt
View File

@ -7,17 +7,12 @@ set(scm_test_standard_reports_SOURCES
)
set(scm_test_with_srfi64_SOURCES
test-net-charts.scm
test-charts.scm
test-transaction.scm
test-balance-sheet.scm
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
@ -36,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
)
@ -53,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})

140
gnucash/report/standard-reports/test/test-balance-sheet.scm Normal file
View File

@ -0,0 +1,140 @@
(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 (gnucash report standard-reports balance-sheet))
(use-modules (gnucash report stylesheets))
(use-modules (gnucash report report-system))
(use-modules (gnucash report report-system test test-extras))
(use-modules (srfi srfi-64))
(use-modules (gnucash engine test srfi64-extras))
(use-modules (sxml simple))
(use-modules (sxml xpath))
;; This is implementation testing for Balance Sheet.
(define balance-sheet-uuid "c4173ac99b2b448289bf4d11c731af13")
;; Explicitly set locale to make the report output predictable
(setlocale LC_ALL "C")
(define (run-test)
(test-runner-factory gnc:test-runner)
(test-begin "balsheet.scm")
(null-test)
(balsheet-tests)
(test-end "balsheet.scm"))
(define (options->sxml options test-title)
(gnc:options->sxml balance-sheet-uuid options "test-balsheet" test-title))
(define (set-option! options section name value)
(let ((option (gnc:lookup-option options section name)))
(if option
(gnc:option-set-value option value)
(test-assert (format #f "wrong-option ~a ~a" section name) #f))))
(define structure
(list "Root" (list (cons 'type ACCT-TYPE-ASSET))
(list "Asset"
(list "Bank"
(list "Bank-Sub"))
(list "A/Receivable" (list (cons 'type ACCT-TYPE-RECEIVABLE))))
(list "Liability" (list (cons 'type ACCT-TYPE-PAYABLE))
(list "CreditCard")
(list "A/Payable"))
(list "Equity" (list (cons 'type ACCT-TYPE-EQUITY)))
(list "Income" (list (cons 'type ACCT-TYPE-INCOME)))
(list "Expenses" (list (cons 'type ACCT-TYPE-EXPENSE)))))
(define (null-test)
;; This null-test tests for the presence of report.
(let ((options (gnc:make-report-options balance-sheet-uuid)))
(test-assert "null-test" (options->sxml options "null-test"))))
(define (balsheet-tests)
;; This function will perform implementation testing on the transaction report.
(let* ((env (create-test-env))
(account-alist (env-create-account-structure-alist env structure))
(bank (cdr (assoc "Bank" account-alist)))
(banksub (cdr (assoc "Bank-Sub" account-alist)))
(income (cdr (assoc "Income" account-alist)))
(expense (cdr (assoc "Expenses" account-alist)))
(equity (cdr (assoc "Equity" account-alist)))
(creditcard (cdr (assoc "CreditCard" account-alist)))
(payable (cdr (assoc "A/Payable" account-alist)))
(receivable (cdr (assoc "A/Receivable" account-alist)))
(YEAR (gnc:time64-get-year (gnc:get-today))))
(define (default-testing-options)
;; To ease testing of transaction report, we will set default
;; options for generating reports. We will elable extra columns
;; for Exporting, disable generation of informational text, and
;; disable indenting. These options will be tested separately as
;; the first test group. By default, we'll select the modern dates.
(let ((options (gnc:make-report-options balance-sheet-uuid)))
(set-option! options "General" "Balance Sheet Date" (cons 'relative 'end-cal-year))
options))
(define* (create-txn DD MM YY DESC list-of-splits #:optional txn-type)
(let ((txn (xaccMallocTransaction (gnc-get-current-book))))
(xaccTransBeginEdit txn)
(xaccTransSetDescription txn DESC)
(xaccTransSetCurrency txn (gnc-default-report-currency))
(xaccTransSetDate txn DD MM YY)
(for-each
(lambda (tfr)
(let ((split (xaccMallocSplit (gnc-get-current-book))))
(xaccSplitSetParent split txn)
(xaccSplitSetAccount split (cdr tfr))
(xaccSplitSetValue split (car tfr))
(xaccSplitSetAmount split (car tfr))))
list-of-splits)
(if txn-type
(xaccTransSetTxnType txn txn-type))
(xaccTransCommitEdit txn)
txn))
(create-txn 1 1 YEAR "invoice charge $100"
(list (cons -100 income)
(cons 100 receivable))
TXN-TYPE-INVOICE)
(create-txn 1 2 YEAR "receive part-payment $98"
(list (cons -98 receivable)
(cons 98 bank))
TXN-TYPE-PAYMENT)
(create-txn 1 3 YEAR "receive bill $55"
(list (cons 55 expense)
(cons -55 payable))
TXN-TYPE-INVOICE)
(create-txn 1 4 YEAR "part-pay bill $50 using creditcard"
(list (cons 50 payable)
(cons -50 creditcard))
TXN-TYPE-PAYMENT)
(create-txn 1 5 YEAR "part-pay creditcard from bank"
(list (cons 47 creditcard)
(cons -47 banksub)))
;; Finally we can begin testing
(test-begin "display options")
(let* ((options (default-testing-options))
(sxml (options->sxml options "default")))
(test-equal "total assets = $53.00"
(list "Total Assets" "$53.00")
(sxml->table-row-col sxml 1 7 #f))
(test-equal "total liabilities = $8.00"
(list "Total Liabilities" "$8.00")
(sxml->table-row-col sxml 1 14 #f))
(test-equal "total equity = $45.00"
(list "Total Equity" "$45.00")
(sxml->table-row-col sxml 1 19 #f))
)
(test-end "display options")))

82
gnucash/report/standard-reports/test/test-net-charts.scm → gnucash/report/standard-reports/test/test-charts.scm
View File

@ -2,6 +2,10 @@
(gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
(use-modules (gnucash engine test test-extras))
(use-modules (gnucash report standard-reports net-charts))
(use-modules (gnucash report standard-reports account-piecharts))
(use-modules (gnucash report standard-reports cashflow-barchart))
(use-modules (gnucash report standard-reports daily-reports))
(use-modules (gnucash report standard-reports price-scatter))
(use-modules (gnucash report stylesheets))
(use-modules (gnucash report report-system))
(use-modules (gnucash report report-system test test-extras))
@ -14,6 +18,19 @@
(define variant-alist
(list
(cons 'liability-piechart "3fe6dce77da24c66bdc8f8efdea7f9ac")
(cons 'stock-piechart "e9418ff64f2c11e5b61d1c7508d793ed")
(cons 'asset-piechart "5c7fd8a1fe9a4cd38884ff54214aa88a")
(cons 'expense-piechart "9bf1892805cb4336be6320fe48ce5446")
(cons 'income-piechart "e1bd09b8a1dd49dd85760db9d82b045c")
(cons 'cashflow-barchart "5426e4d987f6444387fe70880e5b28a0")
(cons 'category-barchart-income "44f81bee049b4b3ea908f8dac9a9474e")
(cons 'category-barchart-expense "b1f15b2052c149df93e698fe85a81ea6")
(cons 'category-barchart-asset "e9cf815f79db44bcb637d0295093ae3d")
(cons 'category-barchart-liability "faf410e8f8da481fbc09e4763da40bcc")
(cons 'daily-income "5e2d129f28d14df881c3e47e3053f604")
(cons 'daily-expense "dde49fed4ca940959ae7d01b72742530")
(cons 'price-scatterplot "1d241609fd4644caad765c95be20ff4c")
(cons 'net-worth-barchart "cbba1696c8c24744848062c7f1cf4a72")
(cons 'net-worth-linechart "d8b63264186b11e19038001558291366")
(cons 'income-expense-barchart "80769921e87943adade887b9835a7685")
@ -46,15 +63,10 @@
(list "Asset"
(list "Bank"))
(list "Income" (list (cons 'type ACCT-TYPE-INCOME)))
(list "Liability" (list (cons 'type ACCT-TYPE-LIABILITY)))
(list "Expenses" (list (cons 'type ACCT-TYPE-EXPENSE)))
(list "Equity" (list (cons 'type ACCT-TYPE-EQUITY)))))
(define (set-option! options section name value)
(let ((option (gnc:lookup-option options section name)))
(if option
(gnc:option-set-value option value)
(test-assert (format #f "wrong-option ~a ~a" section name) #f))))
(define (null-test variant)
;; This null-test tests for the presence of report.
(let* ((uuid (variant->uuid variant))
@ -62,16 +74,17 @@
(test-assert (format #f "null-test: ~a" variant)
(options->render uuid options "null-test"))))
;; the following tests are not ready yet
;; unfortunately sxml parsing requires a very valid xhtml, which means
;; <script>
(define (net-charts-test variant)
(define (set-option! options section name value)
(let ((option (gnc:lookup-option options section name)))
(if option
(gnc:option-set-value option value)
(test-assert (format #f "[~a] wrong-option ~a ~a" variant section name) #f))))
(let* ((uuid (variant->uuid variant))
(env (create-test-env))
(account-alist (env-create-account-structure-alist env structure))
(bank (cdr (assoc "Bank" account-alist)))
(liability (cdr (assoc "Liability" account-alist)))
(income (cdr (assoc "Income" account-alist)))
(expense (cdr (assoc "Expenses" account-alist)))
(equity (cdr (assoc "Equity" account-alist)))
@ -79,22 +92,43 @@
(define (default-testing-options)
(let ((options (gnc:make-report-options (variant->uuid variant))))
(set-option! options "Accounts" "Accounts" (list bank))
(set-option! options "General" "Start Date" (cons 'relative 'start-cal-year))
(set-option! options "General" "End Date" (cons 'relative 'end-cal-year))
(unless (memq variant '(liability-piechart asset-piechart stock-piechart))
(set-option! options "General" "Start Date" '(relative . start-cal-year)))
(set-option! options "General" "End Date" '(relative . end-cal-year))
(unless (eq? variant 'price-scatterplot)
(set-option! options "Accounts" "Accounts" (list bank liability)))
options))
(env-transfer env 01 01 YEAR bank expense 5 #:description "desc-1" #:num "trn1" #:memo "memo-3")
(env-transfer env 21 02 YEAR income bank 10 #:description "desc-2" #:num "trn2" #:void-reason "void" #:notes "notes3")
(env-transfer env 11 02 YEAR income bank 29 #:description "desc-3" #:num "trn3"
#:reconcile (cons #\c (gnc-dmy2time64 01 03 YEAR)))
(env-transfer env 01 02 YEAR bank expense 15 #:description "desc-4" #:num "trn4" #:notes "notes2" #:memo "memo-1")
(env-transfer env 10 03 YEAR bank expense 10 #:description "desc-5" #:num "trn5" #:void-reason "any")
(env-transfer env 10 03 YEAR expense bank 11 #:description "desc-6" #:num "trn6" #:notes "notes1")
(env-transfer env 10 04 YEAR income bank 8 #:description "desc-7" #:num "trn7" #:notes "notes1" #:memo "memo-2"
#:reconcile (cons #\y (gnc-dmy2time64 01 03 YEAR)))
(env-transfer env 01 01 YEAR equity bank 3)
(env-transfer env 11 01 YEAR bank expense 8)
(env-transfer env 11 02 YEAR income bank 29)
(env-transfer env 21 02 YEAR income bank 10 #:void-reason "void")
(env-transfer env 22 02 YEAR liability expense 27)
(env-transfer env 01 03 YEAR bank expense 15)
(env-transfer env 10 05 YEAR bank expense 10 #:void-reason "any")
(env-transfer env 10 07 YEAR expense bank 11)
(env-transfer env 10 09 YEAR income bank 8)
(let* ((options (default-testing-options)))
(test-assert (format #f "basic report exists: ~a" variant)
(options->render uuid options (format #f "net-charts-test ~a default options" variant))))))
(options->render uuid options (format #f "net-charts-test ~a default options" variant))))
(case variant
((liability-piechart stock-piechart asset-piechart expense-piechart income-piechart)
'piechart-tests)
((cashflow-barchart)
'cashflow-barchart-test)
((category-barchart-income category-barchart-expense category-barchart-asset category-barchart-liability)
'category-barchart-tests)
((daily-income daily-expense)
'daily-tests)
((net-worth-barchart income-expense-barchart net-worth-linechart income-expense-linechart)
'net-charts-tests))))

292
gnucash/report/standard-reports/test/test-generic-category-report.scm
View File

@ -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)))))))

366
gnucash/report/standard-reports/test/test-generic-net-barchart.scm
View File

@ -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))
))))))

225
gnucash/report/standard-reports/test/test-generic-net-linechart.scm
View File

@ -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)))))))))

265
gnucash/report/standard-reports/test/test-standard-category-report.scm
View File

@ -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)))))))

342
gnucash/report/standard-reports/test/test-standard-net-barchart.scm
View File

@ -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))
))))))

210
gnucash/report/standard-reports/test/test-standard-net-linechart.scm
View File

@ -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)))))))))

13
gnucash/report/standard-reports/test/test-transaction.scm
View File

@ -566,12 +566,6 @@
(set-option! options "Display" "Other Account Name" #t)
(set-option! options "Display" "Other Account Code" #t)
(let* ((sxml (options->sxml options "dual column")))
;; Note. It's difficult to test converted monetary
;; amounts. Although I've set transfers from USD/GBP, the
;; transfers do not update the pricedb automatically,
;; therefore converted amounts are displayed as $0. We are not
;; testing the pricedb so it does not seem fair to test its
;; output here too.
(test-equal "dual amount headers"
(list "Date" "Num" "Description" "Memo/Notes" "Account" "Transfer from/to"
"Debit (USD)" "Credit (USD)" "Debit" "Credit")
@ -585,12 +579,15 @@
(test-equal "GBP original currency totals = #4"
(list 4.0)
(map str->num (get-row-col sxml 5 10)))
(test-assert "USD original currency totals = $5"
(test-assert "USD original currency totals = $5 (tests pricedb)"
(equal?
(list 5.0)
(map str->num (get-row-col sxml 4 8))
(map str->num (get-row-col sxml 9 7))
(map str->num (get-row-col sxml 9 9))))
)
(test-equal "USD grand totals are correct (tests pricedb)"
(list "Grand Total" "$0.00" "$5.00")
(get-row-col sxml 11 #f)))
;; This test group will test sign reversal strategy. We will
;; display all transactions in the 1969-1970 series, sorted by

20
libgnucash/engine/test/test-extras.scm
View File

@ -140,6 +140,22 @@
;(format #t "tx ~a\n" (map xaccSplitGetValue (list split-1 split-2)))
txn))
(define (gnc-pricedb-create currency commodity time64 value)
;; I think adding pricedb for a DMY date will clobber any existing
;; pricedb entry for that date.
(let ((price (gnc-price-create (gnc-get-current-book)))
(pricedb (gnc-pricedb-get-db (gnc-get-current-book))))
(gnc-price-begin-edit price)
(gnc-price-set-commodity price commodity)
(gnc-price-set-currency price currency)
(gnc-price-set-time64 price time64)
(gnc-price-set-source price PRICE-SOURCE-XFER-DLG-VAL)
(gnc-price-set-source-string price "test-price")
(gnc-price-set-typestr price "test")
(gnc-price-set-value price value)
(gnc-price-commit-edit price)
(gnc-pricedb-add-price pricedb price)))
(define* (env-transfer-foreign
env
DD MM YY ; day/month/year
@ -186,6 +202,10 @@
(begin
(xaccSplitSetMemo split-1 memo)
(xaccSplitSetMemo split-2 memo)))
(gnc-pricedb-create (xaccAccountGetCommodity debit)
(xaccAccountGetCommodity credit)
(gnc-dmy2time64 DD MM YY)
(/ amount1 amount2))
(xaccTransCommitEdit txn)
txn))