From b071022dee7e8ac6a78c8cee114d61e85113cd99 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Fri, 28 Dec 2018 11:06:21 +0800 Subject: [PATCH] [test-cashflow-barchart] upgrade to srfi-64 and sxml --- .../standard-reports/test/CMakeLists.txt | 2 +- .../test/test-cashflow-barchart.scm | 379 +++++++----------- 2 files changed, 143 insertions(+), 238 deletions(-) diff --git a/gnucash/report/standard-reports/test/CMakeLists.txt b/gnucash/report/standard-reports/test/CMakeLists.txt index a3f6e73b34..d9bf7673a4 100644 --- a/gnucash/report/standard-reports/test/CMakeLists.txt +++ b/gnucash/report/standard-reports/test/CMakeLists.txt @@ -1,12 +1,12 @@ set(scm_test_standard_reports_SOURCES test-cash-flow.scm - test-cashflow-barchart.scm ) set(scm_test_with_srfi64_SOURCES test-standard-category-report.scm test-standard-net-linechart.scm test-standard-net-barchart.scm + test-cashflow-barchart.scm test-charts.scm test-transaction.scm test-balsheet-pnl.scm diff --git a/gnucash/report/standard-reports/test/test-cashflow-barchart.scm b/gnucash/report/standard-reports/test/test-cashflow-barchart.scm index ecb349393d..6c251b2123 100644 --- a/gnucash/report/standard-reports/test/test-cashflow-barchart.scm +++ b/gnucash/report/standard-reports/test/test-cashflow-barchart.scm @@ -24,33 +24,34 @@ (use-modules (gnucash engine)) (use-modules (sw_engine)) - (use-modules (gnucash engine test test-extras)) +(use-modules (gnucash engine test srfi64-extras)) (use-modules (gnucash report report-system)) (use-modules (gnucash report report-system test test-extras)) (use-modules (gnucash report standard-reports cashflow-barchart)) (use-modules (gnucash report stylesheets)) - -(use-modules (ice-9 format)) -(use-modules (ice-9 streams)) (use-modules (srfi srfi-1)) +(use-modules (srfi srfi-64)) ;; Explicitly set locale to make the report output predictable (setlocale LC_ALL "C") (define (run-test) - (and (test-in-txn) - (test-out-txn) - (test-null-txn))) - - -(define (set-option report page tag value) - ((gnc:option-setter (gnc:lookup-option (gnc:report-options report) - page tag)) value)) - - -(define constructor (record-constructor )) - + (test-runner-factory gnc:test-runner) + (test-in-txn) + (test-out-txn) + (test-null-txn)) + +(define (set-option options page tag value) + ((gnc:option-setter (gnc:lookup-option options page tag)) value)) + +(define (str->num str) + (string->number + (string-filter + (lambda (c) + (or (char-numeric? c) + (memv c '(#\- #\.)))) + str))) (define structure (list "Root" (list (cons 'type ACCT-TYPE-ASSET)) @@ -60,234 +61,138 @@ (list "Expenses" (list (cons 'type ACCT-TYPE-EXPENSE))) (list "Income" (list (cons 'type ACCT-TYPE-INCOME))))) - ;; Test two transactions from income to two different assets in two different days (define (test-in-txn) - (let* ((template (gnc:find-report-template cashflow-barchart-uuid)) - (options (gnc:make-report-options cashflow-barchart-uuid)) - (report (constructor cashflow-barchart-uuid "bar" options - #t #t #f #f "")) - (renderer (gnc:report-template-renderer template))) - (let* ((env (create-test-env)) - (account-alist (env-create-account-structure-alist env structure)) - (bank-account (cdr (assoc "Bank" account-alist))) - (wallet-account (cdr (assoc "Wallet" account-alist))) - (expense-account (cdr (assoc "Expenses" account-alist))) - (income-account (cdr (assoc "Income" account-alist))) - (date-0 (gnc:get-start-this-month)) - (date-1 (gnc:time64-next-day date-0)) - (date-2 (gnc:time64-next-day date-1))) - (env-create-transaction env - date-1 - bank-account - income-account - 1/1) - (env-create-transaction env - date-2 - wallet-account - income-account - 5/1) - (begin - (set-option report gnc:pagename-display "Show Table" #t) - (set-option report gnc:pagename-general "Start Date" (cons 'absolute date-0)) - (set-option report gnc:pagename-general "End Date" (cons 'absolute date-2)) - (set-option report gnc:pagename-general "Step Size" 'DayDelta) - (set-option report gnc:pagename-general "Price Source" 'pricedb-nearest) - (set-option report gnc:pagename-general "Report's currency" (gnc-default-report-currency)) - (set-option report gnc:pagename-accounts "Accounts" (list wallet-account bank-account)) - ;; (format #t "Create first transaction on ~a~%" (gnc-ctime date-1)) - ;; (format #t "Create second transaction on ~a~%" (gnc-ctime date-2)) - (let ((doc (renderer report))) - (gnc:html-document-set-style-sheet! doc (gnc:report-stylesheet report)) - (let* ((result (gnc:html-document-render doc #f)) - (tbl (stream->list - (pattern-streamer "" - (list (list "([0-9]+)/([0-9]+)/([0-9]+)" - 1 2 3) - (list "[^0-9]*([^<]*)" 1) - (list "[^0-9]*([^<]*)" 1) - (list "[^0-9]*([^<]*)" 1)) - result))) - (total (stream->list - (pattern-streamer "Total" - (list (list "[^0-9]*([^<]*)" 1) - (list "[^0-9]*([^<]*)" 1) - (list "[^0-9]*([^<]*)" 1)) - result)))) - ;; (format #t "Report Result ~a~%" result) - (and (every (lambda (row) ; test in=net & out=0 in all rows (all days) - (and (or (equal? (second row) (fourth row)) - (begin (format #t "Failed, ~a and ~a differ~%" (second row) (fourth row)) #f)) - (or (= 0 (string->number (car (third row)))) - (begin (format #t "Failed ~d isn't 0~%" (car (third row))) #f)))) - tbl) - (or (= 0 (tbl-ref->number tbl 0 1)) - (begin (format #t "Failed refnum ~g isn't 0~%" (tbl-ref->number tbl 0 1)) #f)) ; 1st day in =0 - (or (= 1 (tbl-ref->number tbl 1 1)) (begin (format #t "Failed refnum ~g isn't 1~%" (tbl-ref->number tbl 1 1)) #f)) ; 2nd day in =1 - (or (= 5 (tbl-ref->number tbl 2 1)) (begin (format #t "Failed refnum ~g isn't 5~%" (tbl-ref->number tbl 2 1)) #f)) ; 3rd day in =5 - (or (= (tbl-ref->number total 0 0) (tbl-ref->number total 0 2)) (begin (format #t "Failed refnums ~g and ~g differ ~%" (tbl-ref->number total 0 0) (tbl-ref->number total 0 2)) #f)); total in=total net - (or (= 0 (tbl-ref->number total 0 1)) (begin (format #t "Failed refnum ~g isn't 0~%" (tbl-ref->number total 0 1)) #f)) ; total out=0 - (or (= 3 (tbl-row-count tbl)) (begin (format #t "Failed row count ~g isn't 3~%" (tbl-row-count tbl)) #f)) - (or (= 4 (tbl-column-count tbl)) (begin (format #t "Failed column count ~g isn't 4~%" (tbl-column-count tbl)) #f)))) - ) - ) - ) - ) -) + (let* ((options (gnc:make-report-options cashflow-barchart-uuid)) + (env (create-test-env)) + (account-alist (env-create-account-structure-alist env structure)) + (bank-account (cdr (assoc "Bank" account-alist))) + (wallet-account (cdr (assoc "Wallet" account-alist))) + (expense-account (cdr (assoc "Expenses" account-alist))) + (income-account (cdr (assoc "Income" account-alist))) + (date-0 (gnc:get-start-this-month)) + (date-1 (gnc:time64-next-day date-0)) + (date-2 (gnc:time64-next-day date-1))) + (env-create-transaction env date-1 bank-account income-account 1) + (env-create-transaction env date-2 wallet-account income-account 5) + (set-option options gnc:pagename-display "Show Table" #t) + (set-option options gnc:pagename-general "Start Date" (cons 'absolute date-0)) + (set-option options gnc:pagename-general "End Date" (cons 'absolute date-2)) + (set-option options gnc:pagename-general "Step Size" 'DayDelta) + (set-option options gnc:pagename-general "Price Source" 'pricedb-nearest) + (set-option options gnc:pagename-general "Report's currency" (gnc-default-report-currency)) + (set-option options gnc:pagename-accounts "Accounts" (list wallet-account bank-account)) + + (let ((sxml (gnc:options->sxml cashflow-barchart-uuid options "test-cashflow-barchart" + "test-in-txn" #:strip-tag "script"))) + (test-begin "test-in-txn") + (test-assert "in = net, out=0" + (every (lambda (in out net) + (and (= in net) (zero? out))) + (map str->num (sxml->table-row-col sxml 1 #f 2)) + (map str->num (sxml->table-row-col sxml 1 #f 3)) + (map str->num (sxml->table-row-col sxml 1 #f 4)))) + (test-equal "day in" + '(0.0 1.0 5.0 6.0) + (map str->num (sxml->table-row-col sxml 1 #f 2))) + (test-equal "4 columns" + 4 + (length (sxml->table-row-col sxml 1 1 #f))) + (test-equal "4 rows" + 4 + (length (sxml->table-row-col sxml 1 #f 1))) + (test-end "test-in-txn")))) ;; Test two transactions from two different assets to expense in two different days (define (test-out-txn) - (let* ((template (gnc:find-report-template cashflow-barchart-uuid)) - (options (gnc:make-report-options cashflow-barchart-uuid)) - (report (constructor cashflow-barchart-uuid "bar" options - #t #t #f #f "")) - (renderer (gnc:report-template-renderer template))) - (let* ((env (create-test-env)) - (account-alist (env-create-account-structure-alist env structure)) - (bank-account (cdr (assoc "Bank" account-alist))) - (wallet-account (cdr (assoc "Wallet" account-alist))) - (expense-account (cdr (assoc "Expenses" account-alist))) - (income-account (cdr (assoc "Income" account-alist))) - (date-0 (gnc:get-start-this-month)) - (date-1 (gnc:time64-next-day date-0)) - (date-2 (gnc:time64-next-day date-1))) - (env-create-transaction env - date-1 - bank-account - income-account - 100/1) ; large in txn to avoid negative net (hard to parse) - (env-create-transaction env - date-1 - expense-account - bank-account - 1/1) - (env-create-transaction env - date-2 - wallet-account - income-account - 100/1) ; large in txn to avoid negative net (hard to parse) - (env-create-transaction env - date-2 - expense-account - wallet-account - 5/1) - (begin - (set-option report gnc:pagename-display "Show Table" #t) - (set-option report gnc:pagename-general "Start Date" (cons 'absolute date-0)) - (set-option report gnc:pagename-general "End Date" (cons 'absolute date-2)) - (set-option report gnc:pagename-general "Step Size" 'DayDelta) - (set-option report gnc:pagename-general "Price Source" 'pricedb-nearest) - (set-option report gnc:pagename-general "Report's currency" (gnc-default-report-currency)) - (set-option report gnc:pagename-accounts "Accounts" (list wallet-account bank-account)) - - (let ((doc (renderer report))) - (gnc:html-document-set-style-sheet! doc (gnc:report-stylesheet report)) - (let* ((result (gnc:html-document-render doc #f)) - (tbl (stream->list - (pattern-streamer "" - (list (list "([0-9]+)/([0-9]+)/([0-9]+)" - 1 2 3) - (list "[^0-9]*([^<]*)" 1) - (list "[^0-9]*([^<]*)" 1) - (list "[^0-9]*([^<]*)" 1)) - result))) - (total (stream->list - (pattern-streamer "Total" - (list (list "[^0-9]*([^<]*)" 1) - (list "[^0-9]*([^<]*)" 1) - (list "[^0-9]*([^<]*)" 1)) - result)))) - (and (every (lambda (row) ; test in-out=net in all rows (all days) - (let ((in (string->number (car (second row)))) - (out (string->number (car (third row)))) - (net (string->number (car (fourth row))))) - (= (- in out) net))) - tbl) - (= 0 (tbl-ref->number tbl 0 2)) ; 1st day out =0 - (= 1 (tbl-ref->number tbl 1 2)) ; 2nd day out =1 - (= 5 (tbl-ref->number tbl 2 2)) ; 3rd day out =5 - (= (- (tbl-ref->number total 0 0) (tbl-ref->number total 0 1)) ; total in-total out=total net - (tbl-ref->number total 0 2)) - (= 6 (tbl-ref->number total 0 1)) ; total out=6 - (= 3 (tbl-row-count tbl)) - (= 4 (tbl-column-count tbl))))) - ) - ) - ) - ) + (let* ((options (gnc:make-report-options cashflow-barchart-uuid)) + (env (create-test-env)) + (account-alist (env-create-account-structure-alist env structure)) + (bank-account (cdr (assoc "Bank" account-alist))) + (wallet-account (cdr (assoc "Wallet" account-alist))) + (expense-account (cdr (assoc "Expenses" account-alist))) + (income-account (cdr (assoc "Income" account-alist))) + (date-0 (gnc:get-start-this-month)) + (date-1 (gnc:time64-next-day date-0)) + (date-2 (gnc:time64-next-day date-1))) + ;; large in txn to avoid negative net (hard to parse): + (env-create-transaction env date-1 bank-account income-account 100) + (env-create-transaction env date-1 expense-account bank-account 1) + ;; large in txn to avoid negative net (hard to parse): + (env-create-transaction env date-2 wallet-account income-account 100) + (env-create-transaction env date-2 expense-account wallet-account 5) + + (set-option options gnc:pagename-display "Show Table" #t) + (set-option options gnc:pagename-general "Start Date" (cons 'absolute date-0)) + (set-option options gnc:pagename-general "End Date" (cons 'absolute date-2)) + (set-option options gnc:pagename-general "Step Size" 'DayDelta) + (set-option options gnc:pagename-general "Price Source" 'pricedb-nearest) + (set-option options gnc:pagename-general "Report's currency" (gnc-default-report-currency)) + (set-option options gnc:pagename-accounts "Accounts" (list wallet-account bank-account)) + + (let ((sxml (gnc:options->sxml cashflow-barchart-uuid options "test-cashflow-barchart" + "test-out-txn" #:strip-tag "script"))) + (test-begin "test-out-txn") + (test-assert "in - out = net" + (every (lambda (in out net) + (= (- in out) net)) + (map str->num (sxml->table-row-col sxml 1 #f 2)) + (map str->num (sxml->table-row-col sxml 1 #f 3)) + (map str->num (sxml->table-row-col sxml 1 #f 4)))) + (test-equal "money out" + '(0.0 1.0 5.0 6.0) + (map str->num (sxml->table-row-col sxml 1 #f 3))) + (test-equal "4 columns" + 4 + (length (sxml->table-row-col sxml 1 1 #f))) + (test-equal "4 rows" + 4 + (length (sxml->table-row-col sxml 1 #f 1))) + (test-end "test-out-txn")))) ;; Test null transaction (transaction between assets) ;; This test is identical to test-in-txn but with an extra transaction between assets (define (test-null-txn) - (let* ((template (gnc:find-report-template cashflow-barchart-uuid)) - (options (gnc:make-report-options cashflow-barchart-uuid)) - (report (constructor cashflow-barchart-uuid "bar" options - #t #t #f #f "")) - (renderer (gnc:report-template-renderer template))) - (let* ((env (create-test-env)) - (account-alist (env-create-account-structure-alist env structure)) - (bank-account (cdr (assoc "Bank" account-alist))) - (wallet-account (cdr (assoc "Wallet" account-alist))) - (expense-account (cdr (assoc "Expenses" account-alist))) - (income-account (cdr (assoc "Income" account-alist))) - (date-0 (gnc:get-start-this-month)) - (date-1 (gnc:time64-next-day date-0)) - (date-2 (gnc:time64-next-day date-1))) - (env-create-transaction env - date-1 - bank-account - income-account - 1/1) - (env-create-transaction env - date-1 - bank-account - wallet-account - 20/1) ; this transaction should not be counted - (env-create-transaction env - date-2 - wallet-account - income-account - 5/1) - - (begin - (set-option report gnc:pagename-display "Show Table" #t) - (set-option report gnc:pagename-general "Start Date" (cons 'absolute date-0)) - (set-option report gnc:pagename-general "End Date" (cons 'absolute date-2)) - (set-option report gnc:pagename-general "Step Size" 'DayDelta) - (set-option report gnc:pagename-general "Price Source" 'pricedb-nearest) - (set-option report gnc:pagename-general "Report's currency" (gnc-default-report-currency)) - (set-option report gnc:pagename-accounts "Accounts" (list wallet-account bank-account)) - - (let ((doc (renderer report))) - (gnc:html-document-set-style-sheet! doc (gnc:report-stylesheet report)) - (let* ((result (gnc:html-document-render doc #f)) - (tbl (stream->list - (pattern-streamer "" - (list (list "([0-9]+)/([0-9]+)/([0-9]+)" - 1 2 3) - (list "[^0-9]*([^<]*)" 1) - (list "[^0-9]*([^<]*)" 1) - (list "[^0-9]*([^<]*)" 1)) - result))) - (total (stream->list - (pattern-streamer "Total" - (list (list "[^0-9]*([^<]*)" 1) - (list "[^0-9]*([^<]*)" 1) - (list "[^0-9]*([^<]*)" 1)) - result)))) - (and (every (lambda (row) ; test in=net & out=0 in all rows (all days) - (and (equal? (second row) (fourth row)) - (= 0 (string->number (car (third row)))))) - tbl) - (= 0 (tbl-ref->number tbl 0 1)) ; 1st day in =0 - (= 1 (tbl-ref->number tbl 1 1)) ; 2nd day in =1 - (= 5 (tbl-ref->number tbl 2 1)) ; 3rd day in =5 - (= (tbl-ref->number total 0 0) (tbl-ref->number total 0 2)) ; total in=total net - (= 0 (tbl-ref->number total 0 1)) ; total out=0 - (= 3 (tbl-row-count tbl)) - (= 4 (tbl-column-count tbl))))) - ) - ) - ) - ) + (let* ((options (gnc:make-report-options cashflow-barchart-uuid)) + (env (create-test-env)) + (account-alist (env-create-account-structure-alist env structure)) + (bank-account (cdr (assoc "Bank" account-alist))) + (wallet-account (cdr (assoc "Wallet" account-alist))) + (expense-account (cdr (assoc "Expenses" account-alist))) + (income-account (cdr (assoc "Income" account-alist))) + (date-0 (gnc:get-start-this-month)) + (date-1 (gnc:time64-next-day date-0)) + (date-2 (gnc:time64-next-day date-1))) + (env-create-transaction env date-1 bank-account income-account 1) + ;; the following transaction should not be counted + (env-create-transaction env date-1 bank-account wallet-account 20) + (env-create-transaction env date-2 wallet-account income-account 5) + + (set-option options gnc:pagename-display "Show Table" #t) + (set-option options gnc:pagename-general "Start Date" (cons 'absolute date-0)) + (set-option options gnc:pagename-general "End Date" (cons 'absolute date-2)) + (set-option options gnc:pagename-general "Step Size" 'DayDelta) + (set-option options gnc:pagename-general "Price Source" 'pricedb-nearest) + (set-option options gnc:pagename-general "Report's currency" (gnc-default-report-currency)) + (set-option options gnc:pagename-accounts "Accounts" (list wallet-account bank-account)) + + (let ((sxml (gnc:options->sxml cashflow-barchart-uuid options "test-cashflow-barchart" + "test-null-txn" #:strip-tag "script"))) + (test-begin "test-null-txn") + (test-assert "in = net, out=0" + (every (lambda (in out net) + (and (= in net) (zero? out))) + (map str->num (sxml->table-row-col sxml 1 #f 2)) + (map str->num (sxml->table-row-col sxml 1 #f 3)) + (map str->num (sxml->table-row-col sxml 1 #f 4)))) + (test-equal "day in" + '(0.0 1.0 5.0 6.0) + (map str->num (sxml->table-row-col sxml 1 #f 2))) + (test-equal "4 columns" + 4 + (length (sxml->table-row-col sxml 1 1 #f))) + (test-equal "4 rows" + 4 + (length (sxml->table-row-col sxml 1 #f 1))) + (test-end "test-null-txn"))))