r23026 - gnucash/trunk/src/report/standard-reports/test - Add test suite for standard tests
Geert Janssens
gjanssens at code.gnucash.org
Sun Jun 2 06:32:39 EDT 2013
Author: gjanssens
Date: 2013-06-02 06:32:39 -0400 (Sun, 02 Jun 2013)
New Revision: 23026
Trac: http://svn.gnucash.org/trac/changeset/23026
Added:
gnucash/trunk/src/report/standard-reports/test/test-generic-category-report.scm
gnucash/trunk/src/report/standard-reports/test/test-generic-net-barchart.scm
gnucash/trunk/src/report/standard-reports/test/test-generic-net-linechart.scm
gnucash/trunk/src/report/standard-reports/test/test-standard-category-report.scm
gnucash/trunk/src/report/standard-reports/test/test-standard-net-barchart.scm
gnucash/trunk/src/report/standard-reports/test/test-standard-net-linechart.scm
Modified:
gnucash/trunk/src/report/standard-reports/test/Makefile.am
Log:
Add test suite for standard tests
Author: Peter Broadbery <p.broadbery at gmail.com>
Modified: gnucash/trunk/src/report/standard-reports/test/Makefile.am
===================================================================
--- gnucash/trunk/src/report/standard-reports/test/Makefile.am 2013-06-02 10:32:18 UTC (rev 23025)
+++ gnucash/trunk/src/report/standard-reports/test/Makefile.am 2013-06-02 10:32:39 UTC (rev 23026)
@@ -1,11 +1,15 @@
-TESTS=test-load-module
+MODULE_TESTS=test-load-module
-GNC_TEST_DEPS = --gnc-module-dir ${top_builddir}/src/engine \
+GNC_TEST_DEPS = \
+ --gnc-module-dir ${top_builddir}/src/engine \
--gnc-module-dir ${top_builddir}/src/app-utils \
--gnc-module-dir ${top_builddir}/src/gnome-utils \
--gnc-module-dir ${top_builddir}/src/html \
+ --gnc-module-dir ${top_builddir}/src/report/app-utils \
--gnc-module-dir ${top_builddir}/src/report/report-system \
+ --gnc-module-dir ${top_builddir}/src/report/report-system/test \
--gnc-module-dir ${top_builddir}/src/report/standard-reports \
+ --gnc-module-dir ${top_builddir}/src/report/standard-reports/test \
\
--guile-load-dir ${top_builddir}/src/gnc-module \
--guile-load-dir ${top_builddir}/src/scm \
@@ -14,7 +18,9 @@
--guile-load-dir ${top_builddir}/src/app-utils \
--guile-load-dir ${top_builddir}/src/gnome-utils \
--guile-load-dir ${top_builddir}/src/report/report-system \
+ --guile-load-dir ${top_builddir}/src/report/report-system/test \
--guile-load-dir ${top_builddir}/src/report/standard-reports \
+ --guile-load-dir ${top_builddir}/src/report/standard-reports/test \
\
--library-dir ${top_builddir}/src/libqof/qof \
--library-dir ${top_builddir}/src/core-utils \
@@ -32,3 +38,52 @@
$(shell ${top_srcdir}/src/gnc-test-env --no-exports ${GNC_TEST_DEPS})
EXTRA_DIST = test-load-module
+
+SCM_TESTS = \
+ test-standard-category-report.scm \
+ test-standard-net-barchart.scm \
+ test-standard-net-linechart.scm
+
+if GNUCASH_SEPARATE_BUILDDIR
+#For executing test cases
+SCM_FILE_LINKS = \
+ test-generic-category-report.scm \
+ test-generic-net-barchart.scm \
+ test-generic-net-linechart.scm \
+ $(SCM_TESTS)
+endif
+
+.scm-links:
+ $(RM) -rf gnucash
+ mkdir -p gnucash/report/standard-reports/test
+if GNUCASH_SEPARATE_BUILDDIR
+ for X in ${SCM_FILE_LINKS} ; do \
+ $(LN_S) -f ${srcdir}/$$X . ; \
+ done
+endif
+ ( cd gnucash/report/standard-reports/test; for A in $(SCM_FILE_LINKS) ; do $(LN_S) -f ../../../../$$A . ; done )
+if ! OS_WIN32
+# Windows knows no "ln -s" but uses "cp": must copy every time (see bug #566567).
+ touch .scm-links
+endif
+
+$(patsubst %.scm,%,$(SCM_TESTS)): %: Makefile .scm-links
+ echo 'guile --debug -l $(srcdir)/$*.scm -c "(exit (run-test))"' > $@
+ chmod a+x $@
+
+interp:
+ $(TESTS_ENVIRONMENT) guile --debug
+
+debug:
+ $(TESTS_ENVIRONMENT) gdb --args $(shell cat $(TEST))
+
+TESTS = $(patsubst %.scm,%,$(SCM_TESTS)) $(MODULE_TESTS)
+
+clean-local:
+ $(RM) -rf gnucash
+
+noinst_DATA = .scm-links
+CLEANFILES = .scm-links
+DISTCLEANFILES = ${SCM_FILE_LINKS}
+
+
Added: gnucash/trunk/src/report/standard-reports/test/test-generic-category-report.scm
===================================================================
--- gnucash/trunk/src/report/standard-reports/test/test-generic-category-report.scm (rev 0)
+++ gnucash/trunk/src/report/standard-reports/test/test-generic-category-report.scm 2013-06-02 10:32:39 UTC (rev 23026)
@@ -0,0 +1,243 @@
+(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 main)) ;; FIXME: delete after we finish modularizing.
+(use-modules (gnucash printf))
+(use-modules (gnucash report report-system))
+(use-modules (gnucash app-utils))
+(use-modules (gnucash engine))
+(use-modules (sw_engine))
+
+(use-modules (gnucash report report-system streamers))
+(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)
+ #t))
+
+(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))
+ )))
+
+
+(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)
+
+ (gnc:options-for-each (lambda (option)
+ (format #t "Option: ~a.~a Value ~a\n"
+ (gnc:option-section option)
+ (gnc:option-name option)
+ (gnc:option-value option)))
+ income-options)
+
+ (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 "<string> ([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>" 1 2 3)
+ (list "<number> ([^<]*)</td>" 1))
+ result))))
+ (every (lambda (date value-list)
+ (let ((day (second date))
+ (value (first value-list)))
+ (format #t "[~a] [~a]\n"
+ (string->number day) (string->number value))
+ (= (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)))))
+ (format #t "Expense accounts ~a\n" leaf-expense-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 "<string> ([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>" 1 2 3)
+ (list "<number> ([^<]*)</td>" 1)
+ (list "<number> ([^<]*)</td>" 1)
+ (list "<number> ([^<]*)</td>" 1)
+ (list "<number> ([^<]*)</td>" 1)
+ (list "<number> ([^<]*)</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 "<string> ([^<]*)</" 1))
+ doc))))
+ (format #t "Columns ~a\n" columns)
+ (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)
+
+ (gnc:options-for-each (lambda (option)
+ (format #t "Option: ~a.~a Value ~a\n"
+ (gnc:option-section option)
+ (gnc:option-name option)
+ (gnc:option-value option)))
+ asset-options)
+
+
+ (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 "<string> ([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>" 1 2 3)
+ (list "<number> ([^<]*)</td>" 1))
+ html-document)))
+ (row-count (tbl-row-count tbl)))
+ (format #t "Report: ~a\n" tbl)
+ (logging-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)))))))
+
Added: gnucash/trunk/src/report/standard-reports/test/test-generic-net-barchart.scm
===================================================================
--- gnucash/trunk/src/report/standard-reports/test/test-generic-net-barchart.scm (rev 0)
+++ gnucash/trunk/src/report/standard-reports/test/test-generic-net-barchart.scm 2013-06-02 10:32:39 UTC (rev 23026)
@@ -0,0 +1,266 @@
+(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 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)
+ (logging-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)
+
+ #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))
+ )))
+
+(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
+ (gnc:make-gnc-numeric -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 "<string> ([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
+ 1 2 3)
+ (list "<number> ([^<]*)</td>" 1)
+ (list "<number> ([^<]*)</td>" 1)
+ (list "<number> ([^<]*)</td>" 1))
+ result))))
+ (format #t "~a\n" tbl)
+ (logging-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:timepair-next-day date-0))
+ (date-2 (gnc:timepair-next-day date-1)))
+ (env-create-transaction env
+ date-1
+ my-income-account
+ my-asset-account
+ (gnc:make-gnc-numeric -1 1))
+ (env-create-transaction env
+ date-2
+ my-income-account
+ my-asset-account
+ (gnc:make-gnc-numeric -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 "<string> ([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
+ 1 2 3)
+ (list "<number> ([^<]*)</td>" 1)
+ (list "<number> ([^<]*)</td>" 1)
+ (list "<number> ([^<]*)</td>" 1))
+ result))))
+ (format #t "~a\n~a\n" result tbl)
+ (logging-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:timepair-next-day date-0))
+ (date-2 (gnc:timepair-next-day date-1)))
+ (env-create-transaction env date-1 my-income-account my-asset-account (gnc:make-gnc-numeric -1 1))
+ (env-create-transaction env date-1 my-expense-account my-liability-account (gnc:make-gnc-numeric -1 1))
+ (env-create-transaction env date-2 my-income-account my-asset-account (gnc:make-gnc-numeric -5 1))
+ (env-create-transaction env date-2 my-expense-account my-liability-account (gnc:make-gnc-numeric -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 "<string> ([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
+ 1 2 3)
+ (list "<number> ([^<]*)</td>" 1)
+ (list "<number> ([^<]*)</td>" 1)
+ (list "<number> ([^<]*)</td>" 1))
+ result))))
+ (format #t "~a\n" tbl)
+ (logging-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)))))))))
+
+(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:timepair-next-day date-0))
+ (date-2 (gnc:timepair-next-day date-1)))
+ (env-create-transaction env date-1 my-income-account my-asset-account (gnc:make-gnc-numeric -1 1))
+ (env-create-transaction env date-1 my-expense-account my-liability-account (gnc:make-gnc-numeric -1 1))
+ (env-create-transaction env date-2 my-income-account my-asset-account (gnc:make-gnc-numeric -5 1))
+ (env-create-transaction env date-2 my-expense-account my-liability-account (gnc:make-gnc-numeric -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 "<string> ([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
+ 1 2 3)
+ (list "<number> ([^<]*)</td>" 1)
+ (list "<number> ([^<]*)</td>" 1)
+ (list "<number> ([^<]*)</td>" 1))
+ result))))
+ (format #t "~a\n" tbl)
+ (logging-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)))))))))
Added: gnucash/trunk/src/report/standard-reports/test/test-generic-net-linechart.scm
===================================================================
--- gnucash/trunk/src/report/standard-reports/test/test-generic-net-linechart.scm (rev 0)
+++ gnucash/trunk/src/report/standard-reports/test/test-generic-net-linechart.scm 2013-06-02 10:32:39 UTC (rev 23026)
@@ -0,0 +1,208 @@
+(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 report-system 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)
+ (logging-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)
+
+ #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))
+ )))
+
+(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
+ (gnc:make-gnc-numeric -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 "<string> ([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
+ 1 2 3)
+ (list "<number> ([^<]*)</td>" 1)
+ (list "<number> ([^<]*)</td>" 1)
+ (list "<number> ([^<]*)</td>" 1))
+ result))))
+ (format #t "~a\n" tbl)
+ (logging-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:timepair-next-day date-0))
+ (date-2 (gnc:timepair-next-day date-1)))
+ (env-create-transaction env
+ date-1
+ my-income-account
+ my-asset-account
+ (gnc:make-gnc-numeric -1 1))
+ (env-create-transaction env
+ date-2
+ my-income-account
+ my-asset-account
+ (gnc:make-gnc-numeric -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 "<string> ([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
+ 1 2 3)
+ (list "<number> ([^<]*)</td>" 1)
+ (list "<number> ([^<]*)</td>" 1)
+ (list "<number> ([^<]*)</td>" 1))
+ result))))
+ (format #t "~a\n~a\n" result tbl)
+ (logging-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:timepair-next-day date-0))
+ (date-2 (gnc:timepair-next-day date-1)))
+ (env-create-transaction env date-1 my-income-account my-asset-account (gnc:make-gnc-numeric -1 1))
+ (env-create-transaction env date-1 my-expense-account my-liability-account (gnc:make-gnc-numeric -1 1))
+ (env-create-transaction env date-2 my-income-account my-asset-account (gnc:make-gnc-numeric -5 1))
+ (env-create-transaction env date-2 my-expense-account my-liability-account (gnc:make-gnc-numeric -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 "<string> ([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
+ 1 2 3)
+ (list "<number> ([^<]*)</td>" 1)
+ (list "<number> ([^<]*)</td>" 1)
+ (list "<number> ([^<]*)</td>" 1))
+ result))))
+ (format #t "~a\n" tbl)
+ (logging-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)))))))))
+
Added: gnucash/trunk/src/report/standard-reports/test/test-standard-category-report.scm
===================================================================
--- gnucash/trunk/src/report/standard-reports/test/test-standard-category-report.scm (rev 0)
+++ gnucash/trunk/src/report/standard-reports/test/test-standard-category-report.scm 2013-06-02 10:32:39 UTC (rev 23026)
@@ -0,0 +1,26 @@
+(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 main)) ;; FIXME: delete after we finish modularizing.
+(use-modules (gnucash printf))
+(use-modules (gnucash report report-system))
+(use-modules (gnucash app-utils))
+(use-modules (gnucash engine))
+(use-modules (sw_engine))
+(use-modules (gnucash report standard-reports net-barchart))
+
+(use-modules (gnucash report report-system streamers))
+;(use-modules (gnucash report new-reports reports-2))
+
+(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))
+
+(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))
Added: gnucash/trunk/src/report/standard-reports/test/test-standard-net-barchart.scm
===================================================================
--- gnucash/trunk/src/report/standard-reports/test/test-standard-net-barchart.scm (rev 0)
+++ gnucash/trunk/src/report/standard-reports/test/test-standard-net-barchart.scm 2013-06-02 10:32:39 UTC (rev 23026)
@@ -0,0 +1,15 @@
+;(use-modules (gnucash report new-reports reports-2))
+
+(use-modules (gnucash gnc-module))
+(gnc:module-load "gnucash/report/report-system" 0)
+(use-modules (gnucash engine))
+(use-modules (sw_engine))
+
+(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-barchart))
+
+(define (run-test)
+ (run-net-asset-income-test net-worth-barchart-uuid income-expense-barchart-uuid))
+
Added: gnucash/trunk/src/report/standard-reports/test/test-standard-net-linechart.scm
===================================================================
--- gnucash/trunk/src/report/standard-reports/test/test-standard-net-linechart.scm (rev 0)
+++ gnucash/trunk/src/report/standard-reports/test/test-standard-net-linechart.scm 2013-06-02 10:32:39 UTC (rev 23026)
@@ -0,0 +1,15 @@
+;(use-modules (gnucash report new-reports reports-2))
+
+(use-modules (gnucash gnc-module))
+(gnc:module-load "gnucash/report/report-system" 0)
+(use-modules (gnucash engine))
+(use-modules (sw_engine))
+
+(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-linechart))
+
+(define (run-test)
+ (run-net-asset-test net-worth-linechart-uuid))
+
More information about the gnucash-changes
mailing list