Add test suite for standard tests

Author:    Peter Broadbery <p.broadbery@gmail.com>

git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@23026 57a11ea4-9604-0410-9ed3-97b8803252fd

src/report/standard-reports/test/Makefile.am

@@ -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 @@ GNC_TEST_DEPS = --gnc-module-dir ${top_builddir}/src/engine \
   --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 @@ TESTS_ENVIRONMENT = \
   $(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}
+
+

src/report/standard-reports/test/test-generic-category-report.scm

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