|
|
|
|
@ -17,17 +17,15 @@
|
|
|
|
|
;; Boston, MA 02110-1301, USA gnu@gnu.org
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
|
|
|
|
(debug-set! stack 50000)
|
|
|
|
|
|
|
|
|
|
(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 (srfi srfi-64))
|
|
|
|
|
(use-modules (gnucash report stylesheets))
|
|
|
|
|
(use-modules (gnucash engine test test-extras))
|
|
|
|
|
(use-modules (gnucash engine test srfi64-extras))
|
|
|
|
|
(use-modules (gnucash report report-system test test-extras))
|
|
|
|
|
(use-modules (gnucash report standard-reports net-charts))
|
|
|
|
|
|
|
|
|
|
@ -35,336 +33,272 @@
|
|
|
|
|
(setlocale LC_ALL "C")
|
|
|
|
|
|
|
|
|
|
(define (run-test)
|
|
|
|
|
(test-runner-factory gnc:test-runner)
|
|
|
|
|
(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 (set-option options page tag value)
|
|
|
|
|
((gnc:option-setter (gnc:lookup-option options page tag)) value))
|
|
|
|
|
|
|
|
|
|
(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))
|
|
|
|
|
(null-test asset-report-uuid)
|
|
|
|
|
(null-test income-report-uuid)
|
|
|
|
|
(single-txn-test asset-report-uuid)
|
|
|
|
|
(two-txn-test asset-report-uuid)
|
|
|
|
|
(two-txn-test-2 asset-report-uuid)
|
|
|
|
|
(two-txn-test-income income-report-uuid)
|
|
|
|
|
(closing-test income-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
|
|
|
|
|
)))
|
|
|
|
|
(let* ((options (gnc:make-report-options uuid)))
|
|
|
|
|
(gnc:options->render uuid options "test-standard-net-barchart" "null-test")))
|
|
|
|
|
|
|
|
|
|
(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))
|
|
|
|
|
))))))
|
|
|
|
|
(let* ((options (gnc:make-report-options uuid))
|
|
|
|
|
(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)
|
|
|
|
|
(set-option options gnc:pagename-display "Show table" #t)
|
|
|
|
|
(set-option options gnc:pagename-general "Start Date"
|
|
|
|
|
(cons 'absolute (gnc:get-start-this-month)))
|
|
|
|
|
(set-option options gnc:pagename-general "End Date"
|
|
|
|
|
(cons 'absolute (gnc:get-start-this-month)))
|
|
|
|
|
(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 my-asset-account))
|
|
|
|
|
|
|
|
|
|
(let ((sxml (gnc:options->sxml uuid options "test-standard-net-barchart"
|
|
|
|
|
"single-txn-test" #:strip-tag "script")))
|
|
|
|
|
(test-begin "single-txn-test")
|
|
|
|
|
(test-equal "assets $1.00"
|
|
|
|
|
'("$1.00")
|
|
|
|
|
(sxml->table-row-col sxml 1 1 2))
|
|
|
|
|
(test-equal "liability $0.00"
|
|
|
|
|
'("$0.00")
|
|
|
|
|
(sxml->table-row-col sxml 1 1 3))
|
|
|
|
|
(test-equal "net $0.00"
|
|
|
|
|
'("$1.00")
|
|
|
|
|
(sxml->table-row-col sxml 1 1 4))
|
|
|
|
|
(test-equal "1 rows"
|
|
|
|
|
1
|
|
|
|
|
(length (sxml->table-row-col sxml 1 #f 1)))
|
|
|
|
|
(test-equal "4 columns"
|
|
|
|
|
4
|
|
|
|
|
(length (sxml->table-row-col sxml 1 1 #f)))
|
|
|
|
|
(test-end "single-txn-test"))))
|
|
|
|
|
|
|
|
|
|
(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* ((options (gnc:make-report-options uuid))
|
|
|
|
|
(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)
|
|
|
|
|
(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 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))
|
|
|
|
|
))))))
|
|
|
|
|
(let ((sxml (gnc:options->sxml uuid options "test-standard-net-barchart"
|
|
|
|
|
"two-txn-test" #:strip-tag "script")))
|
|
|
|
|
(test-begin "two-txn-test")
|
|
|
|
|
(test-equal "asset $0.00"
|
|
|
|
|
'("$0.00")
|
|
|
|
|
(sxml->table-row-col sxml 1 1 2))
|
|
|
|
|
(test-equal "asset $1.00"
|
|
|
|
|
'("$1.00")
|
|
|
|
|
(sxml->table-row-col sxml 1 2 2))
|
|
|
|
|
(test-equal "asset $6.00"
|
|
|
|
|
'("$6.00")
|
|
|
|
|
(sxml->table-row-col sxml 1 3 2))
|
|
|
|
|
(test-equal "4 columns"
|
|
|
|
|
4
|
|
|
|
|
(length (sxml->table-row-col sxml 1 1 #f)))
|
|
|
|
|
(test-equal "3 rows"
|
|
|
|
|
3
|
|
|
|
|
(length (sxml->table-row-col sxml 1 #f 1)))
|
|
|
|
|
(test-end "two-txn-test")
|
|
|
|
|
sxml)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(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* ((options (gnc:make-report-options uuid))
|
|
|
|
|
(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 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 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))
|
|
|
|
|
))))))
|
|
|
|
|
(let ((sxml (gnc:options->sxml uuid options "test-standard-net-barchart"
|
|
|
|
|
"two-txn-test-2" #:strip-tag "script")))
|
|
|
|
|
(test-begin "two-txn-test")
|
|
|
|
|
(test-equal "asset $0.00"
|
|
|
|
|
'("$0.00")
|
|
|
|
|
(sxml->table-row-col sxml 1 1 2))
|
|
|
|
|
(test-equal "asset $1.00"
|
|
|
|
|
'("$1.00")
|
|
|
|
|
(sxml->table-row-col sxml 1 2 2))
|
|
|
|
|
(test-equal "asset $6.00"
|
|
|
|
|
'("$6.00")
|
|
|
|
|
(sxml->table-row-col sxml 1 3 2))
|
|
|
|
|
(test-equal "4 columns"
|
|
|
|
|
4
|
|
|
|
|
(length (sxml->table-row-col sxml 1 1 #f)))
|
|
|
|
|
(test-equal "3 rows"
|
|
|
|
|
3
|
|
|
|
|
(length (sxml->table-row-col sxml 1 #f 1)))
|
|
|
|
|
(test-end "two-txn-test")
|
|
|
|
|
sxml))))
|
|
|
|
|
|
|
|
|
|
(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* ((options (gnc:make-report-options uuid))
|
|
|
|
|
(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)
|
|
|
|
|
|
|
|
|
|
(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))
|
|
|
|
|
))))))
|
|
|
|
|
(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 my-income-account my-expense-account))
|
|
|
|
|
|
|
|
|
|
(let ((sxml (gnc:options->sxml uuid options "test-standard-net-barchart"
|
|
|
|
|
"two-txn-test-2" #:strip-tag "script")))
|
|
|
|
|
(test-begin "two-txn-test-2")
|
|
|
|
|
(test-equal "income $0.00"
|
|
|
|
|
'("$0.00")
|
|
|
|
|
(sxml->table-row-col sxml 1 1 2))
|
|
|
|
|
(test-equal "income $1.00"
|
|
|
|
|
'("$1.00")
|
|
|
|
|
(sxml->table-row-col sxml 1 2 2))
|
|
|
|
|
(test-equal "income $5.00"
|
|
|
|
|
'("$5.00")
|
|
|
|
|
(sxml->table-row-col sxml 1 3 2))
|
|
|
|
|
(test-equal "4 columns"
|
|
|
|
|
4
|
|
|
|
|
(length (sxml->table-row-col sxml 1 1 #f)))
|
|
|
|
|
(test-equal "3 rows"
|
|
|
|
|
3
|
|
|
|
|
(length (sxml->table-row-col sxml 1 #f 1)))
|
|
|
|
|
(test-end "two-txn-test-2")
|
|
|
|
|
sxml)))
|
|
|
|
|
|
|
|
|
|
(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)
|
|
|
|
|
(define (closing-test uuid)
|
|
|
|
|
(let* ((options (gnc:make-report-options uuid))
|
|
|
|
|
(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)))
|
|
|
|
|
|
|
|
|
|
(let ((closing-txn (env-create-transaction env date-2 my-asset-account my-equity-account
|
|
|
|
|
300/1)))
|
|
|
|
|
(xaccTransSetIsClosingTxn closing-txn #t))
|
|
|
|
|
(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)
|
|
|
|
|
|
|
|
|
|
(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 ((closing-txn (env-create-transaction env date-2 my-asset-account my-equity-account 300)))
|
|
|
|
|
(xaccTransSetIsClosingTxn closing-txn #t))
|
|
|
|
|
|
|
|
|
|
(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))
|
|
|
|
|
))))))
|
|
|
|
|
(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-3))
|
|
|
|
|
(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 my-income-account my-expense-account))
|
|
|
|
|
|
|
|
|
|
(let ((sxml (gnc:options->sxml uuid options "test-standard-net-barchart"
|
|
|
|
|
"closing-test" #:strip-tag "script")))
|
|
|
|
|
(test-begin "closing-test")
|
|
|
|
|
(test-equal "income $0.00"
|
|
|
|
|
'("$0.00")
|
|
|
|
|
(sxml->table-row-col sxml 1 1 2))
|
|
|
|
|
(test-equal "income $1.00"
|
|
|
|
|
'("$1.00")
|
|
|
|
|
(sxml->table-row-col sxml 1 2 2))
|
|
|
|
|
(test-equal "income $2.00"
|
|
|
|
|
'("$2.00")
|
|
|
|
|
(sxml->table-row-col sxml 1 3 2))
|
|
|
|
|
(test-equal "income $3.00"
|
|
|
|
|
'("$3.00")
|
|
|
|
|
(sxml->table-row-col sxml 1 4 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 "closing-test")
|
|
|
|
|
sxml)))
|
|
|
|
|
|
Christopher Lam
7 years ago