gnucash maint: Multiple changes pushed
John Ralls
jralls at code.gnucash.org
Mon Sep 17 21:23:42 EDT 2018
Updated via https://github.com/Gnucash/gnucash/commit/a20a803c (commit)
via https://github.com/Gnucash/gnucash/commit/395b42d6 (commit)
via https://github.com/Gnucash/gnucash/commit/ce585495 (commit)
via https://github.com/Gnucash/gnucash/commit/ad361d1e (commit)
via https://github.com/Gnucash/gnucash/commit/941acee0 (commit)
via https://github.com/Gnucash/gnucash/commit/77063afa (commit)
via https://github.com/Gnucash/gnucash/commit/984501e9 (commit)
via https://github.com/Gnucash/gnucash/commit/2832b8e6 (commit)
via https://github.com/Gnucash/gnucash/commit/38129365 (commit)
via https://github.com/Gnucash/gnucash/commit/9bba9474 (commit)
via https://github.com/Gnucash/gnucash/commit/3e9cd1fc (commit)
via https://github.com/Gnucash/gnucash/commit/867aa78f (commit)
from https://github.com/Gnucash/gnucash/commit/766dc9b2 (commit)
commit a20a803c8e86fa2c936b96366c1dfd0c25af875a
Merge: 766dc9b 395b42d
Author: John Ralls <jralls at ceridwen.us>
Date: Mon Sep 17 17:46:28 2018 -0700
Merge Chris Lam's 'maint-optimize-interval-charts' into maint.
commit 395b42d620ae0136649d3e74b5eecf220f5550ef
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Sep 14 19:29:06 2018 +0800
[average-balance] add styling to data table
diff --git a/gnucash/report/standard-reports/average-balance.scm b/gnucash/report/standard-reports/average-balance.scm
index ad6e785..9a633a7 100644
--- a/gnucash/report/standard-reports/average-balance.scm
+++ b/gnucash/report/standard-reports/average-balance.scm
@@ -555,17 +555,15 @@
table columns)
(for-each
(lambda (row)
- (gnc:html-table-append-row! table row))
+ (gnc:html-table-append-row!
+ table
+ (map
+ gnc:make-html-table-cell/markup
+ (list "date-cell" "date-cell"
+ "number-cell" "number-cell" "number-cell"
+ "number-cell" "number-cell" "number-cell")
+ row)))
data)
-
- ;; set numeric columns to align right
- (for-each
- (lambda (col)
- (gnc:html-table-set-col-style!
- table col "td"
- 'attribute (list "align" "right")))
- '(2 3 4 5 6 7))
-
(gnc:html-document-add-object! document table))))
;; if there are no accounts selected...
commit ce5854950666b43878b552f44971a36a57289f4b
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Sep 14 20:36:31 2018 +0800
[invoice] mark strings in options as translatable
diff --git a/gnucash/report/business-reports/invoice.scm b/gnucash/report/business-reports/invoice.scm
index e5750f8..690534b 100644
--- a/gnucash/report/business-reports/invoice.scm
+++ b/gnucash/report/business-reports/invoice.scm
@@ -110,23 +110,26 @@
(gnc:make-gnc-monetary currency numeric)))
(define layout-key-list
+ ;; Translators: "Their details" refer to the invoice 'other party' details i.e. client/vendor name/address/ID
(list (cons 'client (list (cons 'text (_ "Their details"))
(cons 'tip (_ "Client or vendor name, address and ID"))))
- (cons 'company (list (cons 'text "Our details")
- (cons 'tip "Company name, address and tax-ID")))
+ ;; Translators: "Our details" refer to the book owner's details i.e. name/address/tax-ID
+ (cons 'company (list (cons 'text (_ "Our details"))
+ (cons 'tip (_ "Company name, address and tax-ID"))))
- (cons 'invoice (list (cons 'text "Invoice details")
- (cons 'tip "Invoice date, due date, billing ID, terms, job details")))
+ (cons 'invoice (list (cons 'text (_ "Invoice details"))
+ (cons 'tip (_ "Invoice date, due date, billing ID, terms, job details"))))
- (cons 'today (list (cons 'text "Today's date")
- (cons 'tip "Today's date")))
+ (cons 'today (list (cons 'text (_ "Today's date"))
+ (cons 'tip (_ "Today's date"))))
- (cons 'picture (list (cons 'text "Picture")
- (cons 'tip "Picture")))
+ (cons 'picture (list (cons 'text (_ "Picture"))
+ (cons 'tip (_ "Picture"))))
- (cons 'none (list (cons 'text "(empty)")
- (cons 'tip "Empty space")))))
+ ;; Translators: "(empty)" refers to invoice header section being left blank
+ (cons 'none (list (cons 'text (_ "(empty)"))
+ (cons 'tip (_ "Empty space"))))))
(define variant-list
(list
commit ad361d1e69edac8fb352c72305f723c81d9b354b
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Sep 14 19:24:12 2018 +0800
[invoice] Add customer/vendor ID in client section
This aims, but does not completely fixes bug 430259 or 742086 which
would require data model changes. It upgrades invoice.scm to add the
customer/vendor/employee internal ID. Job invoices will display the
job owner's ID.
diff --git a/gnucash/report/business-reports/invoice.scm b/gnucash/report/business-reports/invoice.scm
index 38d0421..e5750f8 100644
--- a/gnucash/report/business-reports/invoice.scm
+++ b/gnucash/report/business-reports/invoice.scm
@@ -110,10 +110,10 @@
(gnc:make-gnc-monetary currency numeric)))
(define layout-key-list
- (list (cons 'client (list (cons 'text "Client details")
- (cons 'tip "Client name and address")))
+ (list (cons 'client (list (cons 'text (_ "Their details"))
+ (cons 'tip (_ "Client or vendor name, address and ID"))))
- (cons 'company (list (cons 'text "Company details")
+ (cons 'company (list (cons 'text "Our details")
(cons 'tip "Company name, address and tax-ID")))
(cons 'invoice (list (cons 'text "Invoice details")
@@ -335,6 +335,11 @@ for styling the invoice. Please see the exported report for the CSS class names.
(gnc:register-inv-option
(gnc:make-simple-boolean-option
+ (N_ "Display") (N_ "Invoice owner ID")
+ "tam" (N_ "Display the customer/vendor id?") #f))
+
+ (gnc:register-inv-option
+ (gnc:make-simple-boolean-option
(N_ "Display") (N_ "Invoice Notes")
"tb" (N_ "Display the invoice notes?") #f))
@@ -669,7 +674,10 @@ for styling the invoice. Please see the exported report for the CSS class names.
(gnc:make-html-text
(gnc:html-markup-img img-url)))
-(define (make-client-table owner orders)
+(define (make-client-table owner orders options)
+ (define (opt-val section name)
+ (gnc:option-value
+ (gnc:lookup-option options section name)))
;; this is a single-column table.
(let ((table (gnc:make-html-table)))
@@ -686,6 +694,14 @@ for styling the invoice. Please see the exported report for the CSS class names.
(multiline-to-html-text
(gnc:owner-get-address-dep owner)))))
+ (if (opt-val "Display" "Invoice owner ID")
+ (gnc:html-table-append-row! table
+ (list
+ (gnc:make-html-div/markup
+ "maybe-align-right client-id"
+ (multiline-to-html-text
+ (gnc:owner-get-owner-id owner))))))
+
(for-each
(lambda (order)
(let ((reference (gncOrderGetReference order)))
@@ -793,7 +809,8 @@ for styling the invoice. Please see the exported report for the CSS class names.
invoice options)))
(cons 'client (gnc:make-html-div/markup
"client-table"
- (make-client-table owner orders)))
+ (make-client-table
+ owner orders options)))
(cons 'company (gnc:make-html-div/markup
"company-table"
(make-company-table book)))
commit 941acee04e3598c18eda8cb68c3b024da6f73ab1
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Sep 12 17:28:26 2018 +0800
[net-charts] deoptimize accounts-list
This aims to partially undo commit 8aed5c3f660.
diff --git a/gnucash/report/standard-reports/net-charts.scm b/gnucash/report/standard-reports/net-charts.scm
index 9e1e885..5a633e3 100644
--- a/gnucash/report/standard-reports/net-charts.scm
+++ b/gnucash/report/standard-reports/net-charts.scm
@@ -33,8 +33,6 @@
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
-(use-modules (gnucash report report-system report-collectors))
-(use-modules (gnucash report report-system collectors))
(use-modules (gnucash report standard-reports category-barchart)) ; for guids of called reports
(gnc:module-load "gnucash/report/report-system" 0)
@@ -306,50 +304,16 @@
(if
(not (null? accounts))
- (let* ((the-account-destination-alist
- (if inc-exp?
- (append (map (lambda (account) (cons account 'asset))
- (assoc-ref classified-accounts ACCT-TYPE-INCOME))
- (map (lambda (account) (cons account 'liability))
- (assoc-ref classified-accounts ACCT-TYPE-EXPENSE)))
- (append (map (lambda (account) (cons account 'asset))
- (assoc-ref classified-accounts ACCT-TYPE-ASSET))
- (map (lambda (account) (cons account 'liability))
- (assoc-ref classified-accounts ACCT-TYPE-LIABILITY)))))
- (account-reformat (if inc-exp?
- (lambda (account result)
- (map (lambda (collector date-interval)
- (gnc:monetary-neg (collector->monetary collector (second date-interval))))
- result dates-list))
- (lambda (account result)
- (let ((commodity-collector (gnc:make-commodity-collector)))
- (collector-end (fold (lambda (next date list-collector)
- (commodity-collector 'merge next #f)
- (collector-add list-collector
- (collector->monetary
- commodity-collector date)))
- (collector-into-list)
- result
- dates-list))))))
- (work (category-by-account-report-work inc-exp?
- dates-list
- the-account-destination-alist
- (lambda (account date)
- (make-gnc-collector-collector))
- account-reformat))
- (rpt (category-by-account-report-do-work work (cons 50 90)))
- (assets (assoc-ref rpt 'asset))
- (liabilities (assoc-ref rpt 'liability))
- (assets-list (if assets
- (car assets)
- (map (lambda (d)
- (gnc:make-gnc-monetary report-currency 0))
- dates-list)))
- (liability-list (if liabilities
- (car liabilities)
- (map (lambda (d)
- (gnc:make-gnc-monetary report-currency 0))
- dates-list)))
+ (let* ((assets-list (process-datelist
+ (if inc-exp?
+ accounts
+ (assoc-ref classified-accounts ACCT-TYPE-ASSET))
+ dates-list #t))
+ (liability-list (process-datelist
+ (if inc-exp?
+ accounts
+ (assoc-ref classified-accounts ACCT-TYPE-LIABILITY))
+ dates-list #f))
(net-list (map monetary+ assets-list liability-list))
;; Here the date strings for the x-axis labels are
;; created.
commit 77063afa735d30cb44a51b1a487056bb03f522b3
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Sep 14 09:18:32 2018 +0800
[report-utilities] improve (gnc:account-get-comm-value-interval)
This commit will marginally speed up this function when
include-children? is #t. The original code would create a new query
for each descendant. This commit will create one query only for all
accounts when include-children? is #t. Unfortunately there is no
actual live code whereby include-children? is enabled. Anyway this
code is cleaned up.
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index 8b09b53..1b8cde8 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -413,41 +413,35 @@ construct gnc:make-gnc-monetary and use gnc:monetary->string instead.")
;; just direct children) are are included in the calculation. The results
;; are returned in a commodity collector.
(define (gnc:account-get-comm-value-interval account start-date end-date
- include-children?)
+ include-children?)
(let ((value-collector (gnc:make-commodity-collector))
- (query (qof-query-create-for-splits))
- (splits #f))
-
- (if include-children?
- (for-each
- (lambda (x)
- (value-collector 'merge x #f))
- (gnc:account-map-descendants
- (lambda (d)
- (gnc:account-get-comm-value-interval d start-date end-date #f))
- account)))
+ (query (qof-query-create-for-splits))
+ (accounts (cons account
+ (if include-children?
+ (gnc-account-get-descendants account)
+ '()))))
;; Build a query to find all splits between the indicated dates.
(qof-query-set-book query (gnc-get-current-book))
- (xaccQueryAddSingleAccountMatch query account QOF-QUERY-AND)
+ (xaccQueryAddAccountMatch query accounts
+ QOF-GUID-MATCH-ANY
+ QOF-QUERY-AND)
(xaccQueryAddDateMatchTT query
- (and start-date #t) (if start-date start-date 0)
- (and end-date #t) (if end-date end-date 0)
+ (and start-date #t) (or start-date 0)
+ (and end-date #t) (or end-date 0)
QOF-QUERY-AND)
;; Get the query results.
- (set! splits (qof-query-run query))
- (qof-query-destroy query)
-
- ;; Add the "value" of each split returned (which is measured
- ;; in the transaction currency).
- (for-each
- (lambda (split)
- (value-collector 'add
- (xaccTransGetCurrency (xaccSplitGetParent split))
- (xaccSplitGetValue split)))
- splits)
-
+ (let ((splits (qof-query-run query)))
+ (qof-query-destroy query)
+ ;; Add the "value" of each split returned (which is measured
+ ;; in the transaction currency).
+ (for-each
+ (lambda (split)
+ (value-collector 'add
+ (xaccTransGetCurrency (xaccSplitGetParent split))
+ (xaccSplitGetValue split)))
+ splits))
value-collector))
;; Calculate the balance of the account in terms of "value" (rather
commit 984501e95168726f9e86dbfa4c8fd21fe8fcd6e1
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Sep 12 18:26:48 2018 +0800
[report-utilities] improve (gnc:account-get-comm-balance-at-date)
This improves (gnc:account-get-comm-balance-at-date) to
use (xaccAccountBalanceAsOfDate) instead of cycling through a split
list.
This function is used in numerous charts and should speed them up
tremendously.
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index 02c5e46..8b09b53 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -392,42 +392,20 @@ construct gnc:make-gnc-monetary and use gnc:monetary->string instead.")
;; This works similar as above but returns a commodity-collector,
;; thus takes care of children accounts with different currencies.
-;;
-;; Also note that the commodity-collector contains <gnc:numeric>
-;; values rather than double values.
-(define (gnc:account-get-comm-balance-at-date account
- date include-children?)
+(define (gnc:account-get-comm-balance-at-date
+ account date include-children?)
(let ((balance-collector (gnc:make-commodity-collector))
- (query (qof-query-create-for-splits))
- (splits #f))
-
- (if include-children?
- (for-each
- (lambda (x)
- (balance-collector 'merge x #f))
- (gnc:account-map-descendants
- (lambda (child)
- (gnc:account-get-comm-balance-at-date child date #f))
- account)))
-
- (qof-query-set-book query (gnc-get-current-book))
- (xaccQueryAddSingleAccountMatch query account QOF-QUERY-AND)
- (xaccQueryAddDateMatchTT query #f date #t date QOF-QUERY-AND)
- (qof-query-set-sort-order query
- (list SPLIT-TRANS TRANS-DATE-POSTED)
- (list QUERY-DEFAULT-SORT)
- '())
- (qof-query-set-sort-increasing query #t #t #t)
- (qof-query-set-max-results query 1)
-
- (set! splits (qof-query-run query))
- (qof-query-destroy query)
-
- (if (and splits (not (null? splits)))
- (balance-collector 'add
- (xaccAccountGetCommodity account)
- (xaccSplitGetBalance (car splits))))
- balance-collector))
+ (accounts (cons account
+ (if include-children?
+ (gnc-account-get-descendants account)
+ '()))))
+ (for-each
+ (lambda (acct)
+ (balance-collector 'add
+ (xaccAccountGetCommodity acct)
+ (xaccAccountGetBalanceAsOfDate acct date)))
+ accounts)
+ balance-collector))
;; Calculate the increase in the balance of the account in terms of
;; "value" (as opposed to "amount") between the specified dates.
commit 2832b8e63c5218d630f6220ff5952785ec323608
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Sep 14 17:08:11 2018 +0800
[report-utilities] compact functions
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index 58aeaf6..02c5e46 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -633,34 +633,31 @@ construct gnc:make-gnc-monetary and use gnc:monetary->string instead.")
;; the type is an alist '((str "match me") (cased #f) (regexp #f))
;; If type is #f, sums all non-closing splits in the interval
(define (gnc:account-get-trans-type-balance-interval
- account-list type start-date end-date)
+ account-list type start-date end-date)
(let* ((total (gnc:make-commodity-collector)))
- (map (lambda (split)
- (let* ((shares (xaccSplitGetAmount split))
- (acct-comm (xaccAccountGetCommodity
- (xaccSplitGetAccount split)))
- (txn (xaccSplitGetParent split)))
- (if type
- (total 'add acct-comm shares)
- (if (not (xaccTransGetIsClosingTxn txn))
- (total 'add acct-comm shares)))))
- (gnc:account-get-trans-type-splits-interval
- account-list type start-date end-date))
+ (for-each
+ (lambda (split)
+ (if (or type (not (xaccTransGetIsClosingTxn (xaccSplitGetParent split))))
+ (total 'add
+ (xaccAccountGetCommodity (xaccSplitGetAccount split))
+ (xaccSplitGetAmount split))))
+ (gnc:account-get-trans-type-splits-interval
+ account-list type start-date end-date))
total))
;; Sums up any splits of a certain type affecting a set of accounts.
;; the type is an alist '((str "match me") (cased #f) (regexp #f))
;; If type is #f, sums all splits in the interval (even closing splits)
(define (gnc:account-get-trans-type-balance-interval-with-closing
- account-list type start-date end-date)
+ account-list type start-date end-date)
(let ((total (gnc:make-commodity-collector)))
- (map (lambda (split)
- (let* ((shares (xaccSplitGetAmount split))
- (acct-comm (xaccAccountGetCommodity
- (xaccSplitGetAccount split))))
- (total 'add acct-comm shares)))
- (gnc:account-get-trans-type-splits-interval
- account-list type start-date end-date))
+ (for-each
+ (lambda (split)
+ (total 'add
+ (xaccAccountGetCommodity (xaccSplitGetAccount split))
+ (xaccSplitGetAmount split)))
+ (gnc:account-get-trans-type-splits-interval
+ account-list type start-date end-date))
total))
;; Filters the splits from the source to the target accounts
@@ -757,44 +754,36 @@ construct gnc:make-gnc-monetary and use gnc:monetary->string instead.")
(define (gnc:account-get-trans-type-splits-interval
account-list type start-date end-date)
(if (null? account-list)
- ;; No accounts given. Return empty list.
'()
- ;; The normal case: There are accounts given.
- (let* ((query (qof-query-create-for-splits))
- (query2 #f)
- (splits #f)
- (get-val (lambda (alist key)
- (let ((lst (assoc-ref alist key)))
- (if lst (car lst) lst))))
- (matchstr (get-val type 'str))
- (case-sens (if (get-val type 'cased) #t #f))
- (regexp (if (get-val type 'regexp) #t #f))
- (closing (if (get-val type 'closing) #t #f))
- )
- (qof-query-set-book query (gnc-get-current-book))
- (gnc:query-set-match-non-voids-only! query (gnc-get-current-book))
- (xaccQueryAddAccountMatch query account-list QOF-GUID-MATCH-ANY QOF-QUERY-AND)
- (xaccQueryAddDateMatchTT
- query
- (and start-date #t) (if start-date start-date 0)
- (and end-date #t) (if end-date end-date 0)
- QOF-QUERY-AND)
- (if (or matchstr closing)
- (begin
- (set! query2 (qof-query-create-for-splits))
- (if matchstr (xaccQueryAddDescriptionMatch
- query2 matchstr case-sens regexp QOF-COMPARE-CONTAINS QOF-QUERY-OR))
- (if closing (xaccQueryAddClosingTransMatch query2 1 QOF-QUERY-OR))
- (qof-query-merge-in-place query query2 QOF-QUERY-AND)
- (qof-query-destroy query2)
- ))
-
- (set! splits (qof-query-run query))
- (qof-query-destroy query)
- splits
- )
- )
- )
+ (let* ((query (qof-query-create-for-splits))
+ (get-val (lambda (key)
+ (let ((lst (assq-ref type key)))
+ (and lst (car lst)))))
+ (matchstr (get-val 'str))
+ (case-sens (get-val 'cased))
+ (regexp (get-val 'regexp))
+ (closing (get-val 'closing)))
+ (qof-query-set-book query (gnc-get-current-book))
+ (gnc:query-set-match-non-voids-only! query (gnc-get-current-book))
+ (xaccQueryAddAccountMatch query account-list QOF-GUID-MATCH-ANY QOF-QUERY-AND)
+ (xaccQueryAddDateMatchTT
+ query
+ (and start-date #t) (or start-date 0)
+ (and end-date #t) (or end-date 0)
+ QOF-QUERY-AND)
+ (when (or matchstr closing)
+ (let ((query2 (qof-query-create-for-splits)))
+ (if matchstr
+ (xaccQueryAddDescriptionMatch
+ query2 matchstr case-sens regexp
+ QOF-COMPARE-CONTAINS QOF-QUERY-OR))
+ (if closing
+ (xaccQueryAddClosingTransMatch query2 1 QOF-QUERY-OR))
+ (qof-query-merge-in-place query query2 QOF-QUERY-AND)
+ (qof-query-destroy query2)))
+ (let ((splits (qof-query-run query)))
+ (qof-query-destroy query)
+ splits))))
;; utility to assist with double-column balance tables
;; a request is made with the <req> argument
@@ -867,12 +856,12 @@ construct gnc:make-gnc-monetary and use gnc:monetary->string instead.")
;;
;; Returns a commodity-collector.
(define (gnc:budget-account-get-net budget account start-period end-period)
- (if (not end-period) (set! end-period (gnc-budget-get-num-periods budget)))
(let* ((period (or start-period 0))
- (net (gnc:make-commodity-collector))
- (acct-comm (xaccAccountGetCommodity account)))
- (while (< period end-period)
- (net 'add acct-comm
+ (maxperiod (or end-period (gnc-budget-get-num-periods budget)))
+ (net (gnc:make-commodity-collector)))
+ (while (< period maxperiod)
+ (net 'add
+ (xaccAccountGetCommodity account)
(gnc-budget-get-account-period-value budget account period))
(set! period (1+ period)))
net))
commit 381293655ff60bde76698a58a7b588f1cd20efb1
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Sep 12 18:35:11 2018 +0800
[test-charts] also test income-expense-barchart amounts
diff --git a/gnucash/report/standard-reports/test/test-charts.scm b/gnucash/report/standard-reports/test/test-charts.scm
index edd4b88..850b472 100644
--- a/gnucash/report/standard-reports/test/test-charts.scm
+++ b/gnucash/report/standard-reports/test/test-charts.scm
@@ -119,14 +119,16 @@
(options->render uuid options (format #f "test-null ~a default options" variant))))
;; test net worth barchart amounts
- (when (eq? variant 'net-worth-barchart)
+ (when (or (eq? variant 'net-worth-barchart)
+ (eq? variant 'income-expense-barchart))
;; create 100 daily transactions from 1/1/70. this is meant to
;; test chart date ranges. day 0 = $0, day 1 = $1, etc
(let loop ((date (gnc-dmy2time64 1 1 1970)) (idx 0))
(when (<= idx 100)
(env-create-transaction env date bank income idx)
(loop (incdate date DayDelta) (1+ idx))))
- (let* ((options (default-testing-options)))
+ (when (eq? variant 'net-worth-barchart)
+ (let* ((options (default-testing-options)))
(set-option! options "General" "Start Date" (cons 'absolute (gnc-dmy2time64 15 1 1970)))
(set-option! options "General" "End Date" (cons 'absolute (gnc-dmy2time64 15 3 1970)))
(set-option! options "General" "Step Size" 'DayDelta)
@@ -141,8 +143,27 @@
(sxml->table-row-col sxml 1 1 #f))
(test-equal "net-worth-barchart: last data row"
'("03/15/70" "$2,701.00" "$0.00" "$2,701.00")
- (sxml->table-row-col sxml 1 -1 #f))
- )))
+ (sxml->table-row-col sxml 1 -1 #f)))))
+
+ (when (eq? variant 'income-expense-barchart)
+ (let* ((options (default-testing-options)))
+ (set-option! options "General" "Start Date" (cons 'absolute (gnc-dmy2time64 15 1 1970)))
+ (set-option! options "General" "End Date" (cons 'absolute (gnc-dmy2time64 15 3 1970)))
+ (set-option! options "General" "Step Size" 'DayDelta)
+ (set-option! options "Display" "Show table" #t)
+ (set-option! options "Accounts" "Accounts" (list income expense))
+ (let ((sxml (gnc:options->sxml uuid options (format #f "test-net-charts ~a 2 years" variant)
+ "test-table" #:strip-tag "script")))
+ (test-equal "income-expense-barchart: first row"
+ '("Date" "Income" "Expense" "Net Profit")
+ (sxml->table-row-col sxml 1 0 #f))
+ (test-equal "income-expense: first data row"
+ '("01/15/70" "$14.00" "$0.00" "$14.00")
+ (sxml->table-row-col sxml 1 1 #f))
+ (test-equal "income-expense: last data row"
+ '("03/15/70" "$73.00" "$0.00" "$73.00")
+ (sxml->table-row-col sxml 1 -1 #f))))
+ ))
(case variant
((liability-piechart stock-piechart asset-piechart expense-piechart income-piechart)
commit 9bba9474cbbc9c4702c06a7804f812e2e2acf41f
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Sep 12 18:19:43 2018 +0800
[test-charts] add daily txns and test range
This test (for net-worth-barchart only) adds daily transactions from
1/1/70 for 100 days, and aims to test the date ranges for net-charts
is accurate.
diff --git a/gnucash/report/standard-reports/test/test-charts.scm b/gnucash/report/standard-reports/test/test-charts.scm
index 2094f28..edd4b88 100644
--- a/gnucash/report/standard-reports/test/test-charts.scm
+++ b/gnucash/report/standard-reports/test/test-charts.scm
@@ -116,7 +116,33 @@
(let* ((options (default-testing-options)))
(test-assert (format #f "basic report exists: ~a" variant)
- (options->render uuid options (format #f "net-charts-test ~a default options" variant))))
+ (options->render uuid options (format #f "test-null ~a default options" variant))))
+
+ ;; test net worth barchart amounts
+ (when (eq? variant 'net-worth-barchart)
+ ;; create 100 daily transactions from 1/1/70. this is meant to
+ ;; test chart date ranges. day 0 = $0, day 1 = $1, etc
+ (let loop ((date (gnc-dmy2time64 1 1 1970)) (idx 0))
+ (when (<= idx 100)
+ (env-create-transaction env date bank income idx)
+ (loop (incdate date DayDelta) (1+ idx))))
+ (let* ((options (default-testing-options)))
+ (set-option! options "General" "Start Date" (cons 'absolute (gnc-dmy2time64 15 1 1970)))
+ (set-option! options "General" "End Date" (cons 'absolute (gnc-dmy2time64 15 3 1970)))
+ (set-option! options "General" "Step Size" 'DayDelta)
+ (set-option! options "Display" "Show table" #t)
+ (let ((sxml (gnc:options->sxml uuid options (format #f "test-net-charts ~a 2 months" variant)
+ "test-table" #:strip-tag "script")))
+ (test-equal "net-worth-barchart: first row"
+ '("Date" "Assets" "Liabilities" "Net Worth")
+ (sxml->table-row-col sxml 1 0 #f))
+ (test-equal "net-worth-barchart: first data row"
+ '("01/15/70" "$105.00" "$0.00" "$105.00")
+ (sxml->table-row-col sxml 1 1 #f))
+ (test-equal "net-worth-barchart: last data row"
+ '("03/15/70" "$2,701.00" "$0.00" "$2,701.00")
+ (sxml->table-row-col sxml 1 -1 #f))
+ )))
(case variant
((liability-piechart stock-piechart asset-piechart expense-piechart income-piechart)
commit 3e9cd1fc1170165299a1fe30c434825444eeab2a
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Sep 12 18:11:06 2018 +0800
[test-extras] augment (gnc:options->sxml) to allow tag stripping
An html render containing a <script>...</script> tag will not
typically be parsable by sxml. This augmentation will strip an html
tag from the render. Therefore we can use
(gnc:options->sxml ... #:strip-tag "script")
which will strip off the whole <script> section from the render, which
should usually then be parsable. Note: this is not foolproof, and does
not support nested <script> tags, and it will strip quoted "</script>"
tags too, but should cover common cases.
diff --git a/gnucash/report/report-system/test/test-extras.scm b/gnucash/report/report-system/test/test-extras.scm
index e6e02bf..acfaa61 100644
--- a/gnucash/report/report-system/test/test-extras.scm
+++ b/gnucash/report/report-system/test/test-extras.scm
@@ -117,14 +117,27 @@
(display render)))
render)))
+(define (strip-string s1 s2)
+ (let loop ((str s1))
+ (let ((startpos (string-contains str (format #f "<~a" s2)))
+ (endpos (string-contains str (format #f "</~a>" s2))))
+ (if (and startpos endpos)
+ (loop (string-append
+ (string-take str startpos)
+ (string-drop str (+ endpos (string-length s2) 3))))
+ str))))
+
(export gnc:options->sxml)
-(define (gnc:options->sxml uuid options prefix test-title)
+(define* (gnc:options->sxml uuid options prefix test-title #:key strip-tag)
;; This functions calls the above gnc:options->render to render
;; report. Then report is converted to SXML. It catches XML
- ;; parsing errors, dumping the options changed.
+ ;; parsing errors, dumping the options changed. Also optionally strip
+ ;; an HTML tag from the render, e.g. <script>...</script>
(let ((render (gnc:options->render uuid options prefix test-title)))
(catch 'parser-error
- (lambda () (xml->sxml render
+ (lambda () (xml->sxml (if strip-tag
+ (strip-string render strip-tag)
+ render)
#:trim-whitespace? #t
#:entities '((nbsp . "\xa0"))))
(lambda (k . args)
commit 867aa78f91274c759b0de9d63512af1ff09d6196
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Sep 12 18:10:34 2018 +0800
[test-charts] add SRFI-64 teardown function
diff --git a/gnucash/report/standard-reports/test/test-charts.scm b/gnucash/report/standard-reports/test/test-charts.scm
index 342ef1b..2094f28 100644
--- a/gnucash/report/standard-reports/test/test-charts.scm
+++ b/gnucash/report/standard-reports/test/test-charts.scm
@@ -45,12 +45,8 @@
(define (run-test)
(test-runner-factory gnc:test-runner)
(test-begin "net-charts.scm")
- (for-each (lambda (variant)
- (null-test variant))
- (map car variant-alist))
- (for-each (lambda (variant)
- (net-charts-test variant))
- (map car variant-alist))
+ (for-each null-test (map car variant-alist))
+ (for-each test-chart (map car variant-alist))
(test-end "net-charts.scm"))
(define (options->render variant options test-title)
@@ -74,7 +70,12 @@
(test-assert (format #f "null-test: ~a" variant)
(options->render uuid options "null-test"))))
-(define (net-charts-test variant)
+(define (test-chart variant)
+ (test-group-with-cleanup (format #f "test variant ~a" variant)
+ (test-chart-variant variant)
+ (gnc-clear-current-session)))
+
+(define (test-chart-variant variant)
(define (set-option! options section name value)
(let ((option (gnc:lookup-option options section name)))
(if option
Summary of changes:
gnucash/report/business-reports/invoice.scm | 48 +++--
gnucash/report/report-system/report-utilities.scm | 209 +++++++++------------
gnucash/report/report-system/test/test-extras.scm | 19 +-
.../report/standard-reports/average-balance.scm | 18 +-
gnucash/report/standard-reports/net-charts.scm | 56 +-----
.../report/standard-reports/test/test-charts.scm | 64 ++++++-
6 files changed, 209 insertions(+), 205 deletions(-)
More information about the gnucash-changes
mailing list