gnucash unstable: Multiple changes pushed
John Ralls
jralls at code.gnucash.org
Thu Dec 21 18:33:40 EST 2017
Updated via https://github.com/Gnucash/gnucash/commit/e0300d3a (commit)
via https://github.com/Gnucash/gnucash/commit/70618035 (commit)
from https://github.com/Gnucash/gnucash/commit/318f7ebc (commit)
commit e0300d3a623fe21224c22fc4f2c44565111c2ec9
Author: John Ralls <jralls at ceridwen.us>
Date: Thu Dec 21 15:30:49 2017 -0800
Replace the gnc:numeric pair with normal Scheme rationals.
This allows direct conversion between Scheme numbers and gnc_numeric
without the performance or accuracy penalties arising from using doubles
as an intermediary.
diff --git a/gnucash/report/business-reports/balsheet-eg.eguile.scm b/gnucash/report/business-reports/balsheet-eg.eguile.scm
index c04f7f1..4066ad5 100644
--- a/gnucash/report/business-reports/balsheet-eg.eguile.scm
+++ b/gnucash/report/business-reports/balsheet-eg.eguile.scm
@@ -288,7 +288,7 @@
<?scm
(for xpair in xlist do
(let* ((comm (car xpair))
- (one-num (gnc:make-gnc-numeric 10000 1))
+ (one-num 10000/1)
(one-foreign-mny (gnc:make-gnc-monetary comm one-num))
(one-local-mny (exchange-fn one-foreign-mny opt-report-commodity)))
?>
diff --git a/gnucash/report/business-reports/receipt.scm b/gnucash/report/business-reports/receipt.scm
index 890510b..d920a44 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-numeric-collector))
+ (pctot (gnc:make-number-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 2417c6b..07dd1bc 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-numeric-collector))
+ (pctot (gnc:make-number-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/locale-specific/us/taxtxf.scm b/gnucash/report/locale-specific/us/taxtxf.scm
index fe17aa9..ba2ad26 100644
--- a/gnucash/report/locale-specific/us/taxtxf.scm
+++ b/gnucash/report/locale-specific/us/taxtxf.scm
@@ -701,7 +701,7 @@
(gnc-commodity-equiv account-commodity
USD-currency)))
(xaccSplitGetValue split)
- (gnc:make-gnc-numeric 100 100)))
+ 100/100))
(missing-pricedb-entry? #f)
(pricedb-lookup-price #f)
(pricedb-lookup-price-value (gnc-numeric-zero))
@@ -798,7 +798,7 @@
trans-currency
USD-currency))
(gnc-numeric-div
- (gnc:make-gnc-numeric 100 100)
+ 100/100
(xaccSplitGetSharePrice split)
GNC-DENOM-AUTO
(logior (GNC-DENOM-SIGFIGS 6)
diff --git a/gnucash/report/report-system/commodity-utilities.scm b/gnucash/report/report-system/commodity-utilities.scm
index d14afab..3ff6c4e 100644
--- a/gnucash/report/report-system/commodity-utilities.scm
+++ b/gnucash/report/report-system/commodity-utilities.scm
@@ -415,8 +415,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-numeric-collector))
- (b (gnc:make-numeric-collector)))
+ (let ((a (gnc:make-number-collector))
+ (b (gnc:make-number-collector)))
(a 'add (unknown-coll 'total #f))
(b 'add
;; round to (at least) 8 significant digits
@@ -459,7 +459,7 @@
;; If this is an Euro currency, create the
;; pair of appropriately exchanged amounts.
(if euro-monetary
- (let ((a (gnc:make-numeric-collector)))
+ (let ((a (gnc:make-number-collector)))
(a 'add
(gnc:gnc-monetary-amount euro-monetary))
(list report-commodity
@@ -532,8 +532,8 @@
(define (create-commodity-list inner-comm outer-comm share-amount value-amount)
(let ((foreignlist (list inner-comm
- (cons (gnc:make-numeric-collector)
- (gnc:make-numeric-collector))))
+ (cons (gnc:make-number-collector)
+ (gnc:make-number-collector))))
(comm-list #f))
((caadr foreignlist) 'add share-amount)
((cdadr foreignlist) 'add value-amount)
@@ -560,8 +560,8 @@
(if (not pair)
(begin
(set! pair (list (car foreignlist)
- (cons (gnc:make-numeric-collector)
- (gnc:make-numeric-collector))))
+ (cons (gnc:make-number-collector)
+ (gnc:make-number-collector))))
(gnc:debug "New commodity "
(gnc-commodity-get-mnemonic (car foreignlist)))))
pair))
diff --git a/gnucash/report/report-system/html-barchart.scm b/gnucash/report/report-system/html-barchart.scm
index 76c18a2..6ef3c2d 100644
--- a/gnucash/report/report-system/html-barchart.scm
+++ b/gnucash/report/report-system/html-barchart.scm
@@ -300,8 +300,6 @@
(lambda ()
(let ((n (read)))
(if (number? n) n 0.0)))))
- ((gnc:gnc-numeric? elt)
- (gnc-numeric-to-double elt))
(#t
0.0)))
diff --git a/gnucash/report/report-system/html-linechart.scm b/gnucash/report/report-system/html-linechart.scm
index 927836f..7b0688d 100644
--- a/gnucash/report/report-system/html-linechart.scm
+++ b/gnucash/report/report-system/html-linechart.scm
@@ -335,8 +335,6 @@
(lambda ()
(let ((n (read)))
(if (number? n) n 0.0)))))
- ((gnc:gnc-numeric? elt)
- (gnc-numeric-to-double elt))
(#t
0.0)))
diff --git a/gnucash/report/report-system/html-piechart.scm b/gnucash/report/report-system/html-piechart.scm
index f8b74a8..9fd79e6 100644
--- a/gnucash/report/report-system/html-piechart.scm
+++ b/gnucash/report/report-system/html-piechart.scm
@@ -152,9 +152,7 @@
(lambda ()
(let ((n (read)))
(if (number? n) (abs n) 0.0)))))
- ((gnc:gnc-numeric? elt)
- (abs (gnc-numeric-to-double elt)))
- (#t
+ (#t
0.0)))
nlist))
diff --git a/gnucash/report/report-system/html-scatter.scm b/gnucash/report/report-system/html-scatter.scm
index 13a7440..3134208 100644
--- a/gnucash/report/report-system/html-scatter.scm
+++ b/gnucash/report/report-system/html-scatter.scm
@@ -131,9 +131,7 @@
(lambda ()
(let ((n (read)))
(if (number? n) n 0.0)))))
- ((gnc:gnc-numeric? elt)
- (gnc-numeric-to-double elt))
- (#t
+ (#t
0.0)))
(let* ((retval '())
diff --git a/gnucash/report/report-system/report-system.scm b/gnucash/report/report-system/report-system.scm
index 0efdd9d..1d6c65c 100644
--- a/gnucash/report/report-system/report-system.scm
+++ b/gnucash/report/report-system/report-system.scm
@@ -671,7 +671,7 @@
(export gnc:make-stats-collector)
(export gnc:make-drcr-collector)
(export gnc:make-value-collector)
-(export gnc:make-numeric-collector)
+(export gnc:make-number-collector)
(export gnc:make-commodity-collector)
(export gnc:commodity-collector-get-negated)
(export gnc:commodity-collectorlist-get-merged)
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index 9a9ff131..462dd0e 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -266,24 +266,24 @@
;; Same as above but with gnc:numeric
-(define (gnc:make-numeric-collector)
+(define (gnc:make-number-collector)
(let ;;; values
- ((value (gnc-numeric-zero)))
+ ((value 0))
(lambda (action amount) ;;; Dispatch function
(case action
- ((add) (if (gnc:gnc-numeric? amount)
- (set! value (gnc-numeric-add amount value
- GNC-DENOM-AUTO GNC-DENOM-LCD))
- (gnc:warn
- "gnc:numeric-collector called with wrong argument: "
+ ((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:numeric-collector action: " action))))))
+ (else (gnc:warn "bad gnc:number-collector action: " action))))))
;; Replace all 'action function calls by the normal functions below.
-(define (gnc:numeric-collector-add collector amount)
+(define (gnc:number-collector-add collector amount)
(collector 'add amount))
-(define (gnc:numeric-collector-total collector)
+(define (gnc:number-collector-total collector)
(collector 'total #f))
;; A commodity collector. This is intended to handle multiple
@@ -338,12 +338,12 @@
(gnc-commodity-get-fraction commodity) GNC-RND-ROUND)))
(if (not pair)
(begin
- ;; create a new pair, using the gnc:numeric-collector
- (set! pair (list commodity (gnc:make-numeric-collector)))
+ ;; create a new pair, using the gnc:number-collector
+ (set! pair (list commodity (gnc:make-number-collector)))
;; and add it to the alist
(set! commoditylist (cons pair commoditylist))))
;; add the value
- (gnc:numeric-collector-add (cadr pair) rvalue)))
+ (gnc:number-collector-add (cadr pair) rvalue)))
;; helper function to walk an association list, adding each
;; (commodity -> collector) pair to our list at the appropriate
@@ -352,7 +352,7 @@
(cond ((null? clist) '())
(else (add-commodity-value
(caar clist)
- (gnc:numeric-collector-total (cadar clist)))
+ (gnc:number-collector-total (cadar clist)))
(add-commodity-clist (cdr clist)))))
(define (minus-commodity-clist clist)
@@ -360,7 +360,7 @@
(else (add-commodity-value
(caar clist)
(gnc-numeric-neg
- (gnc:numeric-collector-total (cadar clist))))
+ (gnc:number-collector-total (cadar clist))))
(minus-commodity-clist (cdr clist)))))
;; helper function walk the association list doing a callback on
@@ -368,7 +368,7 @@
(define (process-commodity-list fn clist)
(map
(lambda (pair) (fn (car pair)
- (gnc:numeric-collector-total (cadr pair))))
+ (gnc:number-collector-total (cadr pair))))
clist))
;; helper function which is given a commodity and returns, if
@@ -381,8 +381,8 @@
(gnc-numeric-zero)
(if sign?
(gnc-numeric-neg
- (gnc:numeric-collector-total (cadr pair)))
- (gnc:numeric-collector-total (cadr pair))))
+ (gnc:number-collector-total (cadr pair)))
+ (gnc:number-collector-total (cadr pair))))
'()))))
;; helper function which is given a commodity and returns, if
@@ -395,8 +395,8 @@
(gnc-numeric-zero)
(if sign?
(gnc-numeric-neg
- (gnc:numeric-collector-total (cadr pair)))
- (gnc:numeric-collector-total (cadr pair)))))))
+ (gnc:number-collector-total (cadr pair)))
+ (gnc:number-collector-total (cadr pair)))))))
;; Dispatch function
(lambda (action commodity amount)
diff --git a/gnucash/report/standard-reports/advanced-portfolio.scm b/gnucash/report/standard-reports/advanced-portfolio.scm
index 6a05845..07fbf32 100644
--- a/gnucash/report/standard-reports/advanced-portfolio.scm
+++ b/gnucash/report/standard-reports/advanced-portfolio.scm
@@ -321,7 +321,7 @@
;; If the units ratio is zero the stock is worthless and the value should be zero too
(value-ratio (if (gnc-numeric-zero-p units-ratio)
(gnc-numeric-zero)
- (gnc-numeric-div (gnc:make-gnc-numeric 1 1) units-ratio GNC-DENOM-AUTO GNC-DENOM-REDUCE))))
+ (gnc-numeric-div 1/1 units-ratio GNC-DENOM-AUTO GNC-DENOM-REDUCE))))
(gnc:debug "blist is " b-list " current units is "
(gnc-numeric-to-string current-units)
@@ -341,7 +341,7 @@
(gnc:debug "this is a spinoff")
(gnc:debug "blist is " b-list " value ratio is " (gnc-numeric-to-string value-ratio))
- (apply-basis-ratio b-list (gnc:make-gnc-numeric 1 1) value-ratio))
+ (apply-basis-ratio b-list 1/1 value-ratio))
)
;; when all else fails, just send the b-list back
@@ -473,7 +473,7 @@
(exchange-fn
(gnc:make-gnc-monetary
(gnc-price-get-currency price)
- (gnc:make-gnc-numeric 100 1))
+ 100/1)
currency))))
(set! price #f))
@@ -514,7 +514,7 @@
;; If we still don't have a price, use a price of 1 and complain later
(if (not price)
(begin
- (set! price (gnc:make-gnc-monetary currency (gnc:make-gnc-numeric 1 1)))
+ (set! price (gnc:make-gnc-monetary currency 1/1))
;; If use-txn is set, but pricing-txn isn't set, it's a bogus price
(set! use-txn #t)
(set! pricing-txn #f)
diff --git a/gnucash/report/standard-reports/cash-flow.scm b/gnucash/report/standard-reports/cash-flow.scm
index 7d857d0..cb2d200 100644
--- a/gnucash/report/standard-reports/cash-flow.scm
+++ b/gnucash/report/standard-reports/cash-flow.scm
@@ -427,9 +427,9 @@
(gnc:timepair-ge (gnc-transaction-get-date-posted parent) from-date-tp))
(let* ((parent-description (xaccTransGetDescription parent))
(parent-currency (xaccTransGetCurrency parent)))
- ;(gnc:debug parent-description
- ; " - "
- ; (gnc-commodity-get-printname parent-currency))
+ (gnc:debug parent-description
+ " - "
+ (gnc-commodity-get-printname parent-currency))
(for-each
(lambda (s)
(let* ((s-account (xaccSplitGetAccount s))
@@ -444,7 +444,7 @@
(string-append
"WARNING: s-account is NULL for split: "
(gncSplitGetGUID s) "\n")))
- ;(gnc:debug (xaccAccountGetName s-account))
+ (gnc:debug (xaccAccountGetName s-account))
(if (and ;; make sure we don't have
(not (null? s-account)) ;; any dangling splits
(or include-trading-accounts (not (eq? s-account-type ACCT-TYPE-TRADING)))
@@ -453,7 +453,7 @@
(begin
(if (gnc-numeric-negative-p s-value)
(let ((s-account-in-collector (account-hashtable-ref money-in-hash s-account)))
- ;(gnc:debug "in:" (gnc-commodity-get-printname s-commodity)
+ ;(gnc:debug "in:" (gnc-commodity-get-printname s-commodity)
; (gnc-numeric-to-double s-amount)
; (gnc-commodity-get-printname parent-currency)
; (gnc-numeric-to-double s-value))
@@ -494,14 +494,14 @@
)
)
)
- )
- )
+ )
+ )
)
)
(xaccTransGetSplitList parent)
)
)
- )
+ )
)
)
diff --git a/gnucash/report/standard-reports/category-barchart.scm b/gnucash/report/standard-reports/category-barchart.scm
index 3cb4bb2..cd04b91 100644
--- a/gnucash/report/standard-reports/category-barchart.scm
+++ b/gnucash/report/standard-reports/category-barchart.scm
@@ -306,20 +306,20 @@ developing over time"))
(let* ((start-frac-avg (averaging-fraction-func (gnc:timepair->secs from-date-tp)))
(end-frac-avg (averaging-fraction-func (+ 1 (gnc:timepair->secs to-date-tp))))
(diff-avg (- end-frac-avg start-frac-avg))
- (diff-avg-numeric (gnc:make-gnc-numeric
+ (diff-avg-numeric (/
(inexact->exact (round (* diff-avg 1000000))) ; 6 decimals precision
1000000))
(start-frac-int (interval-fraction-func (gnc:timepair->secs from-date-tp)))
(end-frac-int (interval-fraction-func (+ 1 (gnc:timepair->secs to-date-tp))))
(diff-int (- end-frac-int start-frac-int))
- (diff-int-numeric (gnc:make-gnc-numeric
+ (diff-int-numeric (/
(inexact->exact diff-int) 1))
)
;; Extra sanity check to ensure a number smaller than 1
(if (> diff-avg diff-int)
(gnc-numeric-div diff-int-numeric diff-avg-numeric GNC-DENOM-AUTO GNC-RND-ROUND)
- (gnc:make-gnc-numeric 1 1)))
- (gnc:make-gnc-numeric 1 1)))
+ 1/1))
+ 1/1))
;; If there is averaging, the report-title is extended
;; accordingly.
(report-title
diff --git a/gnucash/report/standard-reports/net-barchart.scm b/gnucash/report/standard-reports/net-barchart.scm
index 83f4890..ef1532b 100644
--- a/gnucash/report/standard-reports/net-barchart.scm
+++ b/gnucash/report/standard-reports/net-barchart.scm
@@ -314,11 +314,11 @@
(liabilities (assoc-ref rpt 'liability)))
(set! assets-list (if assets (car assets)
(map (lambda (d)
- (gnc:make-gnc-monetary report-currency (gnc:make-gnc-numeric 0 1)))
+ (gnc:make-gnc-monetary report-currency 0/1))
dates-list)))
(set! liability-list (if liabilities (car liabilities)
(map (lambda (d)
- (gnc:make-gnc-monetary report-currency (gnc:make-gnc-numeric 0 1)))
+ (gnc:make-gnc-monetary report-currency 0/1))
dates-list)))
)
diff --git a/gnucash/report/standard-reports/sx-summary.scm b/gnucash/report/standard-reports/sx-summary.scm
index f61608b..9d02186 100644
--- a/gnucash/report/standard-reports/sx-summary.scm
+++ b/gnucash/report/standard-reports/sx-summary.scm
@@ -355,7 +355,7 @@
(guid (gncAccountGetGUID account))
(num-bal (hash-ref sx-value-hash guid)))
(if num-bal
- (if (eq? 0 (gnc:gnc-numeric-denom num-bal))
+ (if (eq? 0 (denominator num-bal))
(gnc:warn "Oops, invalid gnc_numeric when looking up SX balance for account GUID " guid ": " num-bal)
(begin
(balance-collector
diff --git a/gnucash/report/standard-reports/test/test-cash-flow.scm b/gnucash/report/standard-reports/test/test-cash-flow.scm
index 47433b0..45db741 100644
--- a/gnucash/report/standard-reports/test/test-cash-flow.scm
+++ b/gnucash/report/standard-reports/test/test-cash-flow.scm
@@ -36,7 +36,7 @@
(exchange-fn (lambda (currency amount date) amount))
(report-currency (gnc-default-report-currency))
)
- (env-create-transaction env to-date-tp bank-account expense-account (gnc:make-gnc-numeric 100 1))
+ (env-create-transaction env to-date-tp bank-account expense-account 100/1)
(let ((result (cash-flow-calc-money-in-out (list (cons 'accounts (list bank-account))
(cons 'to-date-tp to-date-tp)
(cons 'from-date-tp from-date-tp)
@@ -48,16 +48,24 @@
(money-in-alist (cdr (assq 'money-in-alist result)))
(money-out-alist (cdr (assq 'money-out-alist result)))
(expense-acc-in-collector (cadr (assoc expense-account money-in-alist))))
- (and (null? money-out-alist)
- (equal? (gnc:make-gnc-numeric 10000 100)
+ (and (or (null? money-out-alist)
+ (begin (format #t "The money-out-alist is not null.~%") #f))
+ (or (equal? 10000/100
(gnc:gnc-monetary-amount (gnc:sum-collector-commodity expense-acc-in-collector
report-currency exchange-fn)))
- (equal? (gnc:make-gnc-numeric 10000 100)
+ (begin (format #t "Failed expense-acc-in-collector ~g expected 100.00~%" (gnc:gnc-monetary-amount (gnc:sum-collector-commodity expense-acc-in-collector
+ report-currency exchange-fn))) #f))
+ (or (equal? 10000/100
(gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-in-collector
report-currency exchange-fn)))
- (equal? (gnc:make-gnc-numeric 0 1)
+ (begin (format #t "Failed money-in-collector ~g expected 100.00~%" (gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-in-collector
+ report-currency exchange-fn))) #f))
+ (or (equal? 0/1
(gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-out-collector
report-currency exchange-fn)))
+ (begin (format #t "Failed sum-collector-commodity ~g expected 100.00~%" (gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-out-collector
+ report-currency exchange-fn))) #f))
+ (begin (format #t "test-one-tx-in-cash-flow success~%") #t)
)))))
(define (test-one-tx-skip-cash-flow)
@@ -72,7 +80,7 @@
(exchange-fn (lambda (currency amount date) amount))
(report-currency (gnc-default-report-currency))
)
- (env-create-transaction env to-date-tp bank-account wallet-account (gnc:make-gnc-numeric 100 1))
+ (env-create-transaction env to-date-tp bank-account wallet-account 100/1)
(let ((result (cash-flow-calc-money-in-out (list (cons 'accounts (list wallet-account bank-account))
(cons 'to-date-tp to-date-tp)
(cons 'from-date-tp from-date-tp)
@@ -85,12 +93,14 @@
(money-out-alist (cdr (assq 'money-out-alist result))))
(and (null? money-in-alist)
(null? money-out-alist)
- (equal? (gnc:make-gnc-numeric 0 1)
+ (equal? 0/1
(gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-in-collector
report-currency exchange-fn)))
- (equal? (gnc:make-gnc-numeric 0 1)
+ (equal? 0/1
(gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-out-collector
- report-currency exchange-fn))))))))
+ report-currency exchange-fn)))
+ (begin (format #t "test-one-tx-skip-cash-flow success~%") #t)
+ )))))
(define (test-both-way-cash-flow)
(let* ((env (create-test-env))
@@ -104,8 +114,8 @@
(exchange-fn (lambda (currency amount date) amount))
(report-currency (gnc-default-report-currency))
)
- (env-create-transaction env to-date-tp bank-account expense-account (gnc:make-gnc-numeric 100 1))
- (env-create-transaction env to-date-tp expense-account bank-account (gnc:make-gnc-numeric 50 1))
+ (env-create-transaction env to-date-tp bank-account expense-account 100/1)
+ (env-create-transaction env to-date-tp expense-account bank-account 50/1)
(let ((result (cash-flow-calc-money-in-out (list (cons 'accounts (list wallet-account bank-account))
(cons 'to-date-tp to-date-tp)
(cons 'from-date-tp from-date-tp)
@@ -124,11 +134,13 @@
(expenses-out-total (gnc:gnc-monetary-amount (gnc:sum-collector-commodity expense-acc-out-collector
report-currency
exchange-fn))))
- (and (equal? (gnc:make-gnc-numeric 10000 100) expenses-in-total)
- (equal? (gnc:make-gnc-numeric 5000 100) expenses-out-total)
- (equal? (gnc:make-gnc-numeric 10000 100)
+ (and (equal? 10000/100 expenses-in-total)
+ (equal? 5000/100 expenses-out-total)
+ (equal? 10000/100
(gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-in-collector
report-currency exchange-fn)))
- (equal? (gnc:make-gnc-numeric 5000 100)
+ (equal? 5000/100
(gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-out-collector
- report-currency exchange-fn))))))))
+ report-currency exchange-fn)))
+ (begin (format #t "test-both-way-cash-flow success~%") #t)
+ )))))
diff --git a/gnucash/report/standard-reports/test/test-cashflow-barchart.scm b/gnucash/report/standard-reports/test/test-cashflow-barchart.scm
index 5dc958f..2b85f09 100644
--- a/gnucash/report/standard-reports/test/test-cashflow-barchart.scm
+++ b/gnucash/report/standard-reports/test/test-cashflow-barchart.scm
@@ -79,12 +79,12 @@
date-1
bank-account
income-account
- (gnc:make-gnc-numeric 1 1))
+ 1/1)
(env-create-transaction env
date-2
wallet-account
income-account
- (gnc:make-gnc-numeric 5 1))
+ 5/1)
(begin
(set-option report gnc:pagename-display "Show Table" #t)
(set-option report gnc:pagename-general "Start Date" (cons 'absolute date-0))
@@ -111,25 +111,27 @@
(list (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
(list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
(list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
- result))))
+ result))))
+ (format #t "Report Result ~a~%" result)
(and (every (lambda (row) ; test in=net & out=0 in all rows (all days)
(and (or (equal? (second row) (fourth row))
(begin (format #t "Failed, ~a and ~a differ~%" (second row) (fourth row)) #f))
(or (= 0 (string->number (car (third row))))
(begin (format #t "Failed ~d isn't 0~%" (car (third row))) #f))))
tbl)
- (or (= 0 (tbl-ref->number tbl 0 1)) (begin (format #t "Failed refnum ~d isn't 0~%" (tbl-ref->number tbl 0 1) )) #f)) ; 1st day in =0
- (or (= 1 (tbl-ref->number tbl 1 1)) (begin (format #t "Failed refnum ~d isn't 1~%" (tbl-ref->number tbl 1 1)) #f)) ; 2nd day in =1
- (or (= 5 (tbl-ref->number tbl 2 1)) (begin (format #t "Failed refnum ~d isn't 5~%" (tbl-ref->number tbl 2 1)) #f)) ; 3rd day in =5
- (or (= (tbl-ref->number total 0 0) (tbl-ref->number total 0 2)) (begin (format #t "Failed refnums ~d and ~d differ ~%" (tbl-ref->number total 0 0) (tbl-ref->number total 0 2)) #f)); total in=total net
- (or (= 0 (tbl-ref->number total 0 1)) (begin (format #t "Failed refnum ~d isn't 0~%" (tbl-ref->number total 0 1)) #f)) ; total out=0
- (or (= 3 (tbl-row-count tbl)) (begin (format #t "Failed row count ~d isn't 3~%" (tbl-row-count tbl)) #f))
- (or (= 4 (tbl-column-count tbl)) (begin (format #t "Failed column count ~d isn't 4~%" (tbl-column-count tbl)) #f))))
+ (or (= 0 (tbl-ref->number tbl 0 1))
+ (begin (format #t "Failed refnum ~g isn't 0~%" (tbl-ref->number tbl 0 1)) #f)) ; 1st day in =0
+ (or (= 1 (tbl-ref->number tbl 1 1)) (begin (format #t "Failed refnum ~g isn't 1~%" (tbl-ref->number tbl 1 1)) #f)) ; 2nd day in =1
+ (or (= 5 (tbl-ref->number tbl 2 1)) (begin (format #t "Failed refnum ~g isn't 5~%" (tbl-ref->number tbl 2 1)) #f)) ; 3rd day in =5
+ (or (= (tbl-ref->number total 0 0) (tbl-ref->number total 0 2)) (begin (format #t "Failed refnums ~g and ~g differ ~%" (tbl-ref->number total 0 0) (tbl-ref->number total 0 2)) #f)); total in=total net
+ (or (= 0 (tbl-ref->number total 0 1)) (begin (format #t "Failed refnum ~g isn't 0~%" (tbl-ref->number total 0 1)) #f)) ; total out=0
+ (or (= 3 (tbl-row-count tbl)) (begin (format #t "Failed row count ~g isn't 3~%" (tbl-row-count tbl)) #f))
+ (or (= 4 (tbl-column-count tbl)) (begin (format #t "Failed column count ~g isn't 4~%" (tbl-column-count tbl)) #f))))
)
)
)
)
-
+)
;; Test two transactions from two different assets to expense in two different days
(define (test-out-txn)
@@ -151,22 +153,22 @@
date-1
bank-account
income-account
- (gnc:make-gnc-numeric 100 1)) ; large in txn to avoid negative net (hard to parse)
+ 100/1) ; large in txn to avoid negative net (hard to parse)
(env-create-transaction env
date-1
expense-account
bank-account
- (gnc:make-gnc-numeric 1 1))
+ 1/1)
(env-create-transaction env
date-2
wallet-account
income-account
- (gnc:make-gnc-numeric 100 1)) ; large in txn to avoid negative net (hard to parse)
+ 100/1) ; large in txn to avoid negative net (hard to parse)
(env-create-transaction env
date-2
expense-account
wallet-account
- (gnc:make-gnc-numeric 5 1))
+ 5/1)
(begin
(set-option report gnc:pagename-display "Show Table" #t)
(set-option report gnc:pagename-general "Start Date" (cons 'absolute date-0))
@@ -234,17 +236,17 @@
date-1
bank-account
income-account
- (gnc:make-gnc-numeric 1 1))
+ 1/1)
(env-create-transaction env
date-1
bank-account
wallet-account
- (gnc:make-gnc-numeric 20 1)) ; this transaction should not be counted
+ 20/1) ; this transaction should not be counted
(env-create-transaction env
date-2
wallet-account
income-account
- (gnc:make-gnc-numeric 5 1))
+ 5/1)
(begin
(set-option report gnc:pagename-display "Show Table" #t)
diff --git a/gnucash/report/standard-reports/test/test-generic-net-barchart.scm b/gnucash/report/standard-reports/test/test-generic-net-barchart.scm
index ac475e6..403eabe 100644
--- a/gnucash/report/standard-reports/test/test-generic-net-barchart.scm
+++ b/gnucash/report/standard-reports/test/test-generic-net-barchart.scm
@@ -82,7 +82,7 @@
(gnc:get-start-this-month)
my-income-account
my-asset-account
- (gnc:make-gnc-numeric -1 1))
+ -1/1)
(begin
(set-option report gnc:pagename-display "Show table" #t)
(set-option report gnc:pagename-general "Start Date"
@@ -106,11 +106,13 @@
(list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
(list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
result))))
- (and (= 1 (tbl-ref->number tbl 0 1))
+ (or (and (= 1 (tbl-ref->number tbl 0 1))
(= 0 (tbl-ref->number tbl 0 2))
(= 1 (tbl-ref->number tbl 0 3))
(= 1 (tbl-row-count tbl))
- (= 4 (tbl-column-count tbl)))))))))
+ (= 4 (tbl-column-count tbl)))
+ (begin (format #t "Single-txn test ~a failed~%" uuid) #f))
+ ))))))
(define (two-txn-test uuid)
@@ -133,12 +135,12 @@
date-1
my-income-account
my-asset-account
- (gnc:make-gnc-numeric -1 1))
+ -1/1)
(env-create-transaction env
date-2
my-income-account
my-asset-account
- (gnc:make-gnc-numeric -5 1))
+ -5/1)
(begin
(set-option report gnc:pagename-display "Show table" #t)
(set-option report gnc:pagename-general "Start Date" (cons 'absolute date-0))
@@ -160,15 +162,24 @@
(list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
(list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
result))))
- (and (every (lambda (row)
- (and (equal? (second row) (fourth row))
- (= 0 (string->number (car (third row))))))
+ (or (and (every (lambda (row)
+ (and (or (equal? (second row) (fourth row))
+ (begin (format "Second Element ~g != fourth element ~g~%" (second row) (fourth row)) #f))
+ (or (= 0 (string->number (car (third row))))
+ (begin (format "third row element ~a not 0~%" (car (third row))) #f))))
tbl)
- (= 0 (tbl-ref->number tbl 0 1))
- (= 1 (tbl-ref->number tbl 1 1))
- (= 6 (tbl-ref->number tbl 2 1))
- (= 3 (tbl-row-count tbl))
- (= 4 (tbl-column-count tbl)))))))))
+ (or (= 0 (tbl-ref->number tbl 0 1))
+ (begin (format #t "Item 1 failed: ~g not 0~%" (tbl-ref->number tbl 0 1)) #f))
+ (or (= 1 (tbl-ref->number tbl 1 1))
+ (begin (format #t "Item 1 failed: ~g not 1~%" (tbl-ref->number tbl 1 1)) #f))
+ (or (= 6 (tbl-ref->number tbl 2 1))
+ (begin (format #t "Item 2 failed: ~g not 6~%" (tbl-ref->number tbl 2 1)) #f))
+ (or (= 3 (tbl-row-count tbl))
+ (begin (format #t "Item 3 failed: ~g not 3~%" (tbl-row-count tbl)) #f))
+ (or (= 4 (tbl-column-count tbl))
+ (begin (format #t "Item 4 failed: ~g not 4~%" (tbl-column-count tbl)) #f)))
+ (begin (format #t "Two-txn test ~a failed~%" uuid) #f))
+ ))))))
(define (two-txn-test-2 uuid)
@@ -189,10 +200,10 @@
(date-0 (gnc:get-start-this-month))
(date-1 (gnc:timepair-next-day date-0))
(date-2 (gnc:timepair-next-day date-1)))
- (env-create-transaction env date-1 my-income-account my-asset-account (gnc:make-gnc-numeric -1 1))
- (env-create-transaction env date-1 my-expense-account my-liability-account (gnc:make-gnc-numeric -1 1))
- (env-create-transaction env date-2 my-income-account my-asset-account (gnc:make-gnc-numeric -5 1))
- (env-create-transaction env date-2 my-expense-account my-liability-account (gnc:make-gnc-numeric -5 1))
+ (env-create-transaction env date-1 my-income-account my-asset-account -1/1)
+ (env-create-transaction env date-1 my-expense-account my-liability-account -1/1)
+ (env-create-transaction env date-2 my-income-account my-asset-account -5/1)
+ (env-create-transaction env date-2 my-expense-account my-liability-account -5/1)
(begin
(set-option report gnc:pagename-display "Show table" #t)
(set-option report gnc:pagename-general "Start Date" (cons 'absolute date-0))
@@ -214,7 +225,7 @@
(list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
(list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
result))))
- (and (every (lambda (row)
+ (or (and (every (lambda (row)
(and (= (string->number (car (fourth row)))
(+ (string->number (car (second row)))
(string->number (car (third row)))))
@@ -225,7 +236,9 @@
(= 1 (tbl-ref->number tbl 1 1))
(= 6 (tbl-ref->number tbl 2 1))
(= 3 (tbl-row-count tbl))
- (= 4 (tbl-column-count tbl)))))))))
+ (= 4 (tbl-column-count tbl)))
+ (begin (format #t "two-txn test 2 ~a failed~%" uuid) #f))
+ ))))))
(define (two-txn-test-income uuid)
(let* ((template (gnc:find-report-template uuid))
@@ -245,10 +258,10 @@
(date-0 (gnc:get-start-this-month))
(date-1 (gnc:timepair-next-day date-0))
(date-2 (gnc:timepair-next-day date-1)))
- (env-create-transaction env date-1 my-income-account my-asset-account (gnc:make-gnc-numeric -1 1))
- (env-create-transaction env date-1 my-expense-account my-liability-account (gnc:make-gnc-numeric -1 1))
- (env-create-transaction env date-2 my-income-account my-asset-account (gnc:make-gnc-numeric -5 1))
- (env-create-transaction env date-2 my-expense-account my-liability-account (gnc:make-gnc-numeric -5 1))
+ (env-create-transaction env date-1 my-income-account my-asset-account -1/1)
+ (env-create-transaction env date-1 my-expense-account my-liability-account -1/1)
+ (env-create-transaction env date-2 my-income-account my-asset-account -5/1)
+ (env-create-transaction env date-2 my-expense-account my-liability-account -5/1)
(begin
(set-option report gnc:pagename-display "Show table" #t)
(set-option report gnc:pagename-general "Start Date" (cons 'absolute date-0))
@@ -270,7 +283,7 @@
(list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
(list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
result))))
- (and (every (lambda (row)
+ (or (and (every (lambda (row)
(and (= (string->number (car (fourth row)))
(+ (string->number (car (second row)))
(string->number (car (third row)))))
@@ -281,7 +294,9 @@
(= 1 (tbl-ref->number tbl 1 1))
(= 5 (tbl-ref->number tbl 2 1))
(= 3 (tbl-row-count tbl))
- (= 4 (tbl-column-count tbl)))))))))
+ (= 4 (tbl-column-count tbl)))
+ (begin (format #t "two-txn-income test ~a failed~%" uuid) #f))
+ ))))))
(define (closing-test uuid)
@@ -306,12 +321,12 @@
(date-2 (gnc:timepair-next-day date-1))
(date-3 (gnc:timepair-next-day date-2)))
- (env-create-transaction env date-1 my-income-account my-asset-account (gnc:make-gnc-numeric -1 1))
- (env-create-transaction env date-2 my-income-account my-asset-account (gnc:make-gnc-numeric -2 1))
- (env-create-transaction env date-3 my-income-account my-asset-account (gnc:make-gnc-numeric -3 1))
+ (env-create-transaction env date-1 my-income-account my-asset-account -1/1)
+ (env-create-transaction env date-2 my-income-account my-asset-account -2/1)
+ (env-create-transaction env date-3 my-income-account my-asset-account -3/1)
(let ((closing-txn (env-create-transaction env date-2 my-asset-account my-equity-account
- (gnc:make-gnc-numeric 300 1))))
+ 300/1)))
(xaccTransSetIsClosingTxn closing-txn #t))
(begin
@@ -335,7 +350,7 @@
(list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
(list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
result))))
- (and (every (lambda (row)
+ (or (and (every (lambda (row)
(and (= (string->number (car (fourth row)))
(+ (string->number (car (second row)))
(string->number (car (third row)))))))
@@ -345,5 +360,7 @@
(= 2 (tbl-ref->number tbl 2 1))
(= 3 (tbl-ref->number tbl 3 1))
(= 4 (tbl-row-count tbl))
- (= 4 (tbl-column-count tbl)))))))))
+ (= 4 (tbl-column-count tbl)))
+ (begin (format #t "Closing-txn test ~a failed~%" uuid) #f))
+ ))))))
diff --git a/gnucash/report/standard-reports/test/test-generic-net-linechart.scm b/gnucash/report/standard-reports/test/test-generic-net-linechart.scm
index 3b26dfe..89825b7 100644
--- a/gnucash/report/standard-reports/test/test-generic-net-linechart.scm
+++ b/gnucash/report/standard-reports/test/test-generic-net-linechart.scm
@@ -80,7 +80,7 @@
(gnc:get-start-this-month)
my-income-account
my-asset-account
- (gnc:make-gnc-numeric -1 1))
+ -1/1)
(begin
(set-option report gnc:pagename-display "Show table" #t)
(set-option report gnc:pagename-general "Start Date"
@@ -131,12 +131,12 @@
date-1
my-income-account
my-asset-account
- (gnc:make-gnc-numeric -1 1))
+ -1/1)
(env-create-transaction env
date-2
my-income-account
my-asset-account
- (gnc:make-gnc-numeric -5 1))
+ -5/1)
(begin
(set-option report gnc:pagename-display "Show table" #t)
(set-option report gnc:pagename-general "Start Date" (cons 'absolute date-0))
@@ -187,10 +187,10 @@
(date-0 (gnc:get-start-this-month))
(date-1 (gnc:timepair-next-day date-0))
(date-2 (gnc:timepair-next-day date-1)))
- (env-create-transaction env date-1 my-income-account my-asset-account (gnc:make-gnc-numeric -1 1))
- (env-create-transaction env date-1 my-expense-account my-liability-account (gnc:make-gnc-numeric -1 1))
- (env-create-transaction env date-2 my-income-account my-asset-account (gnc:make-gnc-numeric -5 1))
- (env-create-transaction env date-2 my-expense-account my-liability-account (gnc:make-gnc-numeric -5 1))
+ (env-create-transaction env date-1 my-income-account my-asset-account -1/1)
+ (env-create-transaction env date-1 my-expense-account my-liability-account -1/1)
+ (env-create-transaction env date-2 my-income-account my-asset-account -5/1)
+ (env-create-transaction env date-2 my-expense-account my-liability-account -5/1)
(begin
(set-option report gnc:pagename-display "Show table" #t)
(set-option report gnc:pagename-general "Start Date" (cons 'absolute date-0))
diff --git a/gnucash/report/utility-reports/hello-world.scm b/gnucash/report/utility-reports/hello-world.scm
index 5337aa9..8ee7b30 100644
--- a/gnucash/report/utility-reports/hello-world.scm
+++ b/gnucash/report/utility-reports/hello-world.scm
@@ -409,7 +409,7 @@ new, totally cool report, consult the mailing list %s.")
(_ "The number option formatted as currency is %s.")
(gnc:html-markup-b
(xaccPrintAmount
- (gnc:make-gnc-numeric (inexact->exact num-val) 1)
+ (inexact->exact num-val)
(gnc-default-print-info #f)))))))
;; you can add as many objects as you want. Here's another
diff --git a/libgnucash/app-utils/gnc-euro.c b/libgnucash/app-utils/gnc-euro.c
index 8853052..7793285 100644
--- a/libgnucash/app-utils/gnc-euro.c
+++ b/libgnucash/app-utils/gnc-euro.c
@@ -218,7 +218,7 @@ gnc_euro_currency_get_rate (const gnc_commodity *currency)
return gnc_numeric_zero ();
return double_to_gnc_numeric (result->rate, GNC_DENOM_AUTO,
- GNC_HOW_DENOM_SIGFIGS(6) | GNC_HOW_RND_ROUND_HALF_UP);
+ GNC_HOW_RND_ROUND_HALF_UP);
}
/* ------------------------------------------------------ */
diff --git a/libgnucash/app-utils/guile-util.c b/libgnucash/app-utils/guile-util.c
index 5e1ef95..68325d0 100644
--- a/libgnucash/app-utils/guile-util.c
+++ b/libgnucash/app-utils/guile-util.c
@@ -520,7 +520,7 @@ gnc_split_scm_get_amount(SCM split_scm)
return gnc_numeric_zero ();
result = scm_call_1(getters.split_scm_amount, split_scm);
- if (!gnc_numeric_p(result))
+ if (!scm_rational_p(result))
return gnc_numeric_zero ();
return gnc_scm_to_numeric(result);
@@ -545,7 +545,7 @@ gnc_split_scm_get_value(SCM split_scm)
return gnc_numeric_zero ();
result = scm_call_1(getters.split_scm_value, split_scm);
- if (!gnc_numeric_p(result))
+ if (!scm_rational_p(result))
return gnc_numeric_zero ();
return gnc_scm_to_numeric(result);
diff --git a/libgnucash/engine/engine-helpers-guile.h b/libgnucash/engine/engine-helpers-guile.h
index e22a125..218d4f6 100644
--- a/libgnucash/engine/engine-helpers-guile.h
+++ b/libgnucash/engine/engine-helpers-guile.h
@@ -50,11 +50,8 @@ GSList * gnc_query_scm2path (SCM path_scm);
SCM gnc_query2scm (QofQuery * q);
QofQuery * gnc_scm2query (SCM query_scm);
-int gnc_gh_gint64_p(SCM num);
-
SCM gnc_numeric_to_scm(gnc_numeric arg);
gnc_numeric gnc_scm_to_numeric(SCM arg);
-int gnc_numeric_p(SCM arg);
gnc_commodity * gnc_scm_to_commodity(SCM scm);
SCM gnc_commodity_to_scm (const gnc_commodity *commodity);
SCM gnc_book_to_scm (const QofBook *book);
diff --git a/libgnucash/engine/engine-helpers.c b/libgnucash/engine/engine-helpers.c
index d10de0a..f25b160 100644
--- a/libgnucash/engine/engine-helpers.c
+++ b/libgnucash/engine/engine-helpers.c
@@ -319,8 +319,8 @@ int
gnc_timepair_p(SCM x)
{
return(scm_is_pair(x) &&
- gnc_gh_gint64_p(SCM_CAR(x)) &&
- gnc_gh_gint64_p(SCM_CDR(x)));
+ (scm_is_signed_integer(SCM_CAR(x), INT64_MIN, INT64_MAX) &&
+ scm_is_signed_integer(SCM_CDR(x), INT64_MIN, INT64_MAX)));
}
SCM
@@ -1110,10 +1110,8 @@ gnc_scm2query_term_query_v1 (SCM query_term_scm)
break;
scm = SCM_CAR (query_term_scm);
query_term_scm = SCM_CDR (query_term_scm);
- amount = scm_to_double (scm);
-
- val = double_to_gnc_numeric (amount, GNC_DENOM_AUTO,
- GNC_HOW_DENOM_SIGFIGS(6) | GNC_HOW_RND_ROUND_HALF_UP);
+ val = gnc_numeric_create (scm_to_int64(scm_numerator(scm)),
+ scm_to_int64(scm_denominator(scm)));
if (!g_strcmp0 (pr_type, "pr-price"))
{
@@ -1997,96 +1995,23 @@ gnc_scm2query (SCM query_scm)
return q;
}
-int
-gnc_gh_gint64_p(SCM num)
-{
- static int initialized = 0;
- static SCM maxval;
- static SCM minval;
-
- if (!initialized)
- {
- /* to be super safe, we have to build these manually because
- though we know that we have gint64's here, we *don't* know how
- to portably specify a 64bit constant to the compiler (i.e. like
- 0x7FFFFFFFFFFFFFFF). */
- gint64 tmp;
-
- tmp = 0x7FFFFFFF;
- tmp <<= 32;
- tmp |= 0xFFFFFFFF;
- maxval = scm_from_int64(tmp);
-
- tmp = 0x80000000;
- tmp <<= 32;
- minval = scm_from_int64(tmp);
-
- scm_gc_protect_object(maxval);
- scm_gc_protect_object(minval);
- initialized = 1;
- }
-
- return (scm_is_exact(num) &&
- (scm_geq_p(num, minval) != SCM_BOOL_F) &&
- (scm_leq_p(num, maxval) != SCM_BOOL_F));
-}
-
gnc_numeric
gnc_scm_to_numeric(SCM gncnum)
{
- static SCM get_num = SCM_BOOL_F;
- static SCM get_denom = SCM_BOOL_F;
-
- if (get_num == SCM_BOOL_F)
- {
- get_num = scm_c_eval_string("gnc:gnc-numeric-num");
- }
- if (get_denom == SCM_BOOL_F)
- {
- get_denom = scm_c_eval_string("gnc:gnc-numeric-denom");
- }
-
- return gnc_numeric_create(scm_to_int64(scm_call_1(get_num, gncnum)),
- scm_to_int64(scm_call_1(get_denom, gncnum)));
+ if (scm_is_signed_integer(scm_numerator(gncnum), INT64_MIN, INT64_MAX) &&
+ scm_is_signed_integer(scm_denominator(gncnum), INT64_MIN, INT64_MAX))
+ return gnc_numeric_create(scm_to_int64(scm_numerator(gncnum)),
+ scm_to_int64(scm_denominator(gncnum)));
+ return gnc_numeric_create(0, GNC_ERROR_OVERFLOW);
}
SCM
gnc_numeric_to_scm(gnc_numeric arg)
{
- static SCM maker = SCM_BOOL_F;
-
- if (maker == SCM_BOOL_F)
- {
- maker = scm_c_eval_string("gnc:make-gnc-numeric");
- }
-
- return scm_call_2(maker, scm_from_int64(gnc_numeric_num(arg)),
- scm_from_int64(gnc_numeric_denom(arg)));
-}
-
-int
-gnc_numeric_p(SCM arg)
-{
- static SCM type_p = SCM_BOOL_F;
- SCM ret = SCM_BOOL_F;
-
- if (type_p == SCM_BOOL_F)
- {
- type_p = scm_c_eval_string("gnc:gnc-numeric?");
- }
- ret = scm_call_1(type_p, arg);
-
- if (ret == SCM_BOOL_F)
- {
- return FALSE;
- }
- else
- {
- return TRUE;
- }
+ return scm_divide(scm_from_int64(arg.num),
+ scm_from_int64(arg.denom));
}
-
static SCM
gnc_generic_to_scm(const void *cx, const gchar *type_str)
{
diff --git a/libgnucash/engine/engine.scm b/libgnucash/engine/engine.scm
index fdb0b40..b3023a3 100644
--- a/libgnucash/engine/engine.scm
+++ b/libgnucash/engine/engine.scm
@@ -43,12 +43,6 @@
(export GNC-ERROR-OVERFLOW)
(export GNC-ERROR-DENOM-DIFF)
(export GNC-ERROR-REMAINDER)
-(export <gnc-numeric>)
-(export gnc:gnc-numeric?)
-(export gnc:make-gnc-numeric)
-(export gnc:gnc-numeric-denom)
-(export gnc:gnc-numeric-num)
-(export gnc:gnc-numeric-denom-reciprocal)
(export <gnc-monetary>)
(export gnc:gnc-monetary?)
(export gnc:make-gnc-monetary)
diff --git a/libgnucash/engine/gnc-numeric.scm b/libgnucash/engine/gnc-numeric.scm
index c264dc1..f7c846a 100644
--- a/libgnucash/engine/gnc-numeric.scm
+++ b/libgnucash/engine/gnc-numeric.scm
@@ -47,26 +47,6 @@
(define GNC-ERROR-DENOM-DIFF -3)
(define GNC-ERROR-REMAINDER -4)
-(define <gnc-numeric>
- (make-record-type "<gnc-numeric>"
- '(num denom)))
-
-(define gnc:make-gnc-numeric
- (record-constructor <gnc-numeric>))
-
-(define gnc:gnc-numeric?
- (record-predicate <gnc-numeric>))
-
-(define gnc:gnc-numeric-num
- (record-accessor <gnc-numeric> 'num))
-
-(define gnc:gnc-numeric-denom
- (record-accessor <gnc-numeric> 'denom))
-
-(define (gnc:gnc-numeric-denom-reciprocal arg)
- (- arg))
-
-
(define <gnc-monetary>
(make-record-type "<gnc-monetary>"
@@ -76,7 +56,7 @@
(define (gnc:make-gnc-monetary c a)
;;FIXME: we used to type-check the values, like:
;; (gw:wcp-is-of-type? <gnc:commodity*> c)
- (if (and #t (gnc:gnc-numeric? a))
+ (if (and #t (number? a))
((record-constructor <gnc-monetary>) c a)
(warn "wrong arguments for gnc:make-gnc-monetary: " c a)))
diff --git a/libgnucash/engine/kvp-scm.cpp b/libgnucash/engine/kvp-scm.cpp
index 2648526..2e95e65 100644
--- a/libgnucash/engine/kvp-scm.cpp
+++ b/libgnucash/engine/kvp-scm.cpp
@@ -25,22 +25,26 @@ extern "C"
KvpValue *
gnc_scm_to_kvp_value_ptr(SCM val)
{
- if (scm_is_number(val))
+ if (scm_is_rational(val))
{
- /* in guile 1.8 (exact? ) only works on numbers */
- if (scm_is_exact (val) && gnc_gh_gint64_p(val))
+ if (scm_is_exact_integer(val) &&
+ scm_is_signed_integer(val, INT64_MIN, INT64_MAX))
{
return new KvpValue{scm_to_int64(val)};
}
+ else if (scm_is_exact(val) &&
+ scm_is_signed_integer(scm_numerator(val),
+ INT64_MIN, INT64_MAX) &&
+ scm_is_signed_integer(scm_denominator(val),
+ INT64_MIN, INT64_MAX))
+ {
+ return new KvpValue{gnc_scm_to_numeric(val)};
+ }
else
{
return new KvpValue{scm_to_double(val)};
}
}
- else if (gnc_numeric_p(val))
- {
- return new KvpValue{gnc_scm_to_numeric(val)};
- }
else if (gnc_guid_p(val))
{
auto guid = gnc_scm2guid(val);
diff --git a/libgnucash/engine/test/test-extras.scm b/libgnucash/engine/test/test-extras.scm
index 06e0ebd..faf6508 100644
--- a/libgnucash/engine/test/test-extras.scm
+++ b/libgnucash/engine/test/test-extras.scm
@@ -115,7 +115,7 @@
(cons 'sink (make-test-sink))))
(define (env-random-amount env n)
- (gnc:make-gnc-numeric (env-random env n) 1))
+ (/ (env-random env n) 1))
(define (env-random env n)
(random n (assoc-ref env 'random)))
@@ -183,9 +183,9 @@
(for-each (lambda (date)
(env-create-transaction env date to-account
from-account
- (gnc:make-gnc-numeric
- (gnc:date-get-month-day (gnc:timepair->date date))
- 1)))
+ (/
+ (gnc:date-get-month-day (gnc:timepair->date date))
+ 1)))
(cdr (reverse dates-this-month)))))
(define (env-create-account-structure env account-structure)
diff --git a/libgnucash/engine/test/test-split.scm b/libgnucash/engine/test/test-split.scm
index 7c14389..7cd8183 100644
--- a/libgnucash/engine/test/test-split.scm
+++ b/libgnucash/engine/test/test-split.scm
@@ -17,8 +17,8 @@
(bank-account (cdr (assoc "Bank" account-alist)))
(expense-account (cdr (assoc "Expenses" account-alist)))
(wallet-account (cdr (assoc "Wallet" account-alist)))
- (tx1 (env-create-transaction env today bank-account wallet-account (gnc:make-gnc-numeric 20 1)))
- (tx2 (env-create-transaction env today bank-account expense-account (gnc:make-gnc-numeric 10 1)))
+ (tx1 (env-create-transaction env today bank-account wallet-account 20/1))
+ (tx2 (env-create-transaction env today bank-account expense-account 10/1))
(splits-tx1 (xaccTransGetSplitList tx1))
(splits-tx2 (xaccTransGetSplitList tx2)))
(and (split-in-list? (first splits-tx1) splits-tx1)
commit 7061803596ed61dd9829235927f44c0adc9c9ddc
Author: John Ralls <jralls at ceridwen.us>
Date: Mon Dec 18 09:46:42 2017 -0800
Remove SIGFIG rounding from price calculation.
Prices shouldn't be rounded except for display.
diff --git a/libgnucash/engine/Split.c b/libgnucash/engine/Split.c
index 86072d1..c7e86d8 100644
--- a/libgnucash/engine/Split.c
+++ b/libgnucash/engine/Split.c
@@ -60,8 +60,6 @@
const char *void_former_amt_str = "void-former-amount";
const char *void_former_val_str = "void-former-value";
-#define PRICE_SIGFIGS 6
-
/* This static indicates the debugging module that this .o belongs to. */
static QofLogModule log_module = GNC_MOD_ENGINE;
@@ -1956,7 +1954,6 @@ xaccSplitGetSharePrice (const Split * split)
}
price = gnc_numeric_div(val, amt,
GNC_DENOM_AUTO,
- GNC_HOW_DENOM_SIGFIGS(PRICE_SIGFIGS) |
GNC_HOW_RND_ROUND_HALF_UP);
/* During random checks we can get some very weird prices. Let's
diff --git a/libgnucash/engine/test/utest-Split.cpp b/libgnucash/engine/test/utest-Split.cpp
index 7609242..815c2ca 100644
--- a/libgnucash/engine/test/utest-Split.cpp
+++ b/libgnucash/engine/test/utest-Split.cpp
@@ -1670,7 +1670,6 @@ test_xaccSplitGetSharePrice (Fixture *fixture, gconstpointer pData)
gnc_numeric expected = gnc_numeric_create (1, 1);
Split *split = fixture->split;
/* Warning: this is a define in Split.c */
- const guint PRICE_SIGFIGS = 6;
char *logdomain = "gnc.engine";
GLogLevelFlags loglevel = static_cast<GLogLevelFlags>(G_LOG_LEVEL_CRITICAL | G_LOG_FLAG_FATAL);
TestErrorStruct check = { loglevel, logdomain, NULL, 0 };
@@ -1685,7 +1684,6 @@ test_xaccSplitGetSharePrice (Fixture *fixture, gconstpointer pData)
expected = gnc_numeric_div (split->value, split->amount,
GNC_DENOM_AUTO,
- GNC_HOW_DENOM_SIGFIGS (PRICE_SIGFIGS) |
GNC_HOW_RND_ROUND_HALF_UP);
result = xaccSplitGetSharePrice (split);
@@ -1710,7 +1708,6 @@ test_xaccSplitGetSharePrice (Fixture *fixture, gconstpointer pData)
split->value = gnc_numeric_create (3, 789304166);
quotient = gnc_numeric_div (split->value, split->amount,
GNC_DENOM_AUTO,
- GNC_HOW_DENOM_SIGFIGS (PRICE_SIGFIGS) |
GNC_HOW_RND_ROUND_HALF_UP);
check.msg = g_strdup_printf ("[xaccSplitGetSharePrice()] "
"Computing share price failed (%d): [ %"
@@ -1730,7 +1727,6 @@ test_xaccSplitGetSharePrice (Fixture *fixture, gconstpointer pData)
split->value = gnc_numeric_create (3, 0);
quotient = gnc_numeric_div (split->value, split->amount,
GNC_DENOM_AUTO,
- GNC_HOW_DENOM_SIGFIGS (PRICE_SIGFIGS) |
GNC_HOW_RND_ROUND_HALF_UP);
check.msg = g_strdup_printf ("[xaccSplitGetSharePrice()] "
"Computing share price failed (%d): [ %"
@@ -1750,7 +1746,6 @@ test_xaccSplitGetSharePrice (Fixture *fixture, gconstpointer pData)
split->value = gnc_numeric_create (3, 789304166);
quotient = gnc_numeric_div (split->value, split->amount,
GNC_DENOM_AUTO,
- GNC_HOW_DENOM_SIGFIGS (PRICE_SIGFIGS) |
GNC_HOW_RND_ROUND_HALF_UP);
check.msg = g_strdup_printf ("[xaccSplitGetSharePrice()] "
"Computing share price failed (%d): [ %"
Summary of changes:
.../report/business-reports/balsheet-eg.eguile.scm | 2 +-
gnucash/report/business-reports/receipt.scm | 2 +-
gnucash/report/business-reports/taxinvoice.scm | 2 +-
gnucash/report/locale-specific/us/taxtxf.scm | 4 +-
.../report/report-system/commodity-utilities.scm | 14 ++--
gnucash/report/report-system/html-barchart.scm | 2 -
gnucash/report/report-system/html-linechart.scm | 2 -
gnucash/report/report-system/html-piechart.scm | 4 +-
gnucash/report/report-system/html-scatter.scm | 4 +-
gnucash/report/report-system/report-system.scm | 2 +-
gnucash/report/report-system/report-utilities.scm | 40 ++++-----
.../report/standard-reports/advanced-portfolio.scm | 8 +-
gnucash/report/standard-reports/cash-flow.scm | 16 ++--
.../report/standard-reports/category-barchart.scm | 8 +-
gnucash/report/standard-reports/net-barchart.scm | 4 +-
gnucash/report/standard-reports/sx-summary.scm | 2 +-
.../standard-reports/test/test-cash-flow.scm | 44 ++++++----
.../test/test-cashflow-barchart.scm | 38 +++++----
.../test/test-generic-net-barchart.scm | 79 +++++++++++-------
.../test/test-generic-net-linechart.scm | 14 ++--
gnucash/report/utility-reports/hello-world.scm | 2 +-
libgnucash/app-utils/gnc-euro.c | 2 +-
libgnucash/app-utils/guile-util.c | 4 +-
libgnucash/engine/Split.c | 3 -
libgnucash/engine/engine-helpers-guile.h | 3 -
libgnucash/engine/engine-helpers.c | 97 +++-------------------
libgnucash/engine/engine.scm | 6 --
libgnucash/engine/gnc-numeric.scm | 22 +----
libgnucash/engine/kvp-scm.cpp | 18 ++--
libgnucash/engine/test/test-extras.scm | 8 +-
libgnucash/engine/test/test-split.scm | 4 +-
libgnucash/engine/test/utest-Split.cpp | 5 --
32 files changed, 190 insertions(+), 275 deletions(-)
More information about the gnucash-changes
mailing list