gnucash maint: Multiple changes pushed
John Ralls
jralls at code.gnucash.org
Sun Sep 9 14:17:24 EDT 2018
Updated via https://github.com/Gnucash/gnucash/commit/f8a9be2c (commit)
via https://github.com/Gnucash/gnucash/commit/f4c0544f (commit)
via https://github.com/Gnucash/gnucash/commit/c76ea30f (commit)
via https://github.com/Gnucash/gnucash/commit/768ed099 (commit)
via https://github.com/Gnucash/gnucash/commit/cb2fccf4 (commit)
via https://github.com/Gnucash/gnucash/commit/4f90663c (commit)
via https://github.com/Gnucash/gnucash/commit/7a63fab0 (commit)
via https://github.com/Gnucash/gnucash/commit/0144055c (commit)
via https://github.com/Gnucash/gnucash/commit/512dd7c7 (commit)
via https://github.com/Gnucash/gnucash/commit/18087033 (commit)
via https://github.com/Gnucash/gnucash/commit/b85f54a2 (commit)
via https://github.com/Gnucash/gnucash/commit/b21874df (commit)
via https://github.com/Gnucash/gnucash/commit/cb01c93a (commit)
via https://github.com/Gnucash/gnucash/commit/89f8c8dc (commit)
via https://github.com/Gnucash/gnucash/commit/eac79bd5 (commit)
via https://github.com/Gnucash/gnucash/commit/353eee58 (commit)
via https://github.com/Gnucash/gnucash/commit/83ad9e4b (commit)
via https://github.com/Gnucash/gnucash/commit/f3100ddc (commit)
via https://github.com/Gnucash/gnucash/commit/51635416 (commit)
via https://github.com/Gnucash/gnucash/commit/3e8acf29 (commit)
via https://github.com/Gnucash/gnucash/commit/ec1536ad (commit)
via https://github.com/Gnucash/gnucash/commit/0b069900 (commit)
via https://github.com/Gnucash/gnucash/commit/125dcfb0 (commit)
via https://github.com/Gnucash/gnucash/commit/88229370 (commit)
from https://github.com/Gnucash/gnucash/commit/7e56a44f (commit)
commit f8a9be2c7fa8b5af1e429d7dbb6202996ca50613
Merge: f4c0544 c76ea30
Author: John Ralls <jralls at ceridwen.us>
Date: Sun Sep 9 11:10:23 2018 -0700
Merge Chris Lam's cleanup-report-utilities into maint.
commit f4c0544f1b8084553f010c821c55cde2b2d446ac
Merge: 7e56a44 3e8acf2
Author: John Ralls <jralls at ceridwen.us>
Date: Sun Sep 9 11:07:41 2018 -0700
Merge Chris Lam's 'test-report-utilities' into maint
commit c76ea30f3a07f164d0cf9ce8c9561bf7386176f3
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Sep 9 18:41:13 2018 +0800
[obsolete api] improve deprecation warnings
diff --git a/gnucash/report/report-system/commodity-utilities.scm b/gnucash/report/report-system/commodity-utilities.scm
index 3946b98..238fb79 100644
--- a/gnucash/report/report-system/commodity-utilities.scm
+++ b/gnucash/report/report-system/commodity-utilities.scm
@@ -94,7 +94,8 @@
;; Helper for warnings below.
(define (gnc-commodity-numeric->string commodity numeric)
- (issue-deprecation-warning "gnc-commodity-numeric->string deprecated.")
+ (issue-deprecation-warning "gnc-commodity-numeric->string deprecated. \
+construct with gnc:make-gnc-monetary and gnc:monetary->string instead.")
(gnc:monetary->string
(gnc:make-gnc-monetary commodity numeric)))
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index e0baf4d..58aeaf6 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -38,7 +38,8 @@
;; pair is a list of one gnc:commodity and one gnc:numeric
;; value. Deprecated -- use <gnc-monetary> instead.
(define (gnc-commodity-value->string pair)
- (issue-deprecation-warning "gnc-commodity-value->string deprecated")
+ (issue-deprecation-warning "gnc-commodity-value->string deprecated. \
+construct gnc:make-gnc-monetary and use gnc:monetary->string instead.")
(xaccPrintAmount
(cadr pair) (gnc-commodity-print-info (car pair) #t)))
commit 768ed09977630bdfb4c23e01cc58900e7b318d1a
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Aug 31 21:20:21 2018 +0800
[report-utilities] remove (gnc:value-collector-*) functions
These functions are underused. Remove.
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index 37c4f94..e0baf4d 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -243,21 +243,13 @@
;; This is a collector of values -- works similar to the stats-collector but
;; has much less overhead. It is used by the currency-collector (see below).
(define (gnc:make-value-collector)
- (let ;;; values
- ((value 0))
- (lambda (action amount) ;;; Dispatch function
+ (let ((value 0))
+ (lambda (action amount)
(case action
- ((add) (if (number? amount)
- (set! value (+ amount value))))
+ ((add) (if (number? amount)
+ (set! value (+ amount value))))
((total) value)
(else (gnc:warn "bad value-collector action: " action))))))
-;; Bah. Let's get back to normal data types -- this procedure thingy
-;; from above makes every code almost unreadable. First step: replace
-;; all 'action function calls by the normal functions below.
-(define (gnc:value-collector-add collector amount)
- (collector 'add amount))
-(define (gnc:value-collector-total collector)
- (collector 'total #f))
;; A commodity collector. This is intended to handle multiple
;; currencies' amounts. The amounts are accumulated via 'add, the
@@ -316,7 +308,7 @@
;; and add it to the alist
(set! commoditylist (cons pair commoditylist))))
;; add the value
- (gnc:value-collector-add (cadr pair) rvalue)))
+ ((cadr pair) 'add rvalue)))
;; helper function to walk an association list, adding each
;; (commodity -> collector) pair to our list at the appropriate
@@ -325,14 +317,14 @@
(cond ((null? clist) '())
(else (add-commodity-value
(caar clist)
- (gnc:value-collector-total (cadar clist)))
+ ((cadar clist) 'total #f))
(add-commodity-clist (cdr clist)))))
(define (minus-commodity-clist clist)
(cond ((null? clist) '())
(else (add-commodity-value
(caar clist)
- (- (gnc:value-collector-total (cadar clist))))
+ (- ((cadar clist) 'total #f)))
(minus-commodity-clist (cdr clist)))))
;; helper function walk the association list doing a callback on
@@ -340,21 +332,21 @@
(define (process-commodity-list fn clist)
(map
(lambda (pair) (fn (car pair)
- (gnc:value-collector-total (cadr pair))))
+ ((cadr pair) 'total #f)))
clist))
;; helper function which is given a commodity and returns, if
;; existing, a list (gnc:commodity gnc:numeric).
(define (getpair c sign?)
(let* ((pair (assoc c commoditylist))
- (total (and pair (gnc:value-collector-total (cadr pair)))))
+ (total (and pair ((cadr pair) 'total #f))))
(list c (if pair (if sign? (- total) total) 0))))
;; helper function which is given a commodity and returns, if
;; existing, a <gnc:monetary> value.
(define (getmonetary c sign?)
(let* ((pair (assoc c commoditylist))
- (total (and pair (gnc:value-collector-total (cadr pair)))))
+ (total (and pair ((cadr pair) 'total #f))))
(gnc:make-gnc-monetary
c (if pair (if sign? (- total) total) 0))))
commit cb2fccf416ea5c5cb757764e62d9596f0b390e57
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Aug 31 18:55:40 2018 +0800
[report-utilities] remove (gnc-commodity-collector-*) functions
These functions are not actually exported in report-system.scm so they
are not generally available to external reports. It should mean
they're safe to remove.
diff --git a/gnucash/report/report-system/html-acct-table.scm b/gnucash/report/report-system/html-acct-table.scm
index 4072ea6..6fa5f2f 100644
--- a/gnucash/report/report-system/html-acct-table.scm
+++ b/gnucash/report/report-system/html-acct-table.scm
@@ -732,13 +732,12 @@
;; ( acct . balance ) cells
(define (get-balance acct-balances acct)
(let ((this-collector (gnc:make-commodity-collector)))
- (gnc-commodity-collector-merge
- this-collector
+ (this-collector
+ 'merge
(or (hash-ref acct-balances (gncAccountGetGUID acct))
;; return a zero commodity collector
- (gnc:make-commodity-collector)
- )
- )
+ (gnc:make-commodity-collector))
+ #f)
this-collector
)
)
@@ -754,9 +753,9 @@
(let ((this-collector (gnc:make-commodity-collector)))
;; get the balance of the parent account and stick it on the collector
;; that nice shiny *NEW* collector!!
- (gnc-commodity-collector-merge this-collector (get-balance acct-balances account))
+ (this-collector 'merge (get-balance acct-balances account) #f)
(for-each
- (lambda (x) (if x (gnc-commodity-collector-merge this-collector x)))
+ (lambda (x) (if x (this-collector 'merge x #f)))
(gnc:account-map-descendants
(lambda (a)
(get-balance acct-balances a ))
@@ -1143,8 +1142,8 @@
;; readable.
(let* ((table (gnc:make-html-table))
)
- (gnc-commodity-collector-map
- amount
+ (amount
+ 'format
(lambda (curr val)
(let ((bal (gnc:make-gnc-monetary curr val)))
(gnc:html-table-append-row!
@@ -1162,7 +1161,8 @@
"number-cell" (exchange-fn bal report-commodity))
)
)
- )))
+ ))
+ #f)
(gnc:html-table-set-style! table "table" 'attribute(list "style" "width:100%; max-width:20em") 'attribute (list "cellpadding" "0"))
table))
diff --git a/gnucash/report/report-system/html-utilities.scm b/gnucash/report/report-system/html-utilities.scm
index a701ff2..62318e7 100644
--- a/gnucash/report/report-system/html-utilities.scm
+++ b/gnucash/report/report-system/html-utilities.scm
@@ -281,18 +281,15 @@
;; commodity
(commodity-row-helper!
my-name #f
- (if balance
- (gnc-commodity-collector-assoc
- balance report-commodity reverse-balance?)
- #f)
+ (and balance
+ (balance 'getmonetary report-commodity reverse-balance?))
main-row-style)
;; Special case for stock-accounts: then the foreign commodity
;; gets displayed in this line rather then the following lines
;; (loop below). Is also used if is-stock-account? is true.
- (let ((my-balance
- (if balance
- (gnc-commodity-collector-assoc
- balance my-commodity reverse-balance?) #f)))
+ (let ((my-balance
+ (and balance
+ (balance 'getmonetary my-commodity reverse-balance?))))
(set! already-printed my-commodity)
(commodity-row-helper!
my-name
@@ -304,8 +301,8 @@
;; balance and its corresponding value in the
;; report-currency. One row for each non-report-currency.
(if (and balance (not is-stock-account?))
- (gnc-commodity-collector-map
- balance
+ (balance
+ 'format
(lambda (curr val)
(if (or (gnc-commodity-equiv curr report-commodity)
(and already-printed
@@ -323,7 +320,7 @@
bal
(exchange-fn bal report-commodity)
other-rows-style))))
- ))))
+ #f))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -466,8 +463,7 @@
(let ((this-collector (my-get-balance-nosub account)))
(for-each
(lambda (x) (if x
- (gnc-commodity-collector-merge
- this-collector x )))
+ (this-collector 'merge x #f)))
(gnc:account-map-descendants
(lambda (a)
;; Important: Calculate the balance if and only if the
@@ -639,7 +635,7 @@
subaccounts my-get-balance
gnc-reverse-balance)))
(if thisbalance
- (gnc-commodity-collector-merge subbalance thisbalance))
+ (subbalance 'merge thisbalance #f))
subbalance)
heading-style
#t #f)))))
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index baa12da..37c4f94 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -362,10 +362,10 @@
(lambda (action commodity amount)
(case action
((add) (add-commodity-value commodity amount))
- ((merge) (add-commodity-clist
- (gnc-commodity-collector-list commodity)))
+ ((merge) (add-commodity-clist
+ (commodity 'list #f #f)))
((minusmerge) (minus-commodity-clist
- (gnc-commodity-collector-list commodity)))
+ (commodity 'list #f #f)))
((format) (process-commodity-list commodity commoditylist))
((reset) (set! commoditylist '()))
((getpair) (getpair commodity amount))
@@ -383,28 +383,6 @@
(for-each (lambda (collector) (merged 'merge collector #f)) collectorlist)
merged))
-;; Bah. Let's get back to normal data types -- this procedure thingy
-;; from above makes every code almost unreadable. First step: replace
-;; all 'action function calls by the normal functions below.
-
-;; CAS: ugh. Having two usages is even *more* confusing, so let's
-;; please settle on one or the other. What's Step 2? How 'bout
-;; documenting the new functions?
-(define (gnc-commodity-collector-add collector commodity amount)
- (collector 'add commodity amount))
-(define (gnc-commodity-collector-merge collector other-collector)
- (collector 'merge other-collector #f))
-(define (gnc-commodity-collector-minusmerge collector other-collector)
- (collector 'minusmerge other-collector #f))
-(define (gnc-commodity-collector-map collector function)
- (collector 'format function #f))
-(define (gnc-commodity-collector-assoc collector commodity sign?)
- (collector 'getmonetary commodity sign?))
-(define (gnc-commodity-collector-assoc-pair collector commodity sign?)
- (collector 'getpair commodity sign?))
-(define (gnc-commodity-collector-list collector)
- (collector 'list #f #f))
-
;; Returns zero if all entries in this collector are zero.
(define (gnc-commodity-collector-allzero? collector)
(every zero?
@@ -417,8 +395,7 @@
(define (gnc:account-get-balance-at-date account date include-children?)
(let ((collector (gnc:account-get-comm-balance-at-date
account date include-children?)))
- (cadr (gnc-commodity-collector-assoc-pair
- collector (xaccAccountGetCommodity account) #f))))
+ (cadr (collector 'getpair (xaccAccountGetCommodity account) #f))))
;; This works similar as above but returns a commodity-collector,
;; thus takes care of children accounts with different currencies.
@@ -434,7 +411,7 @@
(if include-children?
(for-each
(lambda (x)
- (gnc-commodity-collector-merge balance-collector x))
+ (balance-collector 'merge x #f))
(gnc:account-map-descendants
(lambda (child)
(gnc:account-get-comm-balance-at-date child date #f))
@@ -454,9 +431,9 @@
(qof-query-destroy query)
(if (and splits (not (null? splits)))
- (gnc-commodity-collector-add balance-collector
- (xaccAccountGetCommodity account)
- (xaccSplitGetBalance (car splits))))
+ (balance-collector 'add
+ (xaccAccountGetCommodity account)
+ (xaccSplitGetBalance (car splits))))
balance-collector))
;; Calculate the increase in the balance of the account in terms of
@@ -473,7 +450,7 @@
(if include-children?
(for-each
(lambda (x)
- (gnc-commodity-collector-merge value-collector x))
+ (value-collector 'merge x #f))
(gnc:account-map-descendants
(lambda (d)
(gnc:account-get-comm-value-interval d start-date end-date #f))
@@ -520,10 +497,10 @@
(let ((collector (gnc:make-commodity-collector)))
(for-each
(lambda (acct)
- ((if (reverse-balance-fn acct)
- gnc-commodity-collector-minusmerge
- gnc-commodity-collector-merge)
- collector (get-balance-fn acct)))
+ (collector
+ (if (reverse-balance-fn acct) 'minusmerge 'merge)
+ (get-balance-fn acct)
+ #f))
accounts)
collector))
@@ -576,8 +553,7 @@
(define (gnc:account-get-balance-interval account from to include-children?)
(let ((collector (gnc:account-get-comm-balance-interval
account from to include-children?)))
- (cadr (gnc-commodity-collector-assoc-pair
- collector (xaccAccountGetCommodity account) #f))))
+ (cadr (collector 'getpair (xaccAccountGetCommodity account) #f))))
;; the version which returns a commodity-collector
(define (gnc:account-get-comm-balance-interval account from to include-children?)
@@ -672,17 +648,12 @@
(xaccSplitGetAccount split)))
(txn (xaccSplitGetParent split)))
(if type
- (gnc-commodity-collector-add total acct-comm shares)
- (if (not (xaccTransGetIsClosingTxn txn))
- (gnc-commodity-collector-add total acct-comm shares)
- )))
- )
+ (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)
- )
- total
- )
- )
+ 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))
@@ -694,7 +665,7 @@
(let* ((shares (xaccSplitGetAmount split))
(acct-comm (xaccAccountGetCommodity
(xaccSplitGetAccount split))))
- (gnc-commodity-collector-add total acct-comm shares)))
+ (total 'add acct-comm shares)))
(gnc:account-get-trans-type-splits-interval
account-list type start-date end-date))
total))
@@ -773,7 +744,7 @@
(xaccSplitGetAccount split)))
)
(or (gnc-numeric-negative-p shares)
- (gnc-commodity-collector-add total acct-comm shares)
+ (total 'add acct-comm shares)
)
)
)
commit 4f90663c9a4db834f032a7757208802e50ab1aa4
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Aug 31 21:19:30 2018 +0800
[report-utilities] rewrite list-set-safe! using named let
This avoids some set! calls
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index 2b37031..baa12da 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -24,17 +24,15 @@
(list-ref list elt)))
(define (list-set-safe! l elt val)
- (if (and (list? l) (> (length l) elt))
+ (unless (list? l)
+ (set! l '()))
+ (if (> (length l) elt)
(list-set! l elt val)
- (let ((filler (list val)))
- (if (not (list? l))
- (set! l '()))
- (let loop ((i (length l)))
- (if (< i elt)
- (begin
- (set! filler (cons #f filler))
- (loop (+ 1 i)))))
- (set! l (append! l filler))))
+ (let loop ((filler (list val))
+ (i (length l)))
+ (if (< i elt)
+ (loop (cons #f filler) (1+ i))
+ (set! l (append! l filler)))))
l)
;; pair is a list of one gnc:commodity and one gnc:numeric
commit 7a63fab04a01fd029a337cc0eb37a1e0e882d447
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Aug 30 23:09:10 2018 +0800
[report-utilities] convert functions to srfi-1
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index 26bb587..2b37031 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -145,10 +145,8 @@
;; Get all children of this list of accounts.
(define (gnc:acccounts-get-all-subaccounts accountlist)
- (append-map
- (lambda (a)
- (gnc-account-get-descendants-sorted a))
- accountlist))
+ (append-map gnc-account-get-descendants-sorted
+ accountlist))
;;; Here's a statistics collector... Collects max, min, total, and makes
;;; it easy to get at the mean.
@@ -412,10 +410,8 @@
;; Returns zero if all entries in this collector are zero.
(define (gnc-commodity-collector-allzero? collector)
(every zero?
- (gnc-commodity-collector-map
- collector
- (lambda (commodity amount)
- amount))))
+ (map gnc:gnc-monetary-amount
+ (collector 'format gnc:make-gnc-monetary #f))))
;; get the account balance at the specified date. if include-children?
;; is true, the balances of all children (not just direct children)
@@ -586,15 +582,11 @@
collector (xaccAccountGetCommodity account) #f))))
;; the version which returns a commodity-collector
-(define (gnc:account-get-comm-balance-interval
- account from to include-children?)
- (let ((account-list (if include-children?
- (let ((sub-accts (gnc-account-get-descendants-sorted account)))
- (if sub-accts
- (append (list account) sub-accts)
- (list account)))
- (list account))))
- (gnc:account-get-trans-type-balance-interval account-list #f from to)))
+(define (gnc:account-get-comm-balance-interval account from to include-children?)
+ (let ((sub-accts (gnc-account-get-descendants-sorted account)))
+ (gnc:account-get-trans-type-balance-interval
+ (cons account (or (and include-children? sub-accts) '()))
+ #f from to)))
;; This calculates the increase in the balance(s) of all accounts in
;; <accountlist> over the period from <from-date> to <to-date>.
@@ -1003,38 +995,37 @@
;;
;; Returns a gnc-numeric value
(define (gnc:budget-account-get-rolledup-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-numeric-zero))
- (acct-comm (xaccAccountGetCommodity account)))
- (while (< period end-period)
- (set! net (gnc-numeric-add net
- (gnc:get-account-period-rolledup-budget-value budget account period)
- GNC-DENOM-AUTO GNC-RND-ROUND))
- (set! period (+ period 1)))
- net))
+ (let* ((start (or start-period 0))
+ (end (or end-period (gnc-budget-get-num-periods budget)))
+ (numperiods (- end start -1)))
+ (apply +
+ (map
+ (lambda (period)
+ (gnc:get-account-period-rolledup-budget-value budget account period))
+ (iota numperiods start 1)))))
+
+;; ***************************************************************************
+;; The following 3 functions belong together
+;; Input: accounts, get-balance-fn
+;; Output: account-balances, a list of 2-element lists
(define (gnc:get-assoc-account-balances accounts get-balance-fn)
- (let*
- (
- (initial-balances (list)))
- (for-each
- (lambda (account)
- (set! initial-balances
- (append initial-balances
- (list (list account (get-balance-fn account))))))
- accounts)
- initial-balances))
+ (map
+ (lambda (acct)
+ (list acct (get-balance-fn acct)))
+ accounts))
+;; Input: account-balances, account
+;; Output: commodity-collector
(define (gnc:select-assoc-account-balance account-balances account)
- (let ((account-balance (car account-balances)))
- (and (pair? account-balance)
- (if (equal? (car account-balance) account)
- (cadr account-balance)
- (gnc:select-assoc-account-balance
- (cdr account-balances)
- account)))))
-
+ (let ((found (find
+ (lambda (acct-bal)
+ (equal? (car acct-bal) account))
+ account-balances)))
+ (and found (cadr found))))
+
+;; Input: account-balances
+;; Output: commodity-collector
(define (gnc:get-assoc-account-balances-total account-balances)
(let ((total (gnc:make-commodity-collector)))
(for-each
@@ -1042,6 +1033,7 @@
(total 'merge (cadr account-balance) #f))
account-balances)
total))
+;; ***************************************************************************
;; Adds "file:///" to the beginning of a URL if it doesn't already exist
;;
commit 0144055c4339c202e029ec0508fd5e5df69bfba0
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Aug 30 23:08:43 2018 +0800
[report-utilities] compact functions. no refactoring.
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index 3ffaeb9..26bb587 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -699,21 +699,15 @@
;; 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)
- (let* ((total (gnc:make-commodity-collector)))
+ (let ((total (gnc:make-commodity-collector)))
(map (lambda (split)
(let* ((shares (xaccSplitGetAmount split))
(acct-comm (xaccAccountGetCommodity
- (xaccSplitGetAccount split)))
- )
- (gnc-commodity-collector-add total acct-comm shares)
- )
- )
+ (xaccSplitGetAccount split))))
+ (gnc-commodity-collector-add total acct-comm shares)))
(gnc:account-get-trans-type-splits-interval
- account-list type start-date end-date)
- )
- total
- )
- )
+ account-list type start-date end-date))
+ total))
;; Filters the splits from the source to the target accounts
;; returns a commodity collector
@@ -904,15 +898,11 @@
(define (gnc:budget-accountlist-helper accountlist get-fn)
- (let
- (
- (net (gnc:make-commodity-collector)))
+ (let ((net (gnc:make-commodity-collector)))
(for-each
- (lambda (account)
- (net 'merge
- (get-fn account)
- #f))
- accountlist)
+ (lambda (account)
+ (net 'merge (get-fn account) #f))
+ accountlist)
net))
;; Sums budget values for a single account from start-period (inclusive) to
@@ -923,17 +913,14 @@
;;
;; Returns a commodity-collector.
(define (gnc:budget-account-get-net budget account start-period end-period)
- (if (not start-period) (set! start-period 0))
(if (not end-period) (set! end-period (gnc-budget-get-num-periods budget)))
- (let*
- (
- (period start-period)
- (net (gnc:make-commodity-collector))
- (acct-comm (xaccAccountGetCommodity account)))
+ (let* ((period (or start-period 0))
+ (net (gnc:make-commodity-collector))
+ (acct-comm (xaccAccountGetCommodity account)))
(while (< period end-period)
(net 'add acct-comm
- (gnc-budget-get-account-period-value budget account period))
- (set! period (+ period 1)))
+ (gnc-budget-get-account-period-value budget account period))
+ (set! period (1+ period)))
net))
;; Sums budget values for accounts in accountlist from start-period (inclusive)
@@ -1016,17 +1003,14 @@
;;
;; Returns a gnc-numeric value
(define (gnc:budget-account-get-rolledup-net budget account start-period end-period)
- (if (not start-period) (set! start-period 0))
(if (not end-period) (set! end-period (gnc-budget-get-num-periods budget)))
- (let*
- (
- (period start-period)
- (net (gnc-numeric-zero))
- (acct-comm (xaccAccountGetCommodity account)))
+ (let* ((period (or start-period 0))
+ (net (gnc-numeric-zero))
+ (acct-comm (xaccAccountGetCommodity account)))
(while (< period end-period)
(set! net (gnc-numeric-add net
- (gnc:get-account-period-rolledup-budget-value budget account period)
- GNC-DENOM-AUTO GNC-RND-ROUND))
+ (gnc:get-account-period-rolledup-budget-value budget account period)
+ GNC-DENOM-AUTO GNC-RND-ROUND))
(set! period (+ period 1)))
net))
@@ -1043,29 +1027,20 @@
initial-balances))
(define (gnc:select-assoc-account-balance account-balances account)
- (let*
- (
- (account-balance (car account-balances))
- (result
- (if
- (equal? account-balance '())
- #f
- (if
- (equal? (car account-balance) account)
- (car (cdr account-balance))
- (gnc:select-assoc-account-balance
+ (let ((account-balance (car account-balances)))
+ (and (pair? account-balance)
+ (if (equal? (car account-balance) account)
+ (cadr account-balance)
+ (gnc:select-assoc-account-balance
(cdr account-balances)
account)))))
- result))
(define (gnc:get-assoc-account-balances-total account-balances)
- (let
- (
- (total (gnc:make-commodity-collector)))
+ (let ((total (gnc:make-commodity-collector)))
(for-each
- (lambda (account-balance)
- (total 'merge (car (cdr account-balance)) #f))
- account-balances)
+ (lambda (account-balance)
+ (total 'merge (cadr account-balance) #f))
+ account-balances)
total))
;; Adds "file:///" to the beginning of a URL if it doesn't already exist
commit 512dd7c73cd86fe6f9beef71ee66f11b70c68846
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Aug 30 22:29:55 2018 +0800
[report-utilities] compact gnc:get-account-period-rolledup-budget-value
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index 00ef51e..3ffaeb9 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -980,18 +980,10 @@
;; Return value:
;; budget value to use for account for specified period.
(define (budget-account-sum budget children period)
- (let* ((sum
- (cond
- ((null? children) (gnc-numeric-zero))
- (else
- (gnc-numeric-add
- (gnc:get-account-period-rolledup-budget-value budget (car children) period)
- (budget-account-sum budget (cdr children) period)
- GNC-DENOM-AUTO GNC-RND-ROUND))
- )
- ))
- sum)
-)
+ (apply + (map
+ (lambda (child)
+ (gnc:get-account-period-rolledup-budget-value budget child period))
+ children)))
;; Calculate the value to use for the budget of an account for a specific period.
;; - If the account has a budget value set for the period, use it
@@ -1007,14 +999,11 @@
;; sum of all budgets for list of children for specified period.
(define (gnc:get-account-period-rolledup-budget-value budget acct period)
(let* ((bgt-set? (gnc-budget-is-account-period-value-set budget acct period))
- (children (gnc-account-get-children acct))
- (amount (cond
- (bgt-set? (gnc-budget-get-account-period-value budget acct period))
- ((not (null? children)) (budget-account-sum budget children period))
- (else (gnc-numeric-zero)))
- ))
- amount)
-)
+ (children (gnc-account-get-children acct)))
+ (cond
+ (bgt-set? (gnc-budget-get-account-period-value budget acct period))
+ ((not (null? children)) (budget-account-sum budget children period))
+ (else 0))))
;; Sums rolled-up budget values for a single account from start-period (inclusive) to
;; end-period (exclusive).
commit 18087033540662a34e6e95fe30d8c4e5795d2cdd
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Aug 30 22:21:03 2018 +0800
[report-utilities] compact gnc:account-get-total-flow
This commit compacts function while maintaining legibility
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index 39ef6f7..00ef51e 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -668,10 +668,7 @@
;; function to count the total number of splits to be iterated
(define (gnc:accounts-count-splits accounts)
- (if (not (null? accounts))
- (+ (length (xaccAccountGetSplitList (car accounts)))
- (gnc:accounts-count-splits (cdr accounts)))
- 0))
+ (apply + (map length (map xaccAccountGetSplitList accounts))))
;; 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))
@@ -722,68 +719,22 @@
;; returns a commodity collector
;; does NOT do currency exchanges
(define (gnc:account-get-total-flow direction target-account-list from-date to-date)
-
- (let* (
- (total-flow (gnc:make-commodity-collector))
- )
-
- ;; ------------------------------------------------------------------
- ;; process all target accounts
- ;; ------------------------------------------------------------------
+ (let ((total-flow (gnc:make-commodity-collector)))
(for-each
- (lambda (target-account)
- ;; -------------------------------------
- ;; process all splits of current account
- ;; -------------------------------------
- (for-each
- (lambda (target-account-split)
- ;; ----------------------------------------------------
- ;; only target account splits that are within the specified time range
- ;; ----------------------------------------------------
- (let* (
- (transaction (xaccSplitGetParent target-account-split))
- (transaction-date-posted (xaccTransGetDate transaction))
- )
- (if (and
- (<= transaction-date-posted to-date)
- (>= transaction-date-posted from-date)
- )
- ;; -------------------------------------------------------------
- ;; get the split information
- ;; -------------------------------------------------------------
- (let* (
- (transaction-currency (xaccTransGetCurrency transaction))
- (transaction-value (gnc-numeric-zero))
- (split-value (xaccSplitGetAmount target-account-split))
- )
- ;; -------------------------------------------------------------
- ;; update the return value
- ;; -------------------------------------------------------------
- (case direction
- ((in)
- (if (gnc-numeric-positive-p split-value)
- (total-flow 'add transaction-currency split-value)
- )
- )
- ((out)
- (if (gnc-numeric-negative-p split-value)
- (total-flow 'add transaction-currency split-value)
- )
- )
- (else (gnc:warn "bad gnc:account-get-total-flow action: " direction))
- )
- )
- )
- )
- )
- (xaccAccountGetSplitList target-account)
- )
- )
- target-account-list
- )
- total-flow ;; RETURN
- )
-)
+ (lambda (target-account)
+ (for-each
+ (lambda (target-account-split)
+ (let* ((transaction (xaccSplitGetParent target-account-split))
+ (split-value (xaccSplitGetAmount target-account-split)))
+ (if (and (<= from-date (xaccTransGetDate transaction) to-date)
+ (or (and (eq? direction 'in)
+ (positive? split-value))
+ (and (eq? direction 'out)
+ (negative? split-value))))
+ (total-flow 'add (xaccTransGetCurrency transaction) split-value))))
+ (xaccAccountGetSplitList target-account)))
+ target-account-list)
+ total-flow))
;; similar, but only counts transactions with non-negative shares and
;; *ignores* any closing entries
commit b85f54a2874b036c84b6f69d1c49347779dacf78
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Aug 30 17:05:40 2018 +0800
[report-utilities] commodity-collector: simplify
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index 655c8af..39ef6f7 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -20,9 +20,8 @@
(use-modules (srfi srfi-13))
(define (list-ref-safe list elt)
- (if (> (length list) elt)
- (list-ref list elt)
- #f))
+ (and (> (length list) elt)
+ (list-ref list elt)))
(define (list-set-safe! l elt val)
(if (and (list? l) (> (length l) elt))
@@ -349,31 +348,19 @@
clist))
;; helper function which is given a commodity and returns, if
- ;; existing, a list (gnc:commodity gnc:numeric). If the second
- ;; argument was #t, the sign gets reversed.
+ ;; existing, a list (gnc:commodity gnc:numeric).
(define (getpair c sign?)
- (let ((pair (assoc c commoditylist)))
- (cons c (cons
- (if (not pair)
- (gnc-numeric-zero)
- (if sign?
- (gnc-numeric-neg
- (gnc:value-collector-total (cadr pair)))
- (gnc:value-collector-total (cadr pair))))
- '()))))
+ (let* ((pair (assoc c commoditylist))
+ (total (and pair (gnc:value-collector-total (cadr pair)))))
+ (list c (if pair (if sign? (- total) total) 0))))
;; helper function which is given a commodity and returns, if
- ;; existing, a <gnc:monetary> value. If the second argument was
- ;; #t, the sign gets reversed.
+ ;; existing, a <gnc:monetary> value.
(define (getmonetary c sign?)
- (let ((pair (assoc c commoditylist)))
+ (let* ((pair (assoc c commoditylist))
+ (total (and pair (gnc:value-collector-total (cadr pair)))))
(gnc:make-gnc-monetary
- c (if (not pair)
- (gnc-numeric-zero)
- (if sign?
- (gnc-numeric-neg
- (gnc:value-collector-total (cadr pair)))
- (gnc:value-collector-total (cadr pair)))))))
+ c (if pair (if sign? (- total) total) 0))))
;; Dispatch function
(lambda (action commodity amount)
@@ -391,14 +378,12 @@
(else (gnc:warn "bad commodity-collector action: " action))))))
(define (gnc:commodity-collector-get-negated collector)
- (let
- ((negated (gnc:make-commodity-collector)))
+ (let ((negated (gnc:make-commodity-collector)))
(negated 'minusmerge collector #f)
negated))
(define (gnc:commodity-collectorlist-get-merged collectorlist)
- (let
- ((merged (gnc:make-commodity-collector)))
+ (let ((merged (gnc:make-commodity-collector)))
(for-each (lambda (collector) (merged 'merge collector #f)) collectorlist)
merged))
commit b21874df0bc77ca3760cd45b139ddaf5d78730dd
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Aug 31 23:19:12 2018 +0800
[obsolete api] gnc-commodity-numeric->string to gnc:monetary->string
diff --git a/gnucash/report/report-system/commodity-utilities.scm b/gnucash/report/report-system/commodity-utilities.scm
index 6e3db88..3946b98 100644
--- a/gnucash/report/report-system/commodity-utilities.scm
+++ b/gnucash/report/report-system/commodity-utilities.scm
@@ -94,6 +94,7 @@
;; Helper for warnings below.
(define (gnc-commodity-numeric->string commodity numeric)
+ (issue-deprecation-warning "gnc-commodity-numeric->string deprecated.")
(gnc:monetary->string
(gnc:make-gnc-monetary commodity numeric)))
@@ -157,13 +158,6 @@
value-amount share-amount))
#f)))
- ;;(warn "gnc:get-commodity-totalavg-prices: value "
- ;; (gnc-commodity-numeric->string
- ;;(first foreignlist) (second foreignlist))
- ;; " bought shares "
- ;; (gnc-commodity-numeric->string
- ;;price-commodity (third foreignlist)))
-
;; Try EURO exchange if necessary
(if (and foreignlist
(not (gnc-commodity-equiv (first foreignlist)
@@ -185,14 +179,17 @@
(begin
(warn "gnc:get-commodity-totalavg-prices: "
"Sorry, currency exchange not yet implemented:"
- (gnc-commodity-numeric->string
- (first foreignlist) (second foreignlist))
+ (gnc:monetary->string
+ (gnc:make-gnc-monetary
+ (first foreignlist) (second foreignlist)))
" (buying "
- (gnc-commodity-numeric->string
- price-commodity (third foreignlist))
+ (gnc:monetary->string
+ (gnc:make-gnc-monetary
+ price-commodity (third foreignlist)))
") =? "
- (gnc-commodity-numeric->string
- report-currency (gnc-numeric-zero)))
+ (gnc:monetary->string
+ (gnc:make-gnc-monetary
+ report-currency (gnc-numeric-zero))))
(gnc-numeric-zero))
(begin
(set! total-foreign (gnc-numeric-add total-foreign
@@ -272,13 +269,6 @@
(list transaction-comm
value-amount share-amount))))
- ;;(warn "get-commodity-inst-prices: value "
- ;; (gnc-commodity-numeric->string
- ;; (first foreignlist) (second foreignlist))
- ;; " bought shares "
- ;;(gnc-commodity-numeric->string
- ;; price-commodity (third foreignlist)))
-
;; Try EURO exchange if necessary
(if (not (gnc-commodity-equiv (first foreignlist)
report-currency))
@@ -298,14 +288,17 @@
(begin
(warn "get-commodity-inst-prices: "
"Sorry, currency exchange not yet implemented:"
- (gnc-commodity-numeric->string
- (first foreignlist) (second foreignlist))
- " (buying "
- (gnc-commodity-numeric->string
- price-commodity (third foreignlist))
- ") =? "
- (gnc-commodity-numeric->string
- report-currency (gnc-numeric-zero)))
+ (gnc:monetary->string
+ (gnc:make-gnc-monetary
+ (first foreignlist) (second foreignlist)))
+ " (buying "
+ (gnc:monetary->string
+ (gnc:make-gnc-monetary
+ price-commodity (third foreignlist)))
+ ") =? "
+ (gnc:monetary->string
+ (gnc:make-gnc-monetary
+ report-currency (gnc-numeric-zero))))
(gnc-numeric-zero))
(if (not (zero? (third foreignlist)))
(gnc-numeric-div
diff --git a/gnucash/report/report-system/html-acct-table.scm b/gnucash/report/report-system/html-acct-table.scm
index c7a2173..4072ea6 100644
--- a/gnucash/report/report-system/html-acct-table.scm
+++ b/gnucash/report/report-system/html-acct-table.scm
@@ -675,9 +675,6 @@
(acct-comm (xaccAccountGetCommodity acct))
(shares (xaccSplitGetAmount split))
(hash (hash-ref hash-table guid)))
-; (gnc:debug "Merging split for " (xaccAccountGetName acct) " for "
-; (gnc-commodity-numeric->string acct-comm shares)
-; " into hash entry " hash)
(if (not hash)
(begin (set! hash (gnc:make-commodity-collector))
(hash-set! hash-table guid hash)))
diff --git a/gnucash/report/standard-reports/advanced-portfolio.scm b/gnucash/report/standard-reports/advanced-portfolio.scm
index b834d5b..3b3953f 100644
--- a/gnucash/report/standard-reports/advanced-portfolio.scm
+++ b/gnucash/report/standard-reports/advanced-portfolio.scm
@@ -535,7 +535,8 @@ by preventing negative stock balances.<br/>")
;; Now that we have a pricing transaction if needed, set the value of the asset
(set! value (my-exchange-fn (gnc:make-gnc-monetary commodity units) currency))
(gnc:debug "Value " (gnc:monetary->string value)
- " from " (gnc-commodity-numeric->string commodity units))
+ " from " (gnc:monetary->string
+ (gnc:make-gnc-monetary commodity units)))
(for-each
;; we're looking at each split we find in the account. these splits
commit cb01c93a0fa7d43b670290fb5f0135f9ab9dd6a4
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Aug 31 23:16:41 2018 +0800
[obsolete api] gnc-commodity-value->string to gnc:monetary->string
diff --git a/gnucash/report/report-system/commodity-utilities.scm b/gnucash/report/report-system/commodity-utilities.scm
index c1333d5..6e3db88 100644
--- a/gnucash/report/report-system/commodity-utilities.scm
+++ b/gnucash/report/report-system/commodity-utilities.scm
@@ -487,14 +487,14 @@
;; resolve the exchange rate to this currency.
(warn "gnc:resolve-unknown-comm:"
"can't calculate rate for "
- (gnc-commodity-value->string
- (list (car pair) ((caadr pair) 'total #f)))
+ (gnc:monetary->string
+ (gnc:make-gnc-monetary (car pair) ((caadr pair) 'total #f)))
" = "
- (gnc-commodity-value->string
- (list (car otherlist) ((cdadr pair) 'total #f)))
+ (gnc:monetary->string
+ (gnc:make-gnc-monetary (car otherlist) ((cdadr pair) 'total #f)))
" to "
- (gnc-commodity-value->string
- (list report-commodity (gnc-numeric-zero))))
+ (gnc:monetary->string
+ (gnc:make-gnc-monetary report-commodity (gnc-numeric-zero))))
(if (and pair-a pair-b)
;; If both currencies are found then something
;; went wrong inside
@@ -502,11 +502,11 @@
;; better thing to do in this case.
(warn "gnc:resolve-unknown-comm:"
"Oops - exchange rate ambiguity error: "
- (gnc-commodity-value->string
- (list (car pair) ((caadr pair) 'total #f)))
+ (gnc:monetary->string
+ (gnc:make-gnc-monetary (car pair) ((caadr pair) 'total #f)))
" = "
- (gnc-commodity-value->string
- (list (car otherlist)
+ (gnc:monetary->string
+ (gnc:make-gnc-monetary (car otherlist)
((cdadr pair) 'total #f))))
(let
;; Usual case: one of pair-{a,b} was found
@@ -520,23 +520,12 @@
(list (car pair)
(make-newrate (caadr pair)
(cdadr pair) pair-a)))))
- ;; (warn "created new rate: "
- ;; (gnc-commodity-value->string (list (car
- ;; newrate) ((caadr newrate) 'total #f))) "
- ;; = " (gnc-commodity-value->string (list
- ;; report-commodity ((cdadr newrate) 'total
- ;; #f))))
(set! reportlist (cons newrate reportlist))))))
;; Huh, the report-currency showed up on the wrong side
;; -- we will just add it to the reportlist on the
;; right side.
(let ((newrate (list (car otherlist)
(cons (cdadr pair) (caadr pair)))))
- ;; (warn "created new rate: "
- ;; (gnc-commodity-value->string (list (car newrate)
- ;; ((caadr newrate) 'total #f))) " = "
- ;; (gnc-commodity-value->string (list
- ;; report-commodity ((cdadr newrate) 'total #f))))
(set! reportlist (cons newrate reportlist)))))
(cadr otherlist))))
sumlist)
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index 288f47b..655c8af 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -41,6 +41,7 @@
;; pair is a list of one gnc:commodity and one gnc:numeric
;; value. Deprecated -- use <gnc-monetary> instead.
(define (gnc-commodity-value->string pair)
+ (issue-deprecation-warning "gnc-commodity-value->string deprecated")
(xaccPrintAmount
(cadr pair) (gnc-commodity-print-info (car pair) #t)))
diff --git a/gnucash/report/standard-reports/advanced-portfolio.scm b/gnucash/report/standard-reports/advanced-portfolio.scm
index 0f382ee..b834d5b 100644
--- a/gnucash/report/standard-reports/advanced-portfolio.scm
+++ b/gnucash/report/standard-reports/advanced-portfolio.scm
@@ -473,10 +473,10 @@ by preventing negative stock balances.<br/>")
(exchange-fn fromunits tocurrency)))
(gnc:debug "Starting account " (xaccAccountGetName current) ", initial price: "
- (if price
- (gnc-commodity-value->string
- (list (gnc-price-get-currency price) (gnc-price-get-value price)))
- #f))
+ (and price
+ (gnc:monetary->string
+ (gnc:make-gnc-monetary
+ (gnc-price-get-currency price) (gnc-price-get-value price)))))
;; If we have a price that can't be converted to the report currency
;; don't use it
commit 89f8c8dc12d5b4a924a6dce69ee1ccb11753e5f3
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat Sep 1 11:13:31 2018 +0800
[commodity|report-utilities] simplify functions, convert to srfi-1
these functions are not used elsewhere and should be inlined. however
they are exported and must be retained for now.
diff --git a/gnucash/report/report-system/commodity-utilities.scm b/gnucash/report/report-system/commodity-utilities.scm
index bbfe590..c1333d5 100644
--- a/gnucash/report/report-system/commodity-utilities.scm
+++ b/gnucash/report/report-system/commodity-utilities.scm
@@ -20,16 +20,6 @@
;; Boston, MA 02110-1301, USA gnu at gnu.org
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (gnc-commodity-collector-contains-commodity? collector commodity)
- (let ((ret #f))
- (gnc-commodity-collector-map
- collector
- (lambda (comm amt)
- (set! ret (or ret (gnc-commodity-equiv comm commodity)))))
- ret
- ))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions to get splits with interesting data from accounts.
@@ -1063,23 +1053,19 @@
#f)
balance)))
-;; Returns the number of commodities in a commodity-collector.
-;; (If this were implemented as a record, I would be able to
-;; just (length ...) the alist, but....)
(define (gnc-commodity-collector-commodity-count collector)
- (let ((commodities 0))
- (gnc-commodity-collector-map
- collector
- (lambda (comm amt)
- (set! commodities (+ commodities 1))))
- commodities
- ))
+ (length (collector 'format (lambda (comm amt) comm) #f)))
+
+(define (gnc-commodity-collector-contains-commodity? collector commodity)
+ (member commodity
+ (collector 'format (lambda (comm amt) comm) #f)
+ gnc-commodity-equiv))
(define (gnc:uniform-commodity? amt report-commodity)
;; function to see if the commodity-collector amt
;; contains any foreign commodities
(let ((elts (gnc-commodity-collector-commodity-count amt)))
- (or (equal? elts 0)
- (and (equal? elts 1)
+ (or (zero? elts)
+ (and (= elts 1)
(gnc-commodity-collector-contains-commodity?
amt report-commodity)))))
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index 3ce1255..288f47b 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -425,14 +425,11 @@
;; Returns zero if all entries in this collector are zero.
(define (gnc-commodity-collector-allzero? collector)
- (let ((result #t))
- (gnc-commodity-collector-map
- collector
- (lambda (commodity amount)
- (if (not (gnc-numeric-zero-p amount))
- (set! result #f))))
- result))
-
+ (every zero?
+ (gnc-commodity-collector-map
+ collector
+ (lambda (commodity amount)
+ amount))))
;; get the account balance at the specified date. if include-children?
;; is true, the balances of all children (not just direct children)
commit eac79bd506395120fb986538ab4509e11ef2d365
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Aug 29 22:21:40 2018 +0800
[commodity-utilities] simplify boolean functions
(if a b #f) -> (and a b)
(if a a b) -> (or a b)
diff --git a/gnucash/report/report-system/commodity-utilities.scm b/gnucash/report/report-system/commodity-utilities.scm
index b21e906..bbfe590 100644
--- a/gnucash/report/report-system/commodity-utilities.scm
+++ b/gnucash/report/report-system/commodity-utilities.scm
@@ -398,8 +398,7 @@
(let ((price
(gnc:pricelist-price-find-nearest
plist date)))
- (if price
- price
+ (or price
(gnc-numeric-zero)))
(gnc-numeric-zero))))
@@ -785,9 +784,8 @@
;; #f if the commodities don't match. Therefore, if you use this
;; function in a mixed commodity context, stuff will probably crash.
(define (gnc:exchange-if-same foreign domestic)
- (if (gnc-commodity-equiv (gnc:gnc-monetary-commodity foreign) domestic)
- foreign
- #f))
+ (and (gnc-commodity-equiv (gnc:gnc-monetary-commodity foreign) domestic)
+ foreign))
;; This one returns the ready-to-use function for calculation of the
;; exchange rates. The returned function takes a <gnc-monetary> and
@@ -798,43 +796,41 @@
(lambda (foreign domestic)
(gnc:debug "foreign: " (gnc:monetary->string foreign))
(gnc:debug "domestic: " (gnc-commodity-get-printname domestic))
- (if foreign
- (or (gnc:exchange-by-euro foreign domestic #f)
- (gnc:exchange-if-same foreign domestic)
- (gnc:make-gnc-monetary
- domestic
- (let ((pair (assoc (gnc:gnc-monetary-commodity foreign)
- exchangelist))
- (foreign-amount (gnc:gnc-monetary-amount foreign)))
- (if (or (not pair)
- (gnc-numeric-zero-p foreign-amount))
- (gnc-numeric-zero)
- (gnc-numeric-mul foreign-amount
- (cadr pair)
- (gnc-commodity-get-fraction domestic)
- GNC-RND-ROUND)))))
- #f))))
+ (and foreign
+ (or (gnc:exchange-by-euro foreign domestic #f)
+ (gnc:exchange-if-same foreign domestic)
+ (gnc:make-gnc-monetary
+ domestic
+ (let ((pair (assoc (gnc:gnc-monetary-commodity foreign)
+ exchangelist))
+ (foreign-amount (gnc:gnc-monetary-amount foreign)))
+ (if (or (not pair)
+ (gnc-numeric-zero-p foreign-amount))
+ (gnc-numeric-zero)
+ (gnc-numeric-mul foreign-amount
+ (cadr pair)
+ (gnc-commodity-get-fraction domestic)
+ GNC-RND-ROUND)))))))))
;; Helper for the gnc:exchange-by-pricalist* below. Exchange the
;; <gnc:monetary> 'foreign' into the <gnc:commodity*> 'domestic' by
;; the <gnc:numeric> 'price-value'. Returns a <gnc:monetary>.
(define (gnc:exchange-by-pricevalue-helper
foreign domestic price-value)
- (if (gnc:gnc-monetary? foreign)
- (gnc:make-gnc-monetary
- domestic
- (if price-value
- (gnc-numeric-mul (gnc:gnc-monetary-amount foreign)
- price-value
- (gnc-commodity-get-fraction domestic)
- GNC-RND-ROUND)
- (begin
- (warn "gnc:exchange-by-pricevalue-helper: No price found for "
- (gnc:monetary->string foreign) " into "
- (gnc:monetary->string
- (gnc:make-gnc-monetary domestic (gnc-numeric-zero))))
- (gnc-numeric-zero))))
- #f))
+ (and (gnc:gnc-monetary? foreign)
+ (gnc:make-gnc-monetary
+ domestic
+ (if price-value
+ (gnc-numeric-mul (gnc:gnc-monetary-amount foreign)
+ price-value
+ (gnc-commodity-get-fraction domestic)
+ GNC-RND-ROUND)
+ (begin
+ (warn "gnc:exchange-by-pricevalue-helper: No price found for "
+ (gnc:monetary->string foreign) " into "
+ (gnc:monetary->string
+ (gnc:make-gnc-monetary domestic (gnc-numeric-zero))))
+ (gnc-numeric-zero))))))
;; Helper for gnc:exchange-by-pricedb-* below. 'price' gets tested for
;; #f here, and gets unref'd here too. Exchange the <gnc:monetary>
@@ -842,24 +838,23 @@
;; 'price'. Returns a <gnc:monetary>.
(define (gnc:exchange-by-pricedb-helper
foreign domestic price)
- (if (gnc:gnc-monetary? foreign)
- (gnc:make-gnc-monetary
- domestic
- (if price
- (let ((result
- (gnc-numeric-mul (gnc:gnc-monetary-amount foreign)
- (gnc-price-get-value price)
- (gnc-commodity-get-fraction domestic)
- GNC-RND-ROUND)))
- (gnc-price-unref price)
- result)
- (begin
- (warn "gnc:exchange-by-pricedb-helper: No price found for "
- (gnc:monetary->string foreign) " into "
- (gnc:monetary->string
- (gnc:make-gnc-monetary domestic (gnc-numeric-zero))))
- (gnc-numeric-zero))))
- #f))
+ (and (gnc:gnc-monetary? foreign)
+ (gnc:make-gnc-monetary
+ domestic
+ (if price
+ (let ((result
+ (gnc-numeric-mul (gnc:gnc-monetary-amount foreign)
+ (gnc-price-get-value price)
+ (gnc-commodity-get-fraction domestic)
+ GNC-RND-ROUND)))
+ (gnc-price-unref price)
+ result)
+ (begin
+ (warn "gnc:exchange-by-pricedb-helper: No price found for "
+ (gnc:monetary->string foreign) " into "
+ (gnc:monetary->string
+ (gnc:make-gnc-monetary domestic (gnc-numeric-zero))))
+ (gnc-numeric-zero))))))
;; This is another ready-to-use function for calculation of exchange
;; rates. (Note that this is already the function itself. It doesn't
@@ -870,17 +865,17 @@
;; returns a <gnc-monetary>.
(define (gnc:exchange-by-pricedb-latest
foreign domestic)
- (if (and (record? foreign) (gnc:gnc-monetary? foreign))
- (or (gnc:exchange-by-euro foreign domestic #f)
- (gnc:exchange-if-same foreign domestic)
- (gnc:make-gnc-monetary
- domestic
- (gnc-pricedb-convert-balance-latest-price
- (gnc-pricedb-get-db (gnc-get-current-book))
- (gnc:gnc-monetary-amount foreign)
- (gnc:gnc-monetary-commodity foreign)
- domestic)))
- #f))
+ (and (record? foreign)
+ (gnc:gnc-monetary? foreign)
+ (or (gnc:exchange-by-euro foreign domestic #f)
+ (gnc:exchange-if-same foreign domestic)
+ (gnc:make-gnc-monetary
+ domestic
+ (gnc-pricedb-convert-balance-latest-price
+ (gnc-pricedb-get-db (gnc-get-current-book))
+ (gnc:gnc-monetary-amount foreign)
+ (gnc:gnc-monetary-commodity foreign)
+ domestic)))))
;; Yet another ready-to-use function for calculation of exchange
;; rates. (Note that this is already the function itself. It doesn't
@@ -892,18 +887,18 @@
;; <gnc-monetary>.
(define (gnc:exchange-by-pricedb-nearest
foreign domestic date)
- (if (and (record? foreign) (gnc:gnc-monetary? foreign)
- date)
- (or (gnc:exchange-by-euro foreign domestic date)
- (gnc:exchange-if-same foreign domestic)
- (gnc:make-gnc-monetary
- domestic
- (gnc-pricedb-convert-balance-nearest-price-t64
- (gnc-pricedb-get-db (gnc-get-current-book))
- (gnc:gnc-monetary-amount foreign)
- (gnc:gnc-monetary-commodity foreign)
- domestic (time64CanonicalDayTime date))))
- #f))
+ (and (record? foreign)
+ (gnc:gnc-monetary? foreign)
+ date
+ (or (gnc:exchange-by-euro foreign domestic date)
+ (gnc:exchange-if-same foreign domestic)
+ (gnc:make-gnc-monetary
+ domestic
+ (gnc-pricedb-convert-balance-nearest-price-t64
+ (gnc-pricedb-get-db (gnc-get-current-book))
+ (gnc:gnc-monetary-amount foreign)
+ (gnc:gnc-monetary-commodity foreign)
+ domestic (time64CanonicalDayTime date))))))
;; Exchange by the nearest price from pricelist. This function takes
;; the <gnc-monetary> 'foreign' amount, the <gnc:commodity*>
@@ -913,26 +908,19 @@
;; function returns a <gnc-monetary>.
(define (gnc:exchange-by-pricealist-nearest
pricealist foreign domestic date)
- (begin
- (gnc:debug "foreign " (gnc:monetary->string foreign))
- (gnc:debug "domestic " (gnc-commodity-get-printname domestic))
- (gnc:debug "pricealist " pricealist)
-
- (if (and (record? foreign) (gnc:gnc-monetary? foreign)
- date)
- (or (gnc:exchange-by-euro foreign domestic date)
- (gnc:exchange-if-same foreign domestic)
- (if (not (null? pricealist))
+ (gnc:debug "foreign " (gnc:monetary->string foreign))
+ (gnc:debug "domestic " (gnc-commodity-get-printname domestic))
+ (gnc:debug "pricealist " pricealist)
+ (and (record? foreign)
+ (gnc:gnc-monetary? foreign)
+ date
+ (or (gnc:exchange-by-euro foreign domestic date)
+ (gnc:exchange-if-same foreign domestic)
+ (and (pair? pricealist)
(gnc:exchange-by-pricevalue-helper
foreign domestic
(gnc:pricealist-lookup-nearest-in-time
- pricealist (gnc:gnc-monetary-commodity foreign) date))
- #f))
- #f)))
-
-
-
-
+ pricealist (gnc:gnc-monetary-commodity foreign) date))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Choosing exchange functions made easy -- get the right function by
@@ -1036,45 +1024,44 @@
;; Returns a <gnc-monetary> with the domestic commodity and its
;; corresponding balance. If the foreign balance is #f, it returns #f.
(define (gnc:sum-collector-commodity foreign domestic exchange-fn)
- (cond ((and foreign exchange-fn)
- (let ((balance (gnc:make-commodity-collector)))
- (foreign
- 'format
- (lambda (curr val)
- (if (gnc-commodity-equiv domestic curr)
- (balance 'add domestic val)
- (balance 'add domestic
- (gnc:gnc-monetary-amount
- ;; BUG?: this bombs if the exchange-fn
- ;; returns #f instead of an actual
- ;; <gnc:monetary>. Better to just return #f.
- (exchange-fn (gnc:make-gnc-monetary curr val)
- domestic)))))
- #f)
- (balance 'getmonetary domestic #f)))
- (else #f)))
+ (and foreign
+ exchange-fn
+ (let ((balance (gnc:make-commodity-collector)))
+ (foreign
+ 'format
+ (lambda (curr val)
+ (if (gnc-commodity-equiv domestic curr)
+ (balance 'add domestic val)
+ (balance 'add domestic
+ (gnc:gnc-monetary-amount
+ ;; BUG?: this bombs if the exchange-fn
+ ;; returns #f instead of an actual
+ ;; <gnc:monetary>. Better to just return #f.
+ (exchange-fn (gnc:make-gnc-monetary curr val)
+ domestic)))))
+ #f)
+ (balance 'getmonetary domestic #f))))
;; As above, but adds only the commodities of other stocks and
;; mutual-funds. Returns a commodity-collector, (not a <gnc:monetary>)
;; which (still) may have several different commodities in it -- if
;; there have been different *currencies*, not only stocks.
(define (gnc:sum-collector-stocks foreign domestic exchange-fn)
- (if foreign
- (let ((balance (gnc:make-commodity-collector)))
- (foreign
- 'format
- (lambda (curr val)
- (if (gnc-commodity-equiv domestic curr)
- (balance 'add domestic val)
- (if (gnc-commodity-is-currency curr)
- (balance 'add curr val)
- (balance 'add domestic
- (gnc:gnc-monetary-amount
- (exchange-fn (gnc:make-gnc-monetary curr val)
- domestic))))))
- #f)
- balance)
- #f))
+ (and foreign
+ (let ((balance (gnc:make-commodity-collector)))
+ (foreign
+ 'format
+ (lambda (curr val)
+ (if (gnc-commodity-equiv domestic curr)
+ (balance 'add domestic val)
+ (if (gnc-commodity-is-currency curr)
+ (balance 'add curr val)
+ (balance 'add domestic
+ (gnc:gnc-monetary-amount
+ (exchange-fn (gnc:make-gnc-monetary curr val)
+ domestic))))))
+ #f)
+ balance)))
;; Returns the number of commodities in a commodity-collector.
;; (If this were implemented as a record, I would be able to
commit 353eee58cbf6510682cc511b651273a0d363220c
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Mon Aug 20 10:34:39 2018 +0800
[transaction] convert collector map to for-each
collectors are accumulator-type objects, being mutated with each call,
rather than functional objects. (map) is meant for functional
constructs, returning a list to current continuation. We're not using
the (map) output, so, change it to (for-each) to emphasise this.
diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/standard-reports/transaction.scm
index 694e648..dbe2df6 100644
--- a/gnucash/report/standard-reports/transaction.scm
+++ b/gnucash/report/standard-reports/transaction.scm
@@ -1605,23 +1605,23 @@ be excluded from periodic reporting.")
(add-split-row othersplits calculated-cells def:alternate-row-style #f))
(delete current (xaccTransGetSplitList (xaccSplitGetParent current)))))
- (map (lambda (collector value)
- (if value
- (collector 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))))
- primary-subtotal-collectors
- split-values)
-
- (map (lambda (collector value)
- (if value
- (collector 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))))
- secondary-subtotal-collectors
- split-values)
-
- (map (lambda (collector value)
- (if value
- (collector 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))))
- total-collectors
- split-values)
+ (for-each
+ (lambda (collector value)
+ (if value
+ (collector 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))))
+ primary-subtotal-collectors split-values)
+
+ (for-each
+ (lambda (collector value)
+ (if value
+ (collector 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))))
+ secondary-subtotal-collectors split-values)
+
+ (for-each
+ (lambda (collector value)
+ (if value
+ (collector 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))))
+ total-collectors split-values)
(if (and primary-subtotal-comparator
(or (not next)
commit 83ad9e4b89c597e2087e2353682bd5b376184cf6
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Mon Aug 20 10:30:35 2018 +0800
[transaction] convert add-split-row to functional style
This commit removes need for row-contents, building a list of
table-cells directly.
diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/standard-reports/transaction.scm
index f286f21..694e648 100644
--- a/gnucash/report/standard-reports/transaction.scm
+++ b/gnucash/report/standard-reports/transaction.scm
@@ -1509,65 +1509,46 @@ be excluded from periodic reporting.")
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (add-split-row split cell-calculators row-style transaction-row?)
- (let* ((row-contents '())
- (trans (xaccSplitGetParent split))
- (account (xaccSplitGetAccount split)))
-
- (define left-cols
- (map (lambda (left-col)
- (let* ((col-fn (vector-ref left-col 1))
- (col-data (col-fn split transaction-row?)))
- col-data))
- left-columns))
-
- (define cells
- (map (lambda (cell)
- (let* ((calculator (vector-ref cell 1))
- (reverse? (vector-ref cell 2))
- (subtotal? (vector-ref cell 3))
- (calculated (calculator split)))
- (vector calculated
- reverse?
- subtotal?)))
- cell-calculators))
-
- (for-each (lambda (cell) (addto! row-contents cell))
- (gnc:html-make-empty-cells indent-level))
-
- (for-each (lambda (col)
- (addto! row-contents col))
- left-cols)
-
- (for-each (lambda (cell)
- (let ((cell-content (vector-ref cell 0))
- ;; reverse? returns a bool - will check if the cell type has reversible sign,
- ;; whether the account is also reversible according to Report Option, or
- ;; if Report Option follows Global Settings, will retrieve bool from it.
- (reverse? (and (vector-ref cell 1)
- (if account-types-to-reverse
- (member (xaccAccountGetType account) account-types-to-reverse)
- (gnc-reverse-balance account)))))
- (if cell-content
- (addto! row-contents
- (gnc:make-html-table-cell/markup
- "number-cell"
- (gnc:html-transaction-anchor
- trans
- ;; if conditions for reverse are satisfied, apply sign reverse to
- ;; monetary amount
- (if reverse?
- (gnc:monetary-neg cell-content)
- cell-content))))
- (addto! row-contents (gnc:html-make-empty-cell)))))
- cells)
-
- (if (not (column-uses? 'subtotals-only))
- (gnc:html-table-append-row/markup! table row-style (reverse row-contents)))
+ (let* ((account (xaccSplitGetAccount split))
+ (reversible-account? (if account-types-to-reverse
+ (member (xaccAccountGetType account)
+ account-types-to-reverse)
+ (gnc-reverse-balance account)))
+ (cells (map (lambda (cell)
+ (let* ((split->monetary (vector-ref cell 1)))
+ (vector (split->monetary split)
+ (vector-ref cell 2) ;reverse?
+ (vector-ref cell 3) ;subtotal?
+ )))
+ cell-calculators)))
+
+ (unless (column-uses? 'subtotals-only)
+ (gnc:html-table-append-row/markup!
+ table row-style
+ (append
+ (gnc:html-make-empty-cells indent-level)
+ (map (lambda (left-col)
+ ((vector-ref left-col 1)
+ split transaction-row?))
+ left-columns)
+ (map (lambda (cell)
+ (let ((cell-monetary (vector-ref cell 0))
+ (reverse? (and (vector-ref cell 1)
+ reversible-account?)))
+ (and cell-monetary
+ (gnc:make-html-table-cell/markup
+ "number-cell"
+ (gnc:html-transaction-anchor
+ (xaccSplitGetParent split)
+ (if reverse?
+ (gnc:monetary-neg cell-monetary)
+ cell-monetary))))))
+ cells))))
(map (lambda (cell)
- (let ((cell-content (vector-ref cell 0))
+ (let ((cell-monetary (vector-ref cell 0))
(subtotal? (vector-ref cell 2)))
- (and subtotal? cell-content)))
+ (and subtotal? cell-monetary)))
cells)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
commit f3100ddc0a2c90e4a1f267715767d13aa886caf6
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Mon Aug 20 10:16:01 2018 +0800
[transaction] convert add-subheading to functional style
This commit removes need for row-contents, building a list of
subheadings directly.
diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/standard-reports/transaction.scm
index f59bb52..f286f21 100644
--- a/gnucash/report/standard-reports/transaction.scm
+++ b/gnucash/report/standard-reports/transaction.scm
@@ -1305,10 +1305,8 @@ be excluded from periodic reporting.")
(define indent-level
(+ primary-indent secondary-indent))
-
(define (add-subheading data subheading-style split level)
- (let* ((row-contents '())
- (sortkey (opt-val pagename-sorting
+ (let* ((sortkey (opt-val pagename-sorting
(case level
((primary) optname-prime-sortkey)
((secondary) optname-sec-sortkey))))
@@ -1316,31 +1314,36 @@ be excluded from periodic reporting.")
((primary total) 0)
((secondary) primary-indent)))
(right-indent (- indent-level left-indent)))
- (for-each (lambda (cell) (addto! row-contents cell))
- (gnc:html-make-empty-cells left-indent))
- (if (and (opt-val pagename-sorting optname-show-informal-headers)
- (column-uses? 'amount-double)
- (member sortkey SORTKEY-INFORMAL-HEADERS))
- (begin
- (if export?
- (begin
- (addto! row-contents (gnc:make-html-table-cell data))
- (for-each (lambda (cell) (addto! row-contents cell))
- (gnc:html-make-empty-cells (+ right-indent width-left-columns -1))))
- (addto! row-contents (gnc:make-html-table-cell/size
- 1 (+ right-indent width-left-columns) data)))
- (for-each (lambda (cell)
- (addto! row-contents
- (gnc:make-html-text
- (gnc:html-markup-b
- ((vector-ref cell 5)
- ((keylist-get-info (sortkey-list BOOK-SPLIT-ACTION) sortkey 'renderer-fn) split))))))
- calculated-cells))
- (addto! row-contents (gnc:make-html-table-cell/size
- 1 (+ right-indent width-left-columns width-right-columns) data)))
- (if (not (column-uses? 'subtotals-only))
- (gnc:html-table-append-row/markup! table subheading-style (reverse row-contents)))))
+ (unless (column-uses? 'subtotals-only)
+ (gnc:html-table-append-row/markup!
+ table subheading-style
+ (append
+ (gnc:html-make-empty-cells left-indent)
+ (if (and (opt-val pagename-sorting optname-show-informal-headers)
+ (column-uses? 'amount-double)
+ (member sortkey SORTKEY-INFORMAL-HEADERS))
+ (append
+ (if export?
+ (cons
+ (gnc:make-html-table-cell data)
+ (gnc:html-make-empty-cells
+ (+ right-indent width-left-columns -1)))
+ (list
+ (gnc:make-html-table-cell/size
+ 1 (+ right-indent width-left-columns) data)))
+ (map (lambda (cell)
+ (gnc:make-html-text
+ (gnc:html-markup-b
+ ((vector-ref cell 5)
+ ((keylist-get-info (sortkey-list BOOK-SPLIT-ACTION)
+ sortkey 'renderer-fn)
+ split)))))
+ calculated-cells))
+ (list
+ (gnc:make-html-table-cell/size
+ 1 (+ right-indent width-left-columns width-right-columns)
+ data))))))))
(define (add-subtotal-row subtotal-string subtotal-collectors subtotal-style level row col)
(let* ((left-indent (case level
commit 516354166643980a2a0c35ff50ce985e4988987e
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Aug 16 12:26:08 2018 +0800
[report] remove test-report-system-flag
This flag is not required if we test (gnucash-ui-is-running) instead.
diff --git a/gnucash/report/report-system/report.scm b/gnucash/report/report-system/report.scm
index 39ea6ca..017dcd3 100644
--- a/gnucash/report/report-system/report.scm
+++ b/gnucash/report/report-system/report.scm
@@ -72,9 +72,6 @@
(define gnc:optname-stylesheet (N_ "Stylesheet"))
(define gnc:menuname-business-reports (N_ "_Business"))
(define gnc:optname-invoice-number (N_ "Invoice Number"))
-(define test-report-system-flag #f)
-
-(export test-report-system-flag)
;; We want to warn users if they've got an old-style, non-guid custom
;; report-template, but only once
@@ -142,7 +139,7 @@
;; FIXME: We should pass the top-level window
;; instead of the '() to gnc-error-dialog, but I
;; have no idea where to get it from.
- (if (not test-report-system-flag)
+ (if (gnucash-ui-is-running)
(gnc-error-dialog '() (string-append
(_ "One of your reports has a report-guid that is a duplicate. Please check the report system, especially your saved reports, for a report with this report-guid: ")
report-guid))
@@ -175,14 +172,14 @@
(if (not gnc:old-style-report-warned)
(begin
(set! gnc:old-style-report-warned #t)
- (if (not test-report-system-flag) ;; do not call this during "make test"
+ (if (gnucash-ui-is-running)
(gnc-error-dialog '() (string-append (_ "The GnuCash report system has been upgraded. Your old saved reports have been transferred into a new format. If you experience trouble with saved reports, please contact the GnuCash development team."))))
(hash-set! *gnc:_report-templates_* (gnc:report-template-report-guid report-rec) report-rec)
)
)
)
;;there is no parent -> this is an inital faulty report definition
- (if (not test-report-system-flag) ;; do not call this during "make test"
+ (if (gnucash-ui-is-running)
(gnc-error-dialog '() (string-append (_ "Wrong report definition: ")
(gnc:report-template-name report-rec)
(_ " Report is missing a GUID.")))
diff --git a/gnucash/report/report-system/test/test-report-system.scm b/gnucash/report/report-system/test/test-report-system.scm
index 289ce6d..470365a 100644
--- a/gnucash/report/report-system/test/test-report-system.scm
+++ b/gnucash/report/report-system/test/test-report-system.scm
@@ -8,7 +8,6 @@
(use-modules (gnucash engine test srfi64-extras))
(define (run-test)
- (set! test-report-system-flag #t)
(test-runner-factory gnc:test-runner)
(test-begin "Testing/Temporary/test-report-system") ;; if (test-runner-factory gnc:test-runner) is commented out, this
;; will create Testing/Temporary/test-asset-performance.log
@@ -16,7 +15,6 @@
(test-assert "Missing GUID detection" (test-check2))
(test-assert "Detect double GUID" (test-check3))
(test-assert "Report with Full Argument Set" (test-check4))
- (set! test-report-system-flag #f)
(test-end "Testing/Temporary/test-report-system")
)
commit 3e8acf293d26ac2dad59eaf1368e2cc3741a714f
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Sep 9 19:11:45 2018 +0800
[test-report-utilities] structure must be retrieved dynamically
diff --git a/gnucash/report/report-system/test/test-report-utilities.scm b/gnucash/report/report-system/test/test-report-utilities.scm
index 3995e78..042b7ef 100644
--- a/gnucash/report/report-system/test/test-report-utilities.scm
+++ b/gnucash/report/report-system/test/test-report-utilities.scm
@@ -188,7 +188,7 @@
(gnc-commodity-get-namespace (gnc-default-report-currency))
sym))
-(define structure
+(define (structure)
(list "Root" (list (cons 'type ACCT-TYPE-ASSET))
(list "Asset"
(list "Bank")
@@ -205,7 +205,7 @@
(define (create-test-data)
(let* ((env (create-test-env))
- (account-alist (env-create-account-structure-alist env structure))
+ (account-alist (env-create-account-structure-alist env (structure)))
(asset (cdr (assoc "Asset" account-alist)))
(bank (cdr (assoc "Bank" account-alist)))
(gbp-bank (cdr (assoc "GBP Bank" account-alist)))
commit ec1536ad50a1e9cbcef5afa57e2b2bce32076978
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Aug 31 23:05:05 2018 +0800
[test-report-utilities] encapsulate old test with teardown
Wrap old (test-account-get-trans-type-splits-interval) and clean up
environment with (teardown).
diff --git a/gnucash/report/report-system/test/test-report-utilities.scm b/gnucash/report/report-system/test/test-report-utilities.scm
index c9e2c2e..3995e78 100644
--- a/gnucash/report/report-system/test/test-report-utilities.scm
+++ b/gnucash/report/report-system/test/test-report-utilities.scm
@@ -31,6 +31,7 @@
(map gnc:monetary->string (coll 'format gnc:make-gnc-monetary #f)))
(define (test-account-get-trans-type-splits-interval)
+ (test-group-with-cleanup "test-account-get-trans-type-splits-interval"
(let* ((env (create-test-env))
(ts-now (gnc-localtime (current-time)))
(test-day (tm:mday ts-now))
@@ -57,7 +58,8 @@
;; 10 is the right number (5 days, two splits per tx)
(test-equal "length splits = 10"
10
- (length splits))))))
+ (length splits)))))
+ (teardown)))
(define (teardown)
(gnc-clear-current-session))
commit 0b069900d03507ef455f19ccde650b7040d56bba
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Aug 31 12:42:25 2018 +0800
[test-report-utilities] test account balances
diff --git a/gnucash/report/report-system/test/test-report-utilities.scm b/gnucash/report/report-system/test/test-report-utilities.scm
index f900d8b..c9e2c2e 100644
--- a/gnucash/report/report-system/test/test-report-utilities.scm
+++ b/gnucash/report/report-system/test/test-report-utilities.scm
@@ -17,6 +17,7 @@
(test-list-set-safe)
(test-gnc:monetary->string)
(test-commodity-collector)
+ (test-get-account-balances)
(test-end "report-utilities"))
(define (NDayDelta t64 n)
@@ -178,3 +179,263 @@
#t
(gnc-commodity-collector-allzero? coll-A)))
(teardown)))
+
+(define (mnemonic->commodity sym)
+ (gnc-commodity-table-lookup
+ (gnc-commodity-table-get-table (gnc-get-current-book))
+ (gnc-commodity-get-namespace (gnc-default-report-currency))
+ sym))
+
+(define structure
+ (list "Root" (list (cons 'type ACCT-TYPE-ASSET))
+ (list "Asset"
+ (list "Bank")
+ (list "GBP Bank" (list (cons 'commodity (mnemonic->commodity "GBP")))
+ (list "GBP Savings"))
+ (list "Wallet"))
+ (list "Income" (list (cons 'type ACCT-TYPE-INCOME)))
+ (list "Income-GBP" (list (cons 'type ACCT-TYPE-INCOME)
+ (cons 'commodity (mnemonic->commodity "GBP"))))
+ (list "Expenses" (list (cons 'type ACCT-TYPE-EXPENSE)))
+ (list "Liabilities" (list (cons 'type ACCT-TYPE-LIABILITY)))
+ (list "Equity" (list (cons 'type ACCT-TYPE-EQUITY)))
+ ))
+
+(define (create-test-data)
+ (let* ((env (create-test-env))
+ (account-alist (env-create-account-structure-alist env structure))
+ (asset (cdr (assoc "Asset" account-alist)))
+ (bank (cdr (assoc "Bank" account-alist)))
+ (gbp-bank (cdr (assoc "GBP Bank" account-alist)))
+ (gbp-savings (cdr (assoc "GBP Savings" account-alist)))
+ (wallet (cdr (assoc "Wallet" account-alist)))
+ (income (cdr (assoc "Income" account-alist)))
+ (gbp-income (cdr (assoc "Income-GBP" account-alist)))
+ (expense (cdr (assoc "Expenses" account-alist)))
+ (liability (cdr (assoc "Liabilities" account-alist)))
+ (equity (cdr (assoc "Equity" account-alist))))
+ ;; populate datafile with old transactions
+ (env-transfer env 01 01 1970 bank expense 5 #:description "desc-1" #:num "trn1" #:memo "memo-3")
+ (env-transfer env 31 12 1969 income bank 10 #:description "desc-2" #:num "trn2" #:void-reason "void" #:notes "notes3")
+ (env-transfer env 31 12 1969 income bank 29 #:description "desc-3" #:num "trn3"
+ #:reconcile (cons #\c (gnc-dmy2time64 01 03 1970)))
+ (env-transfer env 01 02 1970 bank expense 15 #:description "desc-4" #:num "trn4" #:notes "notes2" #:memo "memo-1")
+ (env-transfer env 10 01 1970 liability expense 10 #:description "desc-5" #:num "trn5" #:void-reason "any")
+ (env-transfer env 10 01 1970 liability expense 11 #:description "desc-6" #:num "trn6" #:notes "notes1")
+ (env-transfer env 10 02 1970 bank liability 8 #:description "desc-7" #:num "trn7" #:notes "notes1" #:memo "memo-2"
+ #:reconcile (cons #\y (gnc-dmy2time64 01 03 1970)))
+ (env-transfer env 01 01 1975 equity asset 15 #:description "$15 in asset")
+ (env-transfer-foreign env 15 01 2000 gbp-bank bank 10 14 #:description "GBP 10 to USD 14")
+ (env-transfer-foreign env 15 02 2000 bank gbp-bank 9 6 #:description "USD 9 to GBP 6")
+ (env-transfer env 15 03 2000 gbp-bank gbp-savings 5 #:description "GBP 5 from bank to savings")
+ ;; A single closing transaction
+ (let ((closing-txn (env-transfer env 31 12 1999 expense equity 111 #:description "Closing")))
+ (xaccTransSetIsClosingTxn closing-txn #t))
+ (for-each (lambda (m)
+ (env-transfer env 08 (1+ m) 1978 gbp-income gbp-bank 51 #:description "#51 income")
+ (env-transfer env 03 (1+ m) 1978 income bank 103 #:description "$103 income")
+ (env-transfer env 15 (1+ m) 1978 bank expense 22 #:description "$22 expense")
+ (env-transfer env 09 (1+ m) 1978 income bank 109 #:description "$109 income"))
+ (iota 12))
+ (let ((mid (floor (/ (+ (gnc-accounting-period-fiscal-start)
+ (gnc-accounting-period-fiscal-end)) 2))))
+ (env-create-transaction env mid bank income 200))))
+
+
+(define (test-get-account-balances)
+ (define (account-lookup str)
+ (gnc-account-lookup-by-name
+ (gnc-book-get-root-account (gnc-get-current-book))
+ str))
+
+ (create-test-data)
+
+ (test-group-with-cleanup "test-get-account-balances"
+ (let* ((all-accounts (gnc-account-get-descendants
+ (gnc-book-get-root-account (gnc-get-current-book))))
+ (asset (account-lookup "Asset"))
+ (expense (account-lookup "Expenses"))
+ (income (account-lookup "Income"))
+ (bank (account-lookup "Bank"))
+ (gbp-bank (account-lookup "GBP Bank")))
+ (test-equal "gnc:account-get-balance-at-date 1/1/2001 incl children"
+ 2301
+ (gnc:account-get-balance-at-date asset (gnc-dmy2time64 01 01 2001) #t))
+
+ (test-equal "gnc:account-get-balance-at-date 1/1/2001 excl children"
+ 15
+ (gnc:account-get-balance-at-date asset (gnc-dmy2time64 01 01 2001) #f))
+
+ (test-equal "gnc:account-get-comm-balance-at-date 1/1/2001 incl children"
+ '("£608.00" "$2,301.00")
+ (collector->list
+ (gnc:account-get-comm-balance-at-date asset (gnc-dmy2time64 01 01 2001) #t)))
+
+ (test-equal "gnc:account-get-comm-balance-at-date 1/1/2001 excl children"
+ '("$15.00")
+ (collector->list
+ (gnc:account-get-comm-balance-at-date asset (gnc-dmy2time64 01 01 2001) #f)))
+
+ (test-equal "gnc:account-get-comm-value-interval 1/1/2000-1/1/2001 excl children"
+ '("$9.00" "-£15.00")
+ (collector->list
+ (gnc:account-get-comm-value-interval gbp-bank
+ (gnc-dmy2time64 01 01 2000)
+ (gnc-dmy2time64 01 01 2001)
+ #f)))
+
+ (test-equal "gnc:account-get-comm-value-interval 1/1/2000-1/1/2001 incl children"
+ '("$9.00" "-£10.00")
+ (collector->list
+ (gnc:account-get-comm-value-interval gbp-bank
+ (gnc-dmy2time64 01 01 2000)
+ (gnc-dmy2time64 01 01 2001)
+ #t)))
+
+ (test-equal "gnc:account-get-comm-value-at-date 1/1/2001 excl children"
+ '("$9.00" "£597.00")
+ (collector->list
+ (gnc:account-get-comm-value-at-date gbp-bank
+ (gnc-dmy2time64 01 01 2001)
+ #f)))
+
+ (test-equal "gnc:account-get-comm-value-at-date 1/1/2001 incl children"
+ '("$9.00" "£602.00")
+ (collector->list
+ (gnc:account-get-comm-value-at-date gbp-bank
+ (gnc-dmy2time64 01 01 2001)
+ #t)))
+
+ (test-equal "gnc:accounts-get-comm-total-profit"
+ '("£612.00" "$2,389.00")
+ (collector->list
+ (gnc:accounts-get-comm-total-profit all-accounts
+ (lambda (acct)
+ (gnc:account-get-comm-balance-at-date
+ acct (gnc-dmy2time64 01 01 2001) #f)))))
+
+ (test-equal "gnc:accounts-get-comm-total-income"
+ '("£612.00" "$2,573.00")
+ (collector->list
+ (gnc:accounts-get-comm-total-income all-accounts
+ (lambda (acct)
+ (gnc:account-get-comm-balance-at-date
+ acct (gnc-dmy2time64 01 01 2001) #f)))))
+
+ (test-equal "gnc:accounts-get-comm-total-expense"
+ '("-$184.00")
+ (collector->list
+ (gnc:accounts-get-comm-total-expense all-accounts
+ (lambda (acct)
+ (gnc:account-get-comm-balance-at-date
+ acct (gnc-dmy2time64 01 01 2001) #f)))))
+
+ (test-equal "gnc:accounts-get-comm-total-assets"
+ '("£608.00" "$2,394.00")
+ (collector->list
+ (gnc:accounts-get-comm-total-assets all-accounts
+ (lambda (acct)
+ (gnc:account-get-comm-balance-at-date
+ acct (gnc-dmy2time64 01 01 2001) #f)))))
+
+ (test-equal "gnc:account-get-balance-interval 1/1/60 - 1/1/01 incl children"
+ 608
+ (gnc:account-get-balance-interval gbp-bank
+ (gnc-dmy2time64 01 01 1960)
+ (gnc-dmy2time64 01 01 2001)
+ #t))
+
+ (test-equal "gnc:account-get-balance-interval 1/1/60 - 1/1/01 excl children"
+ 603
+ (gnc:account-get-balance-interval gbp-bank
+ (gnc-dmy2time64 01 01 1960)
+ (gnc-dmy2time64 01 01 2001)
+ #f))
+
+ (test-equal "gnc:account-comm-balance-interval 1/1/1960-1/1/2001 incl children"
+ '("£608.00")
+ (collector->list
+ (gnc:account-get-comm-balance-interval gbp-bank
+ (gnc-dmy2time64 01 01 1960)
+ (gnc-dmy2time64 01 01 2001)
+ #t)))
+
+ (test-equal "gnc:account-comm-balance-interval 1/1/1960-1/1/2001 excl children"
+ '("£603.00")
+ (collector->list
+ (gnc:account-get-comm-balance-interval gbp-bank
+ (gnc-dmy2time64 01 01 1960)
+ (gnc-dmy2time64 01 01 2001)
+ #f)))
+
+ (test-equal "gnc:accountlist-get-comm-balance-interval"
+ '("$279.00")
+ (collector->list
+ (gnc:accountlist-get-comm-balance-interval (list expense)
+ (gnc-dmy2time64 15 01 1970)
+ (gnc-dmy2time64 01 01 2001))))
+
+ (test-equal "gnc:accountlist-get-comm-balance-interval-with-closing"
+ '("$168.00")
+ (collector->list
+ (gnc:accountlist-get-comm-balance-interval-with-closing (list expense)
+ (gnc-dmy2time64 15 01 1970)
+ (gnc-dmy2time64 01 01 2001))))
+
+ (test-equal "gnc:accountlist-get-comm-balance-at-date"
+ '("$295.00")
+ (collector->list
+ (gnc:accountlist-get-comm-balance-at-date (list expense)
+ (gnc-dmy2time64 01 01 2001))))
+
+ (test-equal "gnc:accountlist-get-comm-balance-interval-with-closing"
+ '("$184.00")
+ (collector->list
+ (gnc:accountlist-get-comm-balance-at-date-with-closing (list expense)
+ (gnc-dmy2time64 01 01 2001))))
+
+ (test-equal "gnc:accounts-count-splits"
+ 44
+ (gnc:accounts-count-splits (list expense income)))
+
+ (test-equal "gnc:account-get-total-flow 'in"
+ '("£14.00" "$2,544.00")
+ (collector->list
+ (gnc:account-get-total-flow 'in
+ (list bank)
+ (gnc-dmy2time64 15 01 1970)
+ (gnc-dmy2time64 01 01 2001))))
+
+ (test-equal "gnc:account-get-total-flow 'out"
+ '("-$296.00")
+ (collector->list
+ (gnc:account-get-total-flow 'out
+ (list bank)
+ (gnc-dmy2time64 15 01 1970)
+ (gnc-dmy2time64 01 01 2001))))
+
+ (let ((account-balances (gnc:get-assoc-account-balances
+ (list bank gbp-bank)
+ (lambda (acct)
+ (gnc:account-get-comm-balance-at-date
+ acct (gnc-dmy2time64 01 01 2001) #f)))))
+
+ (test-equal "gnc:get-assoc-account-balances"
+ '("$2,286.00")
+ (collector->list (car (assoc-ref account-balances bank))))
+
+ (test-equal "gnc:select-assoc-account-balance - hit"
+ '("$2,286.00")
+ (collector->list
+ (gnc:select-assoc-account-balance account-balances bank)))
+
+ (test-equal "gnc:select-assoc-account-balance - miss"
+ #f
+ (collector->list
+ (gnc:select-assoc-account-balance account-balances expense)))
+
+ (test-equal "gnc:get-assoc-account-balances-total"
+ '("£603.00" "$2,286.00")
+ (collector->list
+ (gnc:get-assoc-account-balances-total account-balances)))))
+ (teardown)))
commit 125dcfb0ec8a50a02024486639a6e95279488824
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Aug 31 11:36:41 2018 +0800
[test-report-utilities] test list, monetary->str, commodity-collector
- list-set-safe
- gnc:monetary->string
- commodity-collector
diff --git a/gnucash/report/report-system/test/test-report-utilities.scm b/gnucash/report/report-system/test/test-report-utilities.scm
index 6865f95..f900d8b 100644
--- a/gnucash/report/report-system/test/test-report-utilities.scm
+++ b/gnucash/report/report-system/test/test-report-utilities.scm
@@ -14,14 +14,21 @@
(test-begin "report-utilities")
(test-account-get-trans-type-splits-interval)
(test-list-ref-safe)
- (test-end "report-utilities")
- )
+ (test-list-set-safe)
+ (test-gnc:monetary->string)
+ (test-commodity-collector)
+ (test-end "report-utilities"))
(define (NDayDelta t64 n)
(let* ((day-secs (* 60 60 24 n)) ; n days in seconds is n times 60 sec/min * 60 min/h * 24 h/day
(new-secs (- t64 day-secs)))
new-secs))
+(define (collector->list coll)
+ ;; input: collector
+ ;; output: list of strings e.g. '("$25.00" "-£15.00")
+ (map gnc:monetary->string (coll 'format gnc:make-gnc-monetary #f)))
+
(define (test-account-get-trans-type-splits-interval)
(let* ((env (create-test-env))
(ts-now (gnc-localtime (current-time)))
@@ -64,3 +71,110 @@
#f
(list-ref-safe lst 3)))
(test-end "list-ref-safe"))
+
+(define (test-list-set-safe)
+ (test-begin "list-set-safe")
+ (let ((lst (list 1 2)))
+ (list-set-safe! lst 1 3)
+ (test-equal "list-set-safe normal"
+ '(1 3)
+ lst)
+ (list-set-safe! lst 5 1)
+ (test-equal "list-set-safe out-of-bounds"
+ '(1 3 #f #f #f 1)
+ lst))
+ (test-end "list-set-safe"))
+
+(define (test-gnc:monetary->string)
+ (test-group-with-cleanup "gnc:monetary->string"
+ (let* ((book (gnc-get-current-book))
+ (comm-table (gnc-commodity-table-get-table book))
+ (monetary (gnc:make-gnc-monetary
+ (gnc-commodity-table-lookup comm-table "CURRENCY" "USD")
+ 100)))
+ (test-equal "gnc:monetary->string"
+ "$100.00"
+ (gnc:monetary->string monetary)))
+ (teardown)))
+
+(define (test-commodity-collector)
+ (test-group-with-cleanup "test-commodity-collector"
+ (let* ((book (gnc-get-current-book))
+ (comm-table (gnc-commodity-table-get-table book))
+ (USD (gnc-commodity-table-lookup comm-table "CURRENCY" "USD"))
+ (GBP (gnc-commodity-table-lookup comm-table "CURRENCY" "GBP"))
+ (EUR (gnc-commodity-table-lookup comm-table "CURRENCY" "EUR"))
+ (coll-A (gnc:make-commodity-collector))
+ (coll-B (gnc:make-commodity-collector)))
+
+ (test-equal "commodity-collector empty"
+ '()
+ (collector->list coll-A))
+
+ (coll-A 'add USD 25)
+ (test-equal "coll-A 'add USD25"
+ '("$25.00")
+ (collector->list coll-A))
+
+ (coll-A 'add USD 25)
+ (test-equal "coll-A 'add USD25"
+ '("$50.00")
+ (collector->list coll-A))
+
+ (coll-A 'add GBP 20)
+ (test-equal "coll-A 'add GBP20"
+ '("£20.00" "$50.00")
+ (collector->list coll-A))
+
+ (coll-A 'reset #f #f)
+ (test-equal "coll-A 'reset"
+ '()
+ (collector->list coll-A))
+
+ (coll-A 'add USD 25)
+ (coll-B 'add GBP 20)
+ (test-equal "coll-B 'add GBP20"
+ '("£20.00")
+ (collector->list coll-B))
+
+ (coll-A 'merge coll-B #f)
+ (test-equal "coll-A 'merge coll-B"
+ '("£20.00" "$25.00")
+ (collector->list coll-A))
+
+ (coll-A 'reset #f #f)
+ (coll-A 'add USD 25)
+ (coll-A 'minusmerge coll-B #f)
+ (test-equal "coll-A 'minusmerge coll-B"
+ '("-£20.00" "$25.00")
+ (collector->list coll-A))
+
+ (test-equal "coll-A 'getpair USD"
+ (list USD 25)
+ (coll-A 'getpair USD #f))
+
+ (test-equal "coll-A 'getmonetary USD"
+ (gnc:make-gnc-monetary USD 25)
+ (coll-A 'getmonetary USD #f))
+
+ (test-equal "gnc:commodity-collector-get-negated"
+ '("-$25.00" "£20.00")
+ (collector->list
+ (gnc:commodity-collector-get-negated coll-A)))
+
+ (test-equal "gnc:commodity-collectorlist-get-merged"
+ '("$25.00" "£0.00")
+ (collector->list
+ (gnc:commodity-collectorlist-get-merged (list coll-A coll-B))))
+
+ (test-equal "gnc-commodity-collector-allzero? #f"
+ #f
+ (gnc-commodity-collector-allzero? coll-A))
+
+ ;; coll-A has -GBP20 and USD25 for now, bring bal to 0 each
+ (coll-A 'add GBP 20)
+ (coll-A 'add USD -25)
+ (test-equal "gnc-commodity-collector-allzero? #t"
+ #t
+ (gnc-commodity-collector-allzero? coll-A)))
+ (teardown)))
commit 88229370aa65f33a8865c9d65b7069498b2fdc26
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Aug 31 10:56:43 2018 +0800
[test-report-utilities] convert to srfi-64 and augment tests
diff --git a/gnucash/report/report-system/test/CMakeLists.txt b/gnucash/report/report-system/test/CMakeLists.txt
index 6d78a26..bfe51be 100644
--- a/gnucash/report/report-system/test/CMakeLists.txt
+++ b/gnucash/report/report-system/test/CMakeLists.txt
@@ -12,12 +12,12 @@ gnc_add_test_with_guile(test-link-module-report-system test-link-module.c
set(scm_test_report_system_SOURCES
test-load-report-system-module.scm
test-collectors.scm
- test-report-utilities.scm
test-test-extras.scm
)
set (scm_test_report_system_with_srfi64_SOURCES
test-commodity-utils.scm
+ test-report-utilities.scm
test-html-utilities-srfi64.scm
test-report-system.scm
)
diff --git a/gnucash/report/report-system/test/test-report-utilities.scm b/gnucash/report/report-system/test/test-report-utilities.scm
index 2d5bf07..6865f95 100644
--- a/gnucash/report/report-system/test/test-report-utilities.scm
+++ b/gnucash/report/report-system/test/test-report-utilities.scm
@@ -3,13 +3,19 @@
(gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
(gnc:module-begin-syntax (gnc:module-load "gnucash/report/report-system" 0))
-
+(use-modules (srfi srfi-64))
+(use-modules (gnucash engine test srfi64-extras))
(use-modules (gnucash engine test test-extras))
(use-modules (gnucash report report-system test test-extras))
(use-modules (gnucash report report-system))
(define (run-test)
- (test-account-get-trans-type-splits-interval))
+ (test-runner-factory gnc:test-runner)
+ (test-begin "report-utilities")
+ (test-account-get-trans-type-splits-interval)
+ (test-list-ref-safe)
+ (test-end "report-utilities")
+ )
(define (NDayDelta t64 n)
(let* ((day-secs (* 60 60 24 n)) ; n days in seconds is n times 60 sec/min * 60 min/h * 24 h/day
@@ -41,4 +47,20 @@
ACCT-TYPE-ASSET
q-start-date q-end-date)))
;; 10 is the right number (5 days, two splits per tx)
- (or (equal? 10 (length splits)) (begin (format #t "Fail, ~d splits, expected 10~%" (length splits)) #f))))))
+ (test-equal "length splits = 10"
+ 10
+ (length splits))))))
+
+(define (teardown)
+ (gnc-clear-current-session))
+
+(define (test-list-ref-safe)
+ (test-begin "list-ref-safe")
+ (let ((lst '(1 2)))
+ (test-equal "list-ref-safe normal"
+ 1
+ (list-ref-safe lst 0))
+ (test-equal "list-ref-safe out of bounds"
+ #f
+ (list-ref-safe lst 3)))
+ (test-end "list-ref-safe"))
Summary of changes:
.../report/report-system/commodity-utilities.scm | 354 ++++++++----------
gnucash/report/report-system/html-acct-table.scm | 23 +-
gnucash/report/report-system/html-utilities.scm | 24 +-
gnucash/report/report-system/report-utilities.scm | 410 +++++++--------------
gnucash/report/report-system/report.scm | 9 +-
gnucash/report/report-system/test/CMakeLists.txt | 2 +-
.../report-system/test/test-report-system.scm | 2 -
.../report-system/test/test-report-utilities.scm | 405 +++++++++++++++++++-
.../report/standard-reports/advanced-portfolio.scm | 11 +-
gnucash/report/standard-reports/transaction.scm | 186 +++++-----
10 files changed, 803 insertions(+), 623 deletions(-)
More information about the gnucash-changes
mailing list