gnucash maint: Multiple changes pushed
John Ralls
jralls at code.gnucash.org
Tue Aug 28 18:14:06 EDT 2018
Updated via https://github.com/Gnucash/gnucash/commit/28691b46 (commit)
via https://github.com/Gnucash/gnucash/commit/b1ee7c6e (commit)
via https://github.com/Gnucash/gnucash/commit/704afc6e (commit)
via https://github.com/Gnucash/gnucash/commit/fe73f52b (commit)
via https://github.com/Gnucash/gnucash/commit/4e88b8cb (commit)
from https://github.com/Gnucash/gnucash/commit/93f3a8ea (commit)
commit 28691b46ba5fc198eaddf133d48c5696421915b9
Author: John Ralls <jralls at ceridwen.us>
Date: Sat Aug 18 12:36:22 2018 -0700
Create srfi-64 tests for gnucash/report/report-system/commodity-utils.scm.
diff --git a/gnucash/report/report-system/commodity-utilities.scm b/gnucash/report/report-system/commodity-utilities.scm
index 63002ea..93ceac8 100644
--- a/gnucash/report/report-system/commodity-utilities.scm
+++ b/gnucash/report/report-system/commodity-utilities.scm
@@ -118,11 +118,24 @@
(define (gnc:price-is-not-zero? elem)
(not (gnc-numeric-zero-p (second elem))))
-;; Create a list of all prices of 'price-commodity' measured in the
-;; currency 'report-currency'. The prices are taken from all splits in
-;; 'currency-accounts' up until the date 'end-date'. Returns a list
-;; of lists. Each listelement looks like the list (time price), where
-;; 'time' is the time64 when the <gnc:numeric*> 'price' was valid.
+;; Create a list of all prices of 'price-commodity' measured in the currency
+;; 'report-currency'. The prices are taken from all splits in
+;; 'currency-accounts' up until the date 'end-date'. Returns a list of
+;; lists. Each listelement looks like the list (time price), where 'time' is the
+;; time64 when the <gnc:numeric*> 'price' was valid. The results are distorted
+;; by the existence of capital gains splits because the amount of the gain is
+;; added to the total value with no adjustment to the total amount. For example
+;; if on day1 one buys 200 shares of XYZ at 20 and on day2 sells 100 at 25
+;; booking a capital gain of 500, the resulting foreignlist will be:
+;; ((day1 4000 200)
+;; (day2 500 0)
+;; (day2 2500 100))
+;; returning the following price list:
+;; ((day1 20)
+;; (day2 22.50)
+;; (day2 23.33))
+;; The intended second price is 6500/300, or 21.67.
+
(define (gnc:get-commodity-totalavg-prices
currency-accounts end-date price-commodity report-currency)
(let ((total-foreign (gnc-numeric-zero))
diff --git a/gnucash/report/report-system/test/CMakeLists.txt b/gnucash/report/report-system/test/CMakeLists.txt
index 7ecd67a..6d78a26 100644
--- a/gnucash/report/report-system/test/CMakeLists.txt
+++ b/gnucash/report/report-system/test/CMakeLists.txt
@@ -17,6 +17,7 @@ set(scm_test_report_system_SOURCES
)
set (scm_test_report_system_with_srfi64_SOURCES
+ test-commodity-utils.scm
test-html-utilities-srfi64.scm
test-report-system.scm
)
diff --git a/gnucash/report/report-system/test/test-commodity-utils.scm b/gnucash/report/report-system/test/test-commodity-utils.scm
new file mode 100644
index 0000000..1a03a21
--- /dev/null
+++ b/gnucash/report/report-system/test/test-commodity-utils.scm
@@ -0,0 +1,590 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; test-commodity-utilities.scm: Test the commodity functions
+;; Copyright 2018 John Ralls <jralls at ceridwen.us>
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, contact:
+;;
+;; Free Software Foundation Voice: +1-617-542-5942
+;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
+;; Boston, MA 02110-1301, USA gnu at gnu.org
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(use-modules (srfi srfi-64))
+(use-modules (ice-9 pretty-print))
+(use-modules (gnucash engine test srfi64-extras))
+(use-modules (gnucash engine test test-extras))
+(use-modules (gnucash app-utils))
+(use-modules (gnucash engine))
+(use-modules (sw_engine))
+(use-modules (sw_app_utils))
+(use-modules (gnucash report report-system))
+
+(setlocale LC_ALL "C")
+
+(define (run-test)
+ (test-runner-factory gnc:test-runner)
+ (test-begin "commodity-utils")
+ ;; Tests go here
+ (test-setup)
+ (test-resolve-unknown-comm)
+ (test-get-exchange-totals)
+ (test-get-exchange-cost-totals)
+ (test-get-exchange-cost-totals-trading)
+ (test-exchange-by-pricedb-latest)
+ (test-exchange-by-pricedb-nearest)
+ (test-get-commodity-totalavg-prices)
+ (test-get-commodity-inst-prices)
+ (test-end "commodity-utils"))
+
+(define test-accounts
+ (list "Root" (list (cons 'type ACCT-TYPE-ROOT))
+ (list "Assets"(list (cons 'type ACCT-TYPE-ASSET))
+ (list "Current"
+ (list "Savings" (list (cons 'type ACCT-TYPE-BANK)))
+ (list "Checking" (list (cons 'type ACCT-TYPE-BANK))))
+ (list "Investment"
+ (list "Broker A"
+ (list "Cash-A" (list (cons 'type ACCT-TYPE-BANK)))
+ (list "Stocks" (list (cons 'type ACCT-TYPE-STOCK))
+ (list "AAPL-A")
+ (list "IBM-A")
+ (list "MSFT-A")
+ (list "TSLA-A")))
+ (list "Broker B"
+ (list "Cash-B" (list (cons 'type ACCT-TYPE-BANK)))
+ (list "Stocks" (list (cons 'type ACCT-TYPE-STOCK))
+ (list "AAPL-B")
+ (list "IBM-B")
+ (list "MSFT-B")
+ (list "TSLA-B")))
+ (list "Broker-GBP"
+ (list "Cash-GBP" (list (cons 'type ACCT-TYPE-BANK)))
+ (list "Stocks" (list (cons 'type ACCT-TYPE-STOCK))
+ (list "RDSA")))))
+ (list "Income" (list (cons 'type ACCT-TYPE-INCOME))
+ (list "Capital Gains"))
+ (list "Expenses" (list (cons 'type ACCT-TYPE-EXPENSE)))
+ (list "Liability" (list (cons 'type ACCT-TYPE-LIABILITY)))
+ (list "Equity" (list (cons 'type ACCT-TYPE-EQUITY))
+ (list "Opening Balances"))))
+
+(define (setup trading)
+ (let* ((env (create-test-env))
+ (book (gnc-get-current-book))
+ (comm-table (gnc-commodity-table-get-table book))
+ (AAPL (gnc-commodity-new book "Apple" "NASDAQ" "AAPL" "" 1))
+ (IBM (gnc-commodity-new book "International Business Machines"
+ "NYSE" "IBM" "" 1))
+ (MSFT (gnc-commodity-new book "Microsoft" "NASDAQ" "MSFT" "" 1))
+ (TSLA (gnc-commodity-new book "Tesla Motors" "NASDAQ" "TSLA" "" 1))
+ (RDSA (gnc-commodity-new book "Royal Dutch Shell A" "LSE" "RDSA" "" 1))
+ ;; Yeah, this is fake, it's for testing DEM->EUR conversions.
+ (DMLR (gnc-commodity-new book "Daimler Motors" "FSE" "DMLR" "" 1))
+ (EUR (gnc-commodity-table-lookup comm-table "CURRENCY" "EUR"))
+ (GBP (gnc-commodity-table-lookup comm-table "CURRENCY" "GBP"))
+ (USD (gnc-commodity-table-lookup comm-table "CURRENCY" "USD"))
+ (account-alist (env-create-account-structure-alist env test-accounts))
+ (checking (cdr (assoc "Checking" account-alist)))
+ (saving (cdr (assoc "Savings" account-alist)))
+ (cash-a (cdr (assoc "Cash-A" account-alist)))
+ (aapl-a (cdr (assoc "AAPL-A" account-alist)))
+ (ibm-a (cdr (assoc "IBM-A" account-alist)))
+ (msft-a (cdr (assoc "MSFT-A" account-alist)))
+ (tsla-a (cdr (assoc "TSLA-A" account-alist)))
+ (cash-b (cdr (assoc "Cash-B" account-alist)))
+ (aapl-b (cdr (assoc "AAPL-B" account-alist)))
+ (ibm-b (cdr (assoc "IBM-B" account-alist)))
+ (msft-b (cdr (assoc "MSFT-B" account-alist)))
+ (tsla-b (cdr (assoc "TSLA-B" account-alist)))
+ (capgain (cdr (assoc "Capital Gains" account-alist)))
+ (openbal (cdr (assoc "Opening Balances" account-alist))))
+ ;; Set account commodities
+ (gnc-commodity-table-insert comm-table AAPL)
+ (gnc-commodity-table-insert comm-table MSFT)
+ (gnc-commodity-table-insert comm-table IBM)
+ (gnc-commodity-table-insert comm-table RDSA)
+ (gnc-commodity-table-insert comm-table TSLA)
+ (xaccAccountSetCommodity aapl-a AAPL)
+ (xaccAccountSetCommodity ibm-a IBM)
+ (xaccAccountSetCommodity msft-a MSFT)
+ (xaccAccountSetCommodity tsla-a TSLA)
+ (xaccAccountSetCommodity aapl-b AAPL)
+ (xaccAccountSetCommodity ibm-b IBM)
+ (xaccAccountSetCommodity msft-b MSFT)
+ (xaccAccountSetCommodity tsla-b TSLA)
+ ;; Create transactions in the accounts
+ (env-transfer env 15 11 2011 openbal saving 1553746/100
+ #:description "Fund Savings")
+ (env-transfer env 15 11 2011 openbal checking 329726/100
+ #:description "Fund Checking")
+ (env-transfer env 15 11 2011 openbal cash-a 11543627/100
+ #:description "Fund Broker A")
+ (env-transfer-foreign env 15 01 2012 cash-a ibm-a 3583200/100 200
+ #:description "Buy IBM 200") ;;200 @ $179.16
+ (env-transfer-foreign env 15 01 2012 cash-a msft-a 4216500/100 1500
+ #:description "Buy MSFT 1500") ;;1500 @ $28.11
+ (env-transfer-foreign env 9 8 2013 cash-a aapl-a 3684000/100 600
+ #:description "Buy AAPL 600") ;;600 @ $61.40
+ (env-transfer-foreign env 5 12 2014 cash-a msft-a -2421000/100 -500
+ #:description "Sell MSFT 500");;-500 @ $48.42
+ (env-transfer-foreign env 5 12 2014 capgain msft-a 1015500/100 0
+ #:description "MSFT 500 G/L")
+ (env-transfer-foreign env 8 8 2014 cash-a ibm-a -3732600/100 -200
+ #:description "Sell IBM 200") ;;-200 @ $186.63
+ (env-transfer-foreign env 8 8 2014 capgain ibm-a 149400/100 0
+ #:description "IBM 200 G/L")
+ (env-transfer env 15 6 2014 cash-a cash-b 4000000/100
+ #:description "Fund Broker B")
+ (env-transfer-foreign env 11 7 2014 cash-b aapl-b 3808800/100 400
+ #:description "Buy AAPL 400") ;;400 @ $95.22
+ (env-transfer-foreign env 2 4 2015 cash-a msft-a 3223200/100 800
+ #:description "Buy MSFT 800") ;;800 @ $40.29
+ (env-transfer-foreign env 23 10 2015 cash-a aapl-a -3572400/100 -300
+ #:description "Sell AAPL 300") ;;-300 @ $119.08
+ (env-transfer-foreign env 23 10 2015 capgain aapl-a 1730400/100 0
+ #:description"AAPL 300 G/L")
+ (env-transfer-foreign env 11 3 2016 cash-a msft-a -4776300/100 -900
+ #:description "Sell MSFT 900") ;;-900 @ $53.07
+ (env-transfer-foreign env 11 3 2016 capgain msft-a 1758200/100 0
+ #:description"MSFT 900 G/L")
+ (gnc-pricedb-create USD MSFT (gnc-dmy2time64 1 1 2013) 2674/100)
+ (gnc-pricedb-create USD IBM (gnc-dmy2time64 1 1 2013) 19399/100)
+ (gnc-pricedb-create USD AAPL (gnc-dmy2time64 1 1 2014) 7728/100)
+ (gnc-pricedb-create USD MSFT (gnc-dmy2time64 1 1 2014) 3691/100)
+ (gnc-pricedb-create USD IBM (gnc-dmy2time64 1 1 2014) 18664/100)
+ (gnc-pricedb-create USD AAPL (gnc-dmy2time64 1 1 2015) 10933/100)
+ (gnc-pricedb-create USD MSFT (gnc-dmy2time64 1 1 2015) 4676/100)
+ (gnc-pricedb-create USD IBM (gnc-dmy2time64 1 1 2015) 16206/100)
+ (gnc-pricedb-create USD AAPL (gnc-dmy2time64 1 1 2016) 10526/100)
+ (gnc-pricedb-create USD MSFT (gnc-dmy2time64 1 1 2016) 5548/100)
+ (gnc-pricedb-create USD IBM (gnc-dmy2time64 1 1 2016) 13163/100)
+ (gnc-pricedb-create USD AAPL (gnc-dmy2time64 1 1 2017) 11582/100)
+ (gnc-pricedb-create USD MSFT (gnc-dmy2time64 1 1 2017) 6214/100)
+ (gnc-pricedb-create USD IBM (gnc-dmy2time64 1 1 2017) 16599/100)
+ account-alist))
+
+
+(define (teardown)
+ (let* ((book (gnc-get-current-book))
+ (pricedb (gnc-pricedb-get-db book)))
+ (gnc-pricedb-destroy pricedb)
+ (gnc-clear-current-session)))
+
+(define (collect collector shares value)
+ ((car collector) 'add shares)
+ ((cdr collector) 'add value))
+
+(define (test-setup)
+ ;; This test ensures that our setup function creates a suitable book
+ (let* ((account-alist (setup #f))
+ (cash-a (cdr (assoc "Cash-A" account-alist)))
+ (book (gnc-get-current-book))
+ (comm-table (gnc-commodity-table-get-table book))
+ (pricedb (gnc-pricedb-get-db book))
+ (USD (gnc-commodity-table-lookup comm-table "CURRENCY" "USD"))
+ (IBM (gnc-commodity-table-lookup comm-table "NYSE" "IBM")))
+ (test-begin "Test Setup")
+ (test-equal "Broker A Cash account balance 73390.27"
+ 7339027/100 (xaccAccountGetBalance cash-a))
+ (test-assert "Have IBM Prices" (gnc-pricedb-has-prices pricedb IBM USD))
+ (let ((ibm-price (gnc-pricedb-lookup-latest pricedb IBM USD)))
+ (test-equal "IBM Latest Price" 16599/100 (gnc-price-get-value ibm-price))
+ (gnc-price-unref ibm-price))
+ (test-end "Test Setup")
+ (teardown)))
+
+(define (test-resolve-unknown-comm)
+ (test-group-with-cleanup "gnc:resolve-unknown-comm"
+ (let* ((account-alist (setup #f))
+ (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"))
+ (DEM (gnc-commodity-table-lookup comm-table "CURRENCY" "DEM"))
+ (MSFT (gnc-commodity-table-lookup comm-table "NASDAQ" "MSFT"))
+ (IBM (gnc-commodity-table-lookup comm-table "NYSE" "IBM"))
+ (AAPL (gnc-commodity-table-lookup comm-table "NASDAQ" "AAPL"))
+ (RDSA (gnc-commodity-table-lookup comm-table "LSE" "RDSA"))
+ (DMLR (gnc-commodity-table-lookup comm-table "FSE" "DMLR"))
+ (aapl-col (cons (gnc:make-value-collector) (gnc:make-value-collector)))
+ (msft-col (cons (gnc:make-value-collector) (gnc:make-value-collector)))
+ (ibm-col (cons (gnc:make-value-collector) (gnc:make-value-collector)))
+ (rdsa-col (cons (gnc:make-value-collector) (gnc:make-value-collector)))
+ (rdsa-gbp-col (cons (gnc:make-value-collector) (gnc:make-value-collector)))
+ (dmlr-dem-col (cons (gnc:make-value-collector) (gnc:make-value-collector)))
+ (gbp-col (cons (gnc:make-value-collector) (gnc:make-value-collector)))
+ (eur-col (cons (gnc:make-value-collector) (gnc:make-value-collector)))
+ (gbp-usd-col (cons (gnc:make-value-collector) (gnc:make-value-collector)))
+ (gbp-eur-col (cons (gnc:make-value-collector) (gnc:make-value-collector)))
+ (gbp-dem-col (cons (gnc:make-value-collector) (gnc:make-value-collector)))
+ (dem-gbp-col (cons (gnc:make-value-collector) (gnc:make-value-collector)))
+ (eur-gbp-col (cons (gnc:make-value-collector) (gnc:make-value-collector)))
+ (eur-usd-col (cons (gnc:make-value-collector) (gnc:make-value-collector))))
+ (test-begin "basic")
+ ;; Entries in the report currency just fall through and are emitted in the
+ ;; result alist.
+ (collect aapl-col 600 3684000/100)
+ (collect aapl-col -300 -3572400/100)
+ (collect aapl-col 0 1730400/100) ;; cap gain
+ (let* ((sumlist (list (list USD (list (list AAPL aapl-col)))))
+ (return-alist (gnc:resolve-unknown-comm sumlist USD)))
+ (test-equal "AAPL 700 shares" 300 ((caadr (assoc AAPL return-alist)) 'total #f))
+ (test-equal "AAPL $18420.00" 1842000/100 ((cdadr (assoc AAPL return-alist)) 'total #f)))
+ (test-end "basic")
+ (test-begin "foreign-no-coll")
+ ;; Now we begin to exercise the function. First up is that it fails to
+ ;; register the security at all if there's no pair of prices that can
+ ;; resolve the transaction commodity to the report currency.
+ (collect rdsa-gbp-col 500 3223400/100)
+ ;; We need a report-currency alist with something in it or
+ ;; resolve-unknown-comm crashes.
+ (let* ((sumlist (list (list USD (list (list AAPL aapl-col)))
+ (list GBP (list (list RDSA rdsa-gbp-col)))))
+ (return-alist (gnc:resolve-unknown-comm sumlist USD)))
+ (test-equal "RDSA #f" #f ((caadr (assoc RDSA return-alist)) 'total #f))
+ (test-equal "RDSA #f" #f ((cdadr (assoc RDSA return-alist)) 'total #f)))
+ (test-end "foreign-no-coll")
+ (test-begin "foreign-no-amount")
+ ;; There's a collector but it doesn't have a price in it so the returned
+ ;; price is 0.
+ (let* ((sumlist (list (list USD (list (list GBP gbp-col)))
+ (list GBP (list (list RDSA rdsa-gbp-col)))))
+ (return-alist (gnc:resolve-unknown-comm sumlist USD)))
+ (test-equal "RDSA 500 shares" 500 ((caadr (assoc RDSA return-alist)) 'total #f))
+ (test-equal "RDSA $0" 0 ((cdadr (assoc RDSA return-alist)) 'total #f)))
+ (test-end "foreign-no-amount")
+ (test-begin "foreign-coll-and-amount")
+ (collect gbp-col 10000/100 15300/100)
+ (let* ((sumlist (list (list USD (list (list GBP gbp-col)))
+ (list GBP (list (list RDSA rdsa-gbp-col)))))
+ (return-alist (gnc:resolve-unknown-comm sumlist USD)))
+ (test-equal "RDSA 500 shares" 500 ((caadr (assoc RDSA return-alist)) 'total #f))
+ (test-equal "RDSA $49,318.02" 4931802/100 ((cdadr (assoc RDSA return-alist)) 'total #f)))
+ (test-end "foreign-coll-and-amount")
+ (test-begin "foreign-inv-coll")
+ ;; Now try with a conversion in the foreign currency instead of the native
+ ;; one.
+ (collect gbp-usd-col 15300/100 10000/100)
+ (let* ((sumlist (list (list USD (list (list AAPL aapl-col)))
+ (list GBP (list (list USD gbp-usd-col)
+ (list RDSA rdsa-gbp-col)))))
+ (return-alist (gnc:resolve-unknown-comm sumlist USD)))
+ (test-equal "RDSA 500 shares" 500 ((caadr (assoc RDSA return-alist)) 'total #f))
+ (test-equal "RDSA $49318.02" 4931802/100 ((cdadr (assoc RDSA return-alist)) 'total #f)))
+ (test-end "foreign-inv-coll")
+ (test-begin "foreign-3way")
+ ;; Three-way conversion, gbp->eur->usd
+ (collect eur-gbp-col 10000/100 121045/1000)
+ (collect eur-col 10000/100 126399/1000)
+ (let* ((sumlist (list (list USD (list (list EUR eur-col)))
+ (list EUR (list (list GBP eur-gbp-col)))
+ (list GBP (list (list RDSA rdsa-gbp-col)))))
+ (return-alist (gnc:resolve-unknown-comm sumlist USD)))
+ (test-equal "RDSA 500 shares" 500 ((caadr (assoc RDSA return-alist)) 'total #f))
+ (test-equal "RDSA $49317.91" 4931791/100 (gnc-numeric-convert ((cdadr (assoc RDSA return-alist)) 'total #f) 100 GNC-HOW-RND-ROUND)))
+ (test-end "foreign-3way")
+ (test-begin "foreign-3way-ambig")
+ ;; Three-way conversion, gbp->eur->usd The equalities are false because
+ ;; there is both a USD price and a GBP price for
+ ;; RDSA. gnc:get-exchange-totals is supposed to resolve this when writing
+ ;; the sumlist, we're testing that gnc:resolve-unknown-comm writes its
+ ;; warning.
+ (collect eur-gbp-col 10000/100 121045/1000)
+ (collect eur-col 10000/100 126399/1000)
+ (collect eur-usd-col 126399/1000 10000/100)
+ (collect rdsa-col 10000/100 1219300/100)
+ (let* ((sumlist (list (list USD (list (list RDSA rdsa-col)
+ (list EUR eur-col)))
+ (list EUR (list (list GBP eur-gbp-col)
+ (list USD eur-usd-col)))
+ (list GBP (list (list RDSA rdsa-gbp-col)))))
+ (return-alist (gnc:resolve-unknown-comm sumlist USD)))
+ (test-assert "RDSA 600 shares" (not (equal? 600 ((caadr (assoc RDSA return-alist)) 'total #f))))
+ (test-assert "RDSA $61510.91" (not (equal? 6151091/100 (gnc-numeric-convert ((cdadr (assoc RDSA return-alist)) 'total #f) 100 GNC-HOW-RND-ROUND)))))
+ (test-end "foreign-3way-ambig")
+ (test-begin "foreign-DEM>EUR")
+ ;; Old currency->Euro conversion.
+ (collect dmlr-dem-col 500 2668000/100)
+ (let* ((sumlist (list (list EUR (list (list USD eur-usd-col)))
+ (list DEM (list (list DMLR dmlr-dem-col)))))
+ (return-alist (gnc:resolve-unknown-comm sumlist EUR)))
+ (test-equal "DMLR 500 shares" 500 ((caadr (assoc DMLR return-alist)) 'total #f))
+ (test-equal "DMLR EUR13631.27" 1364127/100 (gnc-numeric-convert ((cdadr (assoc DMLR return-alist)) 'total #f) 100 GNC-HOW-RND-ROUND)))
+ (test-end "foreign-DEM>EUR")
+ (test-begin "foreign-3way-DEM>EUR")
+ ;; Three-way conversion, gbp->dem->eur->usd
+ ;; Too many levels for resolve-unknown-comm to resolve.
+ (collect gbp-dem-col 10000/100 23665543/100000)
+ (let* ((sumlist (list (list USD (list (list EUR eur-col)))
+ (list GBP (list (list DEM gbp-dem-col)
+ (list RDSA rdsa-gbp-col)))))
+ (return-alist (gnc:resolve-unknown-comm sumlist USD)))
+ (test-equal "Shares fails" #f ((caadr (assoc RDSA return-alist)) 'total #f))
+ (test-equal "Value fails" #f ((cdadr (assoc RDSA return-alist)) 'total #f)))
+ (test-end "foreign-3way-GBP>DEM")
+ (test-begin "foreign-3way-DEM>GBP")
+ ;; Three-way conversion, gbp->dem->eur->usd
+ ;; Too many levels for resolve-unknown-comm to resolve.
+ (collect gbp-dem-col 23665543/100000 10000/100)
+ (let* ((sumlist (list (list USD (list (list EUR eur-col)))
+ (list DEM (list (list GBP dem-gbp-col)))
+ (list GBP (list (list RDSA rdsa-gbp-col)))))
+ (return-alist (gnc:resolve-unknown-comm sumlist USD)))
+ (test-equal "Shares fails" #f ((caadr (assoc RDSA return-alist)) 'total #f))
+ (test-equal "Value fails" #f ((cdadr (assoc RDSA return-alist)) 'total #f)))
+ (test-end "foreign-3way-DEM>GBP")
+ (test-begin "foreign-DEM>EUR")
+ ;; Three-way conversion, gbp->dem->eur
+ ;; Too many levels for resolve-unknown-comm to resolve.
+ (let* ((sumlist (list (list EUR (list (list USD eur-usd-col)))
+ (list GBP (list (list DEM gbp-dem-col)
+ (list RDSA rdsa-gbp-col)))))
+ (return-alist (gnc:resolve-unknown-comm sumlist EUR)))
+ (test-equal "Shares fails" #f ((caadr (assoc RDSA return-alist)) 'total #f))
+ (test-equal "Value fails" #f ((cdadr (assoc RDSA return-alist)) 'total #f)))
+ (test-end "foreign-DEM>EUR"))
+
+ (teardown)))
+
+(define (test-get-exchange-totals)
+ (test-group-with-cleanup "gnc:get-exchange-totals"
+ (let* ((account-alist (setup #f))
+ (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"))
+ (DEM (gnc-commodity-table-lookup comm-table "CURRENCY" "DEM"))
+ (MSFT (gnc-commodity-table-lookup comm-table "NASDAQ" "MSFT"))
+ (IBM (gnc-commodity-table-lookup comm-table "NYSE" "IBM"))
+ (AAPL (gnc-commodity-table-lookup comm-table "NASDAQ" "AAPL"))
+ (RDSA (gnc-commodity-table-lookup comm-table "LSE" "RDSA"))
+ (DMLR (gnc-commodity-table-lookup comm-table "FSE" "DMLR")))
+ (test-begin "multiple")
+ (let ((return-alist (gnc:get-exchange-totals USD (gnc-dmy2time64-neutral 1 12 2016))))
+ (test-equal "AAPL 1300 shares" 1300 ((caadr (assoc AAPL return-alist)) 'total #f))
+ (test-equal "AAPL $110652.00" 11065200/100 ((cdadr (assoc AAPL return-alist)) 'total #f))
+ (test-equal "MSFT 3700 shares" 3700 ((caadr (assoc MSFT return-alist)) 'total #f))
+ (test-equal "MSFT $146370.00" 14637000/100 ((cdadr (assoc MSFT return-alist)) 'total #f))
+ (test-equal "IBM 400 shares" 400 ((caadr (assoc IBM return-alist)) 'total #f))
+ (test-equal "IBM $73158" 7315800/100 ((cdadr (assoc IBM return-alist)) 'total #f)))
+ (test-end "multiple"))
+ (teardown)))
+
+(define (test-get-exchange-cost-totals)
+ (test-group-with-cleanup "gnc:get-exchange-cost-totals"
+ (let* ((account-alist (setup #f))
+ (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"))
+ (DEM (gnc-commodity-table-lookup comm-table "CURRENCY" "DEM"))
+ (MSFT (gnc-commodity-table-lookup comm-table "NASDAQ" "MSFT"))
+ (IBM (gnc-commodity-table-lookup comm-table "NYSE" "IBM"))
+ (AAPL (gnc-commodity-table-lookup comm-table "NASDAQ" "AAPL"))
+ (RDSA (gnc-commodity-table-lookup comm-table "LSE" "RDSA"))
+ (DMLR (gnc-commodity-table-lookup comm-table "FSE" "DMLR")))
+ (test-begin "multiple")
+ (let ((return-alist (gnc:get-exchange-cost-totals USD (gnc-dmy2time64-neutral 1 12 2016))))
+ (test-equal "AAPL 700 shares" 700 ((caadr (assoc AAPL return-alist)) 'total #f))
+ (test-equal "AAPL $56512.00" 5650800/100 ((cdadr (assoc AAPL return-alist)) 'total #f))
+ (test-equal "MSFT 900 shares" 900 ((caadr (assoc MSFT return-alist)) 'total #f))
+ (test-equal "MSFT $30161.00" 3016100/100 ((cdadr (assoc MSFT return-alist)) 'total #f))
+ (test-equal "IBM 0 shares" 0 ((caadr (assoc IBM return-alist)) 'total #f))
+ (test-equal "IBM $0" 0 ((cdadr (assoc IBM return-alist)) 'total #f)))
+ (test-end "multiple"))
+ (teardown)))
+
+(define (test-get-exchange-cost-totals-trading)
+ (test-group-with-cleanup
+ "gnc:get-exchange-totals-trading"
+ (let* ((account-alist (setup #t))
+ (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"))
+ (DEM (gnc-commodity-table-lookup comm-table "CURRENCY" "DEM"))
+ (MSFT (gnc-commodity-table-lookup comm-table "NASDAQ" "MSFT"))
+ (IBM (gnc-commodity-table-lookup comm-table "NYSE" "IBM"))
+ (AAPL (gnc-commodity-table-lookup comm-table "NASDAQ" "AAPL"))
+ (RDSA (gnc-commodity-table-lookup comm-table "LSE" "RDSA"))
+ (DMLR (gnc-commodity-table-lookup comm-table "FSE" "DMLR")))
+ (test-begin "multiple")
+ (let ((return-alist (gnc:get-exchange-cost-totals
+ USD (gnc-dmy2time64-neutral 1 12 2016))))
+ (test-equal "AAPL 700 shares"
+ 700 ((caadr (assoc AAPL return-alist)) 'total #f))
+ (test-equal "AAPL $56512.00"
+ 5650800/100 ((cdadr (assoc AAPL return-alist)) 'total #f))
+ (test-equal "MSFT 900 shares"
+ 900 ((caadr (assoc MSFT return-alist)) 'total #f))
+ (test-equal "MSFT $30161.00"
+ 3016100/100 ((cdadr (assoc MSFT return-alist)) 'total #f))
+ (test-equal "IBM 0 shares"
+ 0 ((caadr (assoc IBM return-alist)) 'total #f))
+ (test-equal "IBM $0"
+ 0 ((cdadr (assoc IBM return-alist)) 'total #f)))
+ (test-end "multiple"))
+ (teardown)))
+
+(define (test-exchange-by-pricedb-latest)
+ (test-group-with-cleanup
+ "gnc:exchange-by-pricedb-latest"
+ (let* ((account-alist (setup #f))
+ (book (gnc-get-current-book))
+ (comm-table (gnc-commodity-table-get-table book))
+ (pricedb (gnc-pricedb-get-db 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"))
+ (DEM (gnc-commodity-table-lookup comm-table "CURRENCY" "DEM"))
+ (MSFT (gnc-commodity-table-lookup comm-table "NASDAQ" "MSFT"))
+ (IBM (gnc-commodity-table-lookup comm-table "NYSE" "IBM"))
+ (AAPL (gnc-commodity-table-lookup comm-table "NASDAQ" "AAPL"))
+ (RDSA (gnc-commodity-table-lookup comm-table "LSE" "RDSA"))
+ (DMLR (gnc-commodity-table-lookup comm-table "FSE" "DMLR")))
+ (test-begin "multiple")
+ (test-equal "AAPL latest" 11582/100 (gnc:gnc-monetary-amount
+ (gnc:exchange-by-pricedb-latest
+ (gnc:make-gnc-monetary AAPL 1) USD)))
+ (test-equal "MSFT latest" 6214/100 (gnc:gnc-monetary-amount
+ (gnc:exchange-by-pricedb-latest
+ (gnc:make-gnc-monetary MSFT 1) USD)))
+ (test-equal "IBM latest" 16599/100 (gnc:gnc-monetary-amount
+ (gnc:exchange-by-pricedb-latest
+ (gnc:make-gnc-monetary IBM 1) USD)))
+ (test-end "multiple"))
+ (teardown)))
+
+(define (test-exchange-by-pricedb-nearest)
+ (test-group-with-cleanup
+ "gnc:exchange-by-pricedb-nearest"
+ (let* ((account-alist (setup #f))
+ (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"))
+ (DEM (gnc-commodity-table-lookup comm-table "CURRENCY" "DEM"))
+ (MSFT (gnc-commodity-table-lookup comm-table "NASDAQ" "MSFT"))
+ (IBM (gnc-commodity-table-lookup comm-table "NYSE" "IBM"))
+ (AAPL (gnc-commodity-table-lookup comm-table "NASDAQ" "AAPL"))
+ (RDSA (gnc-commodity-table-lookup comm-table "LSE" "RDSA"))
+ (DMLR (gnc-commodity-table-lookup comm-table "FSE" "DMLR")))
+ (test-begin "multiple")
+ (test-equal "AAPL nearest 23 March 2015"
+ 10933/100 (gnc:gnc-monetary-amount
+ (gnc:exchange-by-pricedb-nearest
+ (gnc:make-gnc-monetary AAPL 1) USD
+ (gnc-dmy2time64 23 3 2015))))
+ (test-equal "MSFT nearest 11 September 2016"
+ 6214/100 (gnc:gnc-monetary-amount
+ (gnc:exchange-by-pricedb-nearest
+ (gnc:make-gnc-monetary MSFT 1) USD
+ (gnc-dmy2time64 11 9 2016))))
+ (test-equal "IBM nearest 1 July 2014"
+ 18664/100 (gnc:gnc-monetary-amount
+ (gnc:exchange-by-pricedb-nearest
+ (gnc:make-gnc-monetary IBM 1) USD
+ (gnc-dmy2time64 1 7 2014))))
+ (test-end "multiple"))
+ (teardown)))
+
+(define (test-get-commodity-totalavg-prices)
+ (test-group-with-cleanup
+ "gnc:get-commodity-totalavg-prices"
+ (let* ((account-alist (setup #f))
+ (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"))
+ (DEM (gnc-commodity-table-lookup comm-table "CURRENCY" "DEM"))
+ (MSFT (gnc-commodity-table-lookup comm-table "NASDAQ" "MSFT"))
+ (IBM (gnc-commodity-table-lookup comm-table "NYSE" "IBM"))
+ (AAPL (gnc-commodity-table-lookup comm-table "NASDAQ" "AAPL"))
+ (RDSA (gnc-commodity-table-lookup comm-table "LSE" "RDSA"))
+ (DMLR (gnc-commodity-table-lookup comm-table "FSE" "DMLR")))
+ (test-begin "Microsoft-USD")
+ (let* ((curraccts (gnc-account-get-descendants-sorted
+ (gnc-get-current-root-account)))
+ (report-list
+ (gnc:get-commodity-totalavg-prices curraccts
+ (gnc-dmy2time64 4 7 2016)
+ MSFT USD)))
+ (test-equal "MSFT totalavg 2012-01-15" (/ 4216500/100 1500)
+ (cadr (assoc (gnc-dmy2time64-neutral 15 01 2012)
+ report-list)))
+;; We have to use gnc-numeric-div with rounding in order to match the results
+;; from the function. Astute observers will notice that the totals include the
+;; capital gain split but not the acutal sell split on the day because the
+;; capital gain price is first in the list so that's the one (assoc) finds. See
+;; the comment at the gnc:get-commodity-totalavg-prices definition for more
+;; about the prices from this function.
+ (test-equal "MSFT totalavg 2014-12-05"
+ (gnc-numeric-div 5232000/100 1500 GNC-DENOM-AUTO
+ (logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND))
+ (cadr (assoc (gnc-dmy2time64-neutral 5 12 2014)
+ report-list)))
+ (test-equal "MSFT totalavg 2015-04-02"
+ (gnc-numeric-div 10876200/100 2800 GNC-DENOM-AUTO
+ (logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND))
+ (cadr (assoc (gnc-dmy2time64-neutral 2 4 2015) report-list)))
+ (test-equal "MSFT totalavg 2016-03-11"
+ (gnc-numeric-div 12634400/100 2800 GNC-DENOM-AUTO
+ (logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND))
+ (cadr (assoc (gnc-dmy2time64-neutral 11 3 2016)
+ report-list))))
+ (test-end "Microsoft-USD"))
+ (teardown)))
+
+(define (test-get-commodity-inst-prices)
+ (test-group-with-cleanup
+ "gnc:get-commodity-inst-prices"
+ (let* ((account-alist (setup #f))
+ (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"))
+ (DEM (gnc-commodity-table-lookup comm-table "CURRENCY" "DEM"))
+ (MSFT (gnc-commodity-table-lookup comm-table "NASDAQ" "MSFT"))
+ (IBM (gnc-commodity-table-lookup comm-table "NYSE" "IBM"))
+ (AAPL (gnc-commodity-table-lookup comm-table "NASDAQ" "AAPL"))
+ (RDSA (gnc-commodity-table-lookup comm-table "LSE" "RDSA"))
+ (DMLR (gnc-commodity-table-lookup comm-table "FSE" "DMLR")))
+ (test-begin "Microsoft-USD")
+ (let* ((curraccts (gnc-account-get-descendants-sorted
+ (gnc-get-current-root-account)))
+ (report-list
+ (gnc:get-commodity-inst-prices curraccts
+ (gnc-dmy2time64 4 7 2016)
+ MSFT USD)))
+ (test-equal "MSFT inst 2012-01-15" (/ 4216500/100 1500)
+ (cadr (assoc (gnc-dmy2time64-neutral 15 01 2012)
+ report-list)))
+ (test-equal "MSFT inst 2014-12-05" (/ 2421000/100 500)
+ (cadr (assoc (gnc-dmy2time64-neutral 5 12 2014)
+ report-list)))
+ (test-equal "MSFT inst 2015-04-02" (/ 3223200/100 800)
+ (cadr (assoc (gnc-dmy2time64-neutral 2 4 2015) report-list)))
+ (test-equal "MSFT inst 2016-03-11" (/ 4776300/100 900)
+ (cadr (assoc (gnc-dmy2time64-neutral 11 3 2016)
+ report-list))))
+ (test-end "Microsoft-USD"))
+ (teardown)))
commit b1ee7c6eec8b18647213d955bdd4b229815a438a
Author: John Ralls <jralls at ceridwen.us>
Date: Fri Aug 24 14:25:43 2018 -0700
Clarify and de-duplicate sumlist and report-list descriptions.
Also correct descriptions of gnc:get-exchange-totals and
gnc:get-exchange-cost-totals. Neither calculates prices.
diff --git a/gnucash/report/report-system/commodity-utilities.scm b/gnucash/report/report-system/commodity-utilities.scm
index f7ce0e6..63002ea 100644
--- a/gnucash/report/report-system/commodity-utilities.scm
+++ b/gnucash/report/report-system/commodity-utilities.scm
@@ -388,13 +388,24 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions to get one price at a given time (i.e. not time-variant).
+;; Several of the following functions use two types of alist, a return-list or a
+;; sumlist.
+;;
+;; A return-list is an alist with a GncCommodity pointer as the keys and a pair
+;; of gnc-value-collectors, one for amount and the other for value, as the
+;; value.
+;;
+;; A sumlist is an alist having a GncCommodity pointer as the key and a
+;; return-list as the values. The reason for the outer alist is that there might
+;; be commodity transactions which do not involve the report-commodity, but
+;; which can still be calculated after *all* transactions are processed.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Go through all toplevel non-'report-commodity' balances in 'sumlist' and add
+;; them to 'report-commodity', if possible. This function takes a sumlist
+;; (described in gnc:get-exchange-totals) and returns a report-list, This
+;; resulting alist can immediately be plugged into gnc:make-exchange-alist.
-;; Go through all toplevel non-'report-commodity' balances in
-;; 'sumlist' and add them to 'report-commodity', if possible. This
-;; function takes a sumlist (described in gnc:get-exchange-totals) and
-;; returns an alist similar to one value of the sumlist's alist,
-;; e.g. (cadr (assoc report-commodity sumlist))). This resulting alist
-;; can immediately be plugged into gnc:make-exchange-alist.
(define (gnc:resolve-unknown-comm sumlist report-commodity)
;; reportlist contains all known transactions with the
;; report-commodity, and now the transactions with unknown
@@ -529,28 +540,17 @@
;; this functions to use some kind of recursiveness.
-;; Calculate the weighted average exchange rate between all
-;; commodities and the 'report-commodity'. Uses all currency
-;; transactions up until the 'end-date'. Returns an alist, see
-;; sumlist.
+;; Sum the absolute value of the amounts and values in the report commodity of
+;; all exchanges, ignoring gain/loss splits (i.e. those with a 0 amount). For
+;; example, if one bought 1000 GBP for 1210 EUR and then 1190 EUR for 1000 GBP,
+;; if the report currency is EUR the result will be an entry for GBP having an
+;; amount total of 2000 GBP and a value of 2400 EUR. Returns a report-list.
+
(define (gnc:get-exchange-totals report-commodity end-date)
(let ((curr-accounts
;;(filter gnc:account-has-shares? ))
;; -- use all accounts, not only share accounts, since gnucash-1.7
(gnc-account-get-descendants-sorted (gnc-get-current-root-account)))
- ;; sumlist: a multilevel alist. Each element has a commodity
- ;; as key, and another alist as a value. The value-alist's
- ;; elements consist of a commodity as a key, and a pair of two
- ;; value-collectors as value, e.g. with only one (the report-)
- ;; commodity DEM in the outer alist: ( {DEM ( [USD (400 .
- ;; 1000)] [FRF (300 . 100)] ) } ) where DEM,USD,FRF are
- ;; <gnc:commodity> and the numbers are a numeric-collector
- ;; which in turn store a <gnc:numeric>. In the example, USD
- ;; 400 were bought for an amount of DEM 1000, FRF 300 were
- ;; bought for DEM 100. The reason for the outer alist is that
- ;; there might be commodity transactions which do not involve
- ;; the report-commodity, but which can still be calculated
- ;; after *all* transactions are processed.
(sumlist (list (list report-commodity '()))))
(if (not (null? curr-accounts))
@@ -621,27 +621,15 @@
(gnc:resolve-unknown-comm sumlist report-commodity)))
-;; Calculate the volume-weighted average cost of all commodities,
-;; priced in the 'report-commodity'. Uses all transactions up until
-;; the 'end-date'. Returns an alist, see sumlist.
+;; Sum the net amounts and values in the report commodity, including booked
+;; gains and losses, of each commodity across all accounts. Returns a
+;; report-list.
+
(define (gnc:get-exchange-cost-totals report-commodity end-date)
(let ((curr-accounts
;;(filter gnc:account-has-shares? ))
;; -- use all accounts, not only share accounts, since gnucash-1.7
(gnc-account-get-descendants-sorted (gnc-get-current-root-account)))
- ;; sumlist: a multilevel alist. Each element has a commodity
- ;; as key, and another alist as a value. The value-alist's
- ;; elements consist of a commodity as a key, and a pair of two
- ;; value-collectors as value, e.g. with only one (the report-)
- ;; commodity DEM in the outer alist: ( {DEM ( [USD (400 .
- ;; 1000)] [FRF (300 . 100)] ) } ) where DEM,USD,FRF are
- ;; <gnc:commodity> and the numbers are a numeric-collector
- ;; which in turn store a <gnc:numeric>. In the example, USD
- ;; 400 were bought for an amount of DEM 1000, FRF 300 were
- ;; bought for DEM 100. The reason for the outer alist is that
- ;; there might be commodity transactions which do not involve
- ;; the report-commodity, but which can still be calculated
- ;; after *all* transactions are processed.
(sumlist (list (list report-commodity '()))))
(if (not (null? curr-accounts))
commit 704afc6e02fc78f7d8669f6b4ef3be239c05e543
Author: John Ralls <jralls at ceridwen.us>
Date: Fri Aug 24 14:25:04 2018 -0700
Comment to explain structuring an (env-transfer-foreign).
diff --git a/libgnucash/engine/test/test-extras.scm b/libgnucash/engine/test/test-extras.scm
index 90c3ed5..d671e9e 100644
--- a/libgnucash/engine/test/test-extras.scm
+++ b/libgnucash/engine/test/test-extras.scm
@@ -157,6 +157,17 @@
(gnc-price-commit-edit price)
(gnc-pricedb-add-price pricedb price)))
+;; When creating stock transactions always put the stock account and the number
+;; of shares second, using negative numbers for a sale. e.g., to buy 100 shares
+;; of IBM:
+;; (env-transfer-foreign env 15 01 2012 cash-a ibm-a 3583200/100 200
+;; #:description "Buy IBM 200") ;;200 @ $179.16
+;; and to sell them:
+;; (env-transfer-foreign env 8 8 2014 cash-a ibm-a -3732600/100 -200
+;; #:description "Sell IBM 200") ;;-200 @ $186.63
+;; (env-transfer-foreign env 8 8 2014 capgain ibm-a 149400/100 0
+;; #:description "IBM 200 G/L")
+
(define* (env-transfer-foreign
env
DD MM YY ; day/month/year
@@ -204,7 +215,7 @@
(xaccSplitSetMemo split-1 memo)
(xaccSplitSetMemo split-2 memo)))
(if (> amount2 0)
- (gnc-pricedb-create (xaccAccountGetCommodity debit)
+ (gnc-pricedb-create (xaccAccountGetCommodity debit)
(xaccAccountGetCommodity credit)
(gnc-dmy2time64 DD MM YY)
(/ amount1 amount2)))
commit fe73f52bdbdecfe73797aacc327d50f67f29d68d
Author: John Ralls <jralls at ceridwen.us>
Date: Mon Aug 27 18:00:55 2018 -0700
Guard against divide-by-zero errors.
diff --git a/gnucash/report/report-system/commodity-utilities.scm b/gnucash/report/report-system/commodity-utilities.scm
index 987f527..f7ce0e6 100644
--- a/gnucash/report/report-system/commodity-utilities.scm
+++ b/gnucash/report/report-system/commodity-utilities.scm
@@ -193,11 +193,12 @@
(second foreignlist)
GNC-DENOM-AUTO
GNC-DENOM-LCD))
- (gnc-numeric-div
- total-domestic
- total-foreign
- GNC-DENOM-AUTO
- (logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND)))))))
+ (if (not (zero? total-foreign))
+ (gnc-numeric-div
+ total-domestic
+ total-foreign
+ GNC-DENOM-AUTO
+ (logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND)) 0))))))
;; Get all the interesting splits, and sort them according to the
;; date.
(gnc:get-match-commodity-splits-sorted
@@ -295,11 +296,12 @@
(gnc-commodity-numeric->string
report-currency (gnc-numeric-zero)))
(gnc-numeric-zero))
- (gnc-numeric-div
- (second foreignlist)
- (third foreignlist)
- GNC-DENOM-AUTO
- (logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND))))))
+ (if (not (zero? (third foreignlist)))
+ (gnc-numeric-div
+ (second foreignlist)
+ (third foreignlist)
+ GNC-DENOM-AUTO
+ (logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND)) 0)))))
;; Get all the interesting splits, sorted by date.
(gnc:get-match-commodity-splits-sorted
currency-accounts
diff --git a/libgnucash/engine/test/test-extras.scm b/libgnucash/engine/test/test-extras.scm
index a040132..90c3ed5 100644
--- a/libgnucash/engine/test/test-extras.scm
+++ b/libgnucash/engine/test/test-extras.scm
@@ -203,10 +203,11 @@
(begin
(xaccSplitSetMemo split-1 memo)
(xaccSplitSetMemo split-2 memo)))
+ (if (> amount2 0)
(gnc-pricedb-create (xaccAccountGetCommodity debit)
(xaccAccountGetCommodity credit)
(gnc-dmy2time64 DD MM YY)
- (/ amount1 amount2))
+ (/ amount1 amount2)))
(xaccTransCommitEdit txn)
txn))
commit 4e88b8cb6c2c2715522a9fe0d5e636c0286530a5
Author: John Ralls <jralls at ceridwen.us>
Date: Sat Aug 18 16:19:43 2018 -0700
Remove the number-collector.
It is redundant and incorrect since gnc-numeric was replaced with Scheme
rationals in the report code.
diff --git a/gnucash/report/business-reports/receipt.scm b/gnucash/report/business-reports/receipt.scm
index 7aea766..780dbf0 100644
--- a/gnucash/report/business-reports/receipt.scm
+++ b/gnucash/report/business-reports/receipt.scm
@@ -46,7 +46,7 @@
(if (or (not taxable) (eq? taxtable '()))
(display " ")
(let* ((amttot (gnc:make-commodity-collector))
- (pctot (gnc:make-number-collector))
+ (pctot (gnc:make-value-collector))
(entries (gncTaxTableGetEntries taxtable))
(amt? #f) ; becomes #t if any entries are amounts
(pc? #f)) ; becomes #t if any entries are percentages
diff --git a/gnucash/report/business-reports/taxinvoice.scm b/gnucash/report/business-reports/taxinvoice.scm
index 326ce4a..685afdb 100644
--- a/gnucash/report/business-reports/taxinvoice.scm
+++ b/gnucash/report/business-reports/taxinvoice.scm
@@ -53,7 +53,7 @@
(if (or (not taxable) (eq? taxtable '()))
(display " ")
(let* ((amttot (gnc:make-commodity-collector))
- (pctot (gnc:make-number-collector))
+ (pctot (gnc:make-value-collector))
(entries (gncTaxTableGetEntries taxtable))
(amt? #f) ; becomes #t if any entries are amounts
(pc? #f)) ; becomes #t if any entries are percentages
diff --git a/gnucash/report/report-system/commodity-utilities.scm b/gnucash/report/report-system/commodity-utilities.scm
index 4238d1a..987f527 100644
--- a/gnucash/report/report-system/commodity-utilities.scm
+++ b/gnucash/report/report-system/commodity-utilities.scm
@@ -404,8 +404,8 @@
;; numeric-collectors, where [abc] are numeric-collectors. See the
;; real variable names below.
(define (make-newrate unknown-coll un->known-coll known-pair)
- (let ((a (gnc:make-number-collector))
- (b (gnc:make-number-collector)))
+ (let ((a (gnc:make-value-collector))
+ (b (gnc:make-value-collector)))
(a 'add (unknown-coll 'total #f))
(b 'add
;; round to (at least) 8 significant digits
@@ -448,7 +448,7 @@
;; If this is an Euro currency, create the
;; pair of appropriately exchanged amounts.
(if euro-monetary
- (let ((a (gnc:make-number-collector)))
+ (let ((a (gnc:make-value-collector)))
(a 'add
(gnc:gnc-monetary-amount euro-monetary))
(list report-commodity
@@ -578,8 +578,8 @@
;; entry doesn't exist in comm-list
;; create sub-alist from scratch
(let ((pair (list transaction-comm
- (cons (gnc:make-number-collector)
- (gnc:make-number-collector)))))
+ (cons (gnc:make-value-collector)
+ (gnc:make-value-collector)))))
((caadr pair) 'add value-amount)
((cdadr pair) 'add share-amount)
(set! comm-list (list account-comm (list pair)))
@@ -603,8 +603,8 @@
(begin
(set!
pair (list (car foreignlist)
- (cons (gnc:make-number-collector)
- (gnc:make-number-collector))))
+ (cons (gnc:make-value-collector)
+ (gnc:make-value-collector))))
(set!
comm-list (list (car comm-list)
(cons pair (cadr comm-list))))
@@ -665,8 +665,8 @@
(if (not comm-list)
;; no, create sub-alist from scratch
(let ((pair (list transaction-comm
- (cons (gnc:make-number-collector)
- (gnc:make-number-collector)))))
+ (cons (gnc:make-value-collector)
+ (gnc:make-value-collector)))))
((caadr pair) 'add value-amount)
((cdadr pair) 'add share-amount)
(set! comm-list (list account-comm (list pair)))
@@ -690,8 +690,8 @@
(begin
(set!
pair (list (car foreignlist)
- (cons (gnc:make-number-collector)
- (gnc:make-number-collector))))
+ (cons (gnc:make-value-collector)
+ (gnc:make-value-collector))))
(set!
comm-list (list (car comm-list)
(cons pair (cadr comm-list))))
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index dbe56c6..3ce1255 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -263,28 +263,6 @@
(define (gnc:value-collector-total collector)
(collector 'total #f))
-
-;; Same as above but with gnc:numeric
-(define (gnc:make-number-collector)
- (let ;;; values
- ((value 0))
- (lambda (action amount) ;;; Dispatch function
- (case action
- ((add) (if (number? amount)
- (set! value (gnc-numeric-add amount value
- GNC-DENOM-AUTO GNC-DENOM-LCD))
- (gnc:warn
- "gnc:Number-collector called with wrong argument: "
- amount)))
- ((total) value)
- (else (gnc:warn "bad gnc:number-collector action: " action))))))
-
-;; Replace all 'action function calls by the normal functions below.
-(define (gnc:number-collector-add collector amount)
- (collector 'add amount))
-(define (gnc:number-collector-total collector)
- (collector 'total #f))
-
;; A commodity collector. This is intended to handle multiple
;; currencies' amounts. The amounts are accumulated via 'add, the
;; result can be fetched via 'format. This used to work with strings
@@ -337,12 +315,12 @@
(gnc-commodity-get-fraction commodity) GNC-RND-ROUND)))
(if (not pair)
(begin
- ;; create a new pair, using the gnc:number-collector
- (set! pair (list commodity (gnc:make-number-collector)))
+ ;; create a new pair, using the gnc:value-collector
+ (set! pair (list commodity (gnc:make-value-collector)))
;; and add it to the alist
(set! commoditylist (cons pair commoditylist))))
;; add the value
- (gnc:number-collector-add (cadr pair) rvalue)))
+ (gnc:value-collector-add (cadr pair) rvalue)))
;; helper function to walk an association list, adding each
;; (commodity -> collector) pair to our list at the appropriate
@@ -351,15 +329,14 @@
(cond ((null? clist) '())
(else (add-commodity-value
(caar clist)
- (gnc:number-collector-total (cadar clist)))
+ (gnc:value-collector-total (cadar clist)))
(add-commodity-clist (cdr clist)))))
(define (minus-commodity-clist clist)
(cond ((null? clist) '())
(else (add-commodity-value
(caar clist)
- (gnc-numeric-neg
- (gnc:number-collector-total (cadar clist))))
+ (- (gnc:value-collector-total (cadar clist))))
(minus-commodity-clist (cdr clist)))))
;; helper function walk the association list doing a callback on
@@ -367,7 +344,7 @@
(define (process-commodity-list fn clist)
(map
(lambda (pair) (fn (car pair)
- (gnc:number-collector-total (cadr pair))))
+ (gnc:value-collector-total (cadr pair))))
clist))
;; helper function which is given a commodity and returns, if
@@ -380,8 +357,8 @@
(gnc-numeric-zero)
(if sign?
(gnc-numeric-neg
- (gnc:number-collector-total (cadr pair)))
- (gnc:number-collector-total (cadr pair))))
+ (gnc:value-collector-total (cadr pair)))
+ (gnc:value-collector-total (cadr pair))))
'()))))
;; helper function which is given a commodity and returns, if
@@ -394,8 +371,8 @@
(gnc-numeric-zero)
(if sign?
(gnc-numeric-neg
- (gnc:number-collector-total (cadr pair)))
- (gnc:number-collector-total (cadr pair)))))))
+ (gnc:value-collector-total (cadr pair)))
+ (gnc:value-collector-total (cadr pair)))))))
;; Dispatch function
(lambda (action commodity amount)
Summary of changes:
gnucash/report/business-reports/receipt.scm | 2 +-
gnucash/report/business-reports/taxinvoice.scm | 2 +-
.../report/report-system/commodity-utilities.scm | 133 ++---
gnucash/report/report-system/report-utilities.scm | 43 +-
gnucash/report/report-system/test/CMakeLists.txt | 1 +
.../report-system/test/test-commodity-utils.scm | 590 +++++++++++++++++++++
libgnucash/engine/test/test-extras.scm | 16 +-
7 files changed, 685 insertions(+), 102 deletions(-)
create mode 100644 gnucash/report/report-system/test/test-commodity-utils.scm
More information about the gnucash-changes
mailing list