gnucash master: Multiple changes pushed
Christopher Lam
clam at code.gnucash.org
Tue Jun 23 22:10:36 EDT 2020
Updated via https://github.com/Gnucash/gnucash/commit/c12c6af2 (commit)
via https://github.com/Gnucash/gnucash/commit/64637f72 (commit)
from https://github.com/Gnucash/gnucash/commit/fb9cde36 (commit)
commit c12c6af2fbf87164d1b525ae44c502a25e322ab9
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Jun 24 09:39:33 2020 +0800
[test-portfolios] 100% coverage for advanced-portfolio helper fns
diff --git a/gnucash/report/reports/standard/test/test-portfolios.scm b/gnucash/report/reports/standard/test/test-portfolios.scm
index 298d072e0..84138072d 100644
--- a/gnucash/report/reports/standard/test/test-portfolios.scm
+++ b/gnucash/report/reports/standard/test/test-portfolios.scm
@@ -43,6 +43,7 @@
(null-test "portfolio" portfolio-uuid)
(null-test "advanced-portfolio" advanced-uuid)
(portfolio-tests)
+ (advanced-helper-tests)
(advanced-tests)
(test-end "test-portfolios.scm"))
@@ -122,3 +123,76 @@
"-$1.00" "-0.13%")
(sxml->table-row-col sxml 1 1 #f))))
(teardown)))
+
+(define (advanced-helper-tests)
+ (define sum-basis
+ (@@ (gnucash reports standard advanced-portfolio) sum-basis))
+ (define units-basis
+ (@@ (gnucash reports standard advanced-portfolio) units-basis))
+ (define apply-basis-ratio
+ (@@ (gnucash reports standard advanced-portfolio) apply-basis-ratio))
+ (define basis-builder
+ (@@ (gnucash reports standard advanced-portfolio) basis-builder))
+ (define basis1 '((3 . 4) (5 . 6) (7 . 8)))
+ (define basis2 '((3 . 4) (5 . 6) (7 . 8) (9 . 10)))
+
+ (test-equal "sum-basis"
+ 98
+ (sum-basis basis1 100))
+ (test-equal "sum-basis"
+ 188
+ (sum-basis basis2 100))
+
+ (test-equal "units-basis"
+ 15
+ (units-basis basis1))
+ (test-equal "units-basis"
+ 24
+ (units-basis basis2))
+
+ (test-equal "apply-basis-ratio"
+ '((6 . 12) (10 . 18) (14 . 24))
+ (apply-basis-ratio basis1 2 3))
+ (test-equal "apply-basis-ratio"
+ '((6 . 12) (10 . 18) (14 . 24) (18 . 30))
+ (apply-basis-ratio basis2 2 3))
+
+ (test-equal "basis-builder buy new units"
+ '((3 . 133333333/100000000))
+ (basis-builder '() 3 4 'average-basis 100))
+ (test-equal "basis-builder buy new units average"
+ '((6 . 266666667/100000000))
+ (basis-builder '((3 . 4) (5 . 6) (7 . 8)) 3 4 'average-basis 100))
+ (test-equal "basis-builder buy new units FIFO"
+ '((3 . 4) (5 . 6) (7 . 8) (3 . 133333333/100000000))
+ (basis-builder '((3 . 4) (5 . 6) (7 . 8)) 3 4 'fifo-basis 100))
+ (test-equal "basis-builder buy new units LIFO"
+ '((3 . 4) (5 . 6) (7 . 8) (3 . 133333333/100000000))
+ (basis-builder '((3 . 4) (5 . 6) (7 . 8)) 3 4 'filo-basis 100))
+
+ (test-equal "basis-builder sell average"
+ '((0 . 4))
+ (basis-builder '((3 . 4) (5 . 6) (7 . 8)) -3 4 'average-basis 100))
+ (test-equal "basis-builder sell FIFO first"
+ '((5 . 6) (7 . 8))
+ (basis-builder '((3 . 4) (5 . 6) (7 . 8)) -3 4 'fifo-basis 100))
+ (test-equal "basis-builder sell FIFO 2 lots"
+ '((3 . 6) (7 . 8))
+ (basis-builder '((3 . 4) (5 . 6) (7 . 8)) -5 4 'fifo-basis 100))
+ (test-equal "basis-builder sell LIFO"
+ '((3 . 4) (5 . 6) (4 . 8))
+ (basis-builder '((3 . 4) (5 . 6) (7 . 8)) -3 4 'filo-basis 100))
+ (test-equal "basis-builder sell LIFO all"
+ '()
+ (basis-builder '((3 . 4) (5 . 6) (7 . 8)) -15 4 'filo-basis 100))
+ (test-equal "basis-builder sell LIFO more than we have"
+ '()
+ (basis-builder '() -15 4 'filo-basis 100))
+
+ (test-equal "basis-builder = no value just units = split/merge"
+ '((12/5 . 5) (4 . 15/2) (28/5 . 10))
+ (basis-builder '((3 . 4) (5 . 6) (7 . 8)) -3 0 'average-basis 100))
+
+ (test-equal "basis-builder = no units just value = spin-off"
+ '((3 . 8) (5 . 12) (7 . 16))
+ (basis-builder '((3 . 4) (5 . 6) (7 . 8)) 0 98 'average-basis 100)))
commit 64637f72cf465eb4ffdf74cc83517e4cec294381
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Jun 24 09:36:48 2020 +0800
[advanced-portfolio] move helper functions to toplevel for testing
functions are moved to toplevel advanced-portfolio.scm. this allows
them to be tested.
diff --git a/gnucash/report/reports/standard/advanced-portfolio.scm b/gnucash/report/reports/standard/advanced-portfolio.scm
index 279fcb91f..2210045d5 100644
--- a/gnucash/report/reports/standard/advanced-portfolio.scm
+++ b/gnucash/report/reports/standard/advanced-portfolio.scm
@@ -179,6 +179,158 @@ by preventing negative stock balances.<br/>")
(gnc:options-set-default-section options gnc:pagename-general)
options))
+;; helper functions for renderer
+
+;; sum up the contents of the b-list built by basis-builder below
+(define (sum-basis b-list currency-frac)
+ (if (not (eqv? b-list '()))
+ (gnc-numeric-add (gnc-numeric-mul (caar b-list) (cdar b-list) currency-frac GNC-RND-ROUND)
+ (sum-basis (cdr b-list) currency-frac) currency-frac GNC-RND-ROUND)
+ (gnc-numeric-zero)))
+
+;; sum up the total number of units in the b-list built by
+;; basis-builder below
+(define (units-basis b-list)
+ (if (not (eqv? b-list '()))
+ (gnc-numeric-add (caar b-list) (units-basis (cdr b-list))
+ units-denom GNC-RND-ROUND)
+ (gnc-numeric-zero)))
+
+;; apply a ratio to an existing basis-list, useful for splits/mergers and spinoffs
+;; I need to get a brain and use (map) for this.
+(define (apply-basis-ratio b-list units-ratio value-ratio)
+ (if (not (eqv? b-list '()))
+ (cons (cons (gnc-numeric-mul units-ratio (caar b-list) units-denom GNC-RND-ROUND)
+ (gnc-numeric-mul value-ratio (cdar b-list) price-denom GNC-RND-ROUND))
+ (apply-basis-ratio (cdr b-list) units-ratio value-ratio))
+ '()))
+
+;; this builds a list for basis calculation and handles average, fifo
+;; and lifo methods the list is cons cells of (units-of-stock
+;; . price-per-unit)... average method produces only one cell that
+;; mutates to the new average. Need to add a date checker so that we
+;; allow for prices coming in out of order, such as a transfer with a
+;; price adjusted to carryover the basis.
+(define (basis-builder b-list b-units b-value b-method currency-frac)
+ (gnc:debug "actually in basis-builder")
+ (gnc:debug "b-list is " b-list " b-units is " (gnc-numeric-to-string b-units)
+ " b-value is " (gnc-numeric-to-string b-value) " b-method is " b-method)
+
+ ;; if there is no b-value, then this is a split/merger and needs
+ ;; special handling
+ (cond
+
+ ;; we have value and positive units, add units to basis
+ ((and (not (gnc-numeric-zero-p b-value))
+ (gnc-numeric-positive-p b-units))
+ (case b-method
+ ((average-basis)
+ (if (not (eqv? b-list '()))
+ (list (cons (gnc-numeric-add b-units
+ (caar b-list) units-denom GNC-RND-ROUND)
+ (gnc-numeric-div
+ (gnc-numeric-add b-value
+ (gnc-numeric-mul (caar b-list)
+ (cdar b-list)
+ GNC-DENOM-AUTO GNC-DENOM-REDUCE)
+ GNC-DENOM-AUTO GNC-DENOM-REDUCE)
+ (let ((denom (gnc-numeric-add b-units
+ (caar b-list) GNC-DENOM-AUTO GNC-DENOM-REDUCE)))
+ (if (zero? denom)
+ (throw 'div/0 (format #f "buying ~0,4f share units" b-units))
+ denom))
+ price-denom GNC-RND-ROUND)))
+ (append b-list
+ (list (cons b-units (gnc-numeric-div
+ b-value b-units price-denom GNC-RND-ROUND))))))
+ (else (append b-list
+ (list (cons b-units (gnc-numeric-div
+ b-value b-units price-denom GNC-RND-ROUND)))))))
+
+ ;; we have value and negative units, remove units from basis
+ ((and (not (gnc-numeric-zero-p b-value))
+ (gnc-numeric-negative-p b-units))
+ (if (not (eqv? b-list '()))
+ (case b-method
+ ((fifo-basis)
+ (case (gnc-numeric-compare (gnc-numeric-abs b-units) (caar b-list))
+ ((-1)
+ ;; Sold less than the first lot, create a new first lot
+ ;; from the remainder
+ (let ((new-units (gnc-numeric-add b-units (caar b-list) units-denom GNC-RND-ROUND)))
+ (cons (cons new-units (cdar b-list)) (cdr b-list))))
+ ((0)
+ ;; Sold all of the first lot
+ (cdr b-list))
+ ((1)
+ ;; Sold more than the first lot, delete it and recurse
+ (basis-builder (cdr b-list) (gnc-numeric-add b-units (caar b-list) units-denom GNC-RND-ROUND)
+ ;; Only the sign of b-value matters since
+ ;; the new b-units is negative
+ b-value
+ b-method currency-frac))))
+ ((filo-basis)
+ (let ((rev-b-list (reverse b-list)))
+ (case (gnc-numeric-compare (gnc-numeric-abs b-units) (caar rev-b-list))
+ ((-1)
+ ;; Sold less than the last lot
+ (let ((new-units (gnc-numeric-add b-units (caar rev-b-list) units-denom GNC-RND-ROUND)))
+ (reverse (cons (cons new-units (cdar rev-b-list)) (cdr rev-b-list)))))
+ ((0)
+ ;; Sold all of the last lot
+ (reverse (cdr rev-b-list))
+ )
+ ((1)
+ ;; Sold more than the last lot
+ (basis-builder (reverse (cdr rev-b-list)) (gnc-numeric-add b-units (caar rev-b-list) units-denom GNC-RND-ROUND)
+ b-value b-method currency-frac)))))
+ ((average-basis)
+ (list (cons (gnc-numeric-add
+ (caar b-list) b-units units-denom GNC-RND-ROUND)
+ (cdar b-list)))))
+ '()))
+
+ ;; no value, just units, this is a split/merge...
+ ((and (gnc-numeric-zero-p b-value)
+ (not (gnc-numeric-zero-p b-units)))
+ (let* ((current-units (units-basis b-list))
+ ;; If current-units is zero then so should be everything else.
+ (units-ratio (if (zero? current-units) (gnc-numeric-zero)
+ (gnc-numeric-div (gnc-numeric-add b-units current-units GNC-DENOM-AUTO GNC-DENOM-REDUCE)
+ current-units GNC-DENOM-AUTO GNC-DENOM-REDUCE)))
+ ;; 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 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)
+ " value ratio is " (gnc-numeric-to-string value-ratio)
+ " units ratio is " (gnc-numeric-to-string units-ratio))
+ (apply-basis-ratio b-list units-ratio value-ratio)))
+
+ ;; If there are no units, just a value, then its a spin-off,
+ ;; calculate a ratio for the values, but leave the units alone
+ ;; with a ratio of 1
+ ((and (gnc-numeric-zero-p b-units)
+ (not (gnc-numeric-zero-p b-value)))
+ (let* ((current-value (sum-basis b-list GNC-DENOM-AUTO))
+ (value-ratio (if (zero? current-value)
+ (throw 'div/0 (format #f "spinoff of ~,2f currency units" current-value))
+ (gnc-numeric-div (gnc-numeric-add b-value current-value GNC-DENOM-AUTO GNC-DENOM-REDUCE)
+ current-value GNC-DENOM-AUTO GNC-DENOM-REDUCE))))
+
+ (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 1/1 value-ratio)))
+
+ ;; when all else fails, just send the b-list back
+ (else
+ b-list)))
+
+
+
;; This is the rendering function. It accepts a database of options
;; and generates an object of type <html-document>. See the file
;; report-html.txt for documentation; the file report-html.scm
@@ -209,158 +361,6 @@ by preventing negative stock balances.<br/>")
(define (same-account? a1 a2)
(equal? (gncAccountGetGUID a1) (gncAccountGetGUID a2)))
- ;; sum up the contents of the b-list built by basis-builder below
- (define (sum-basis b-list currency-frac)
- (if (not (eqv? b-list '()))
- (gnc-numeric-add (gnc-numeric-mul (caar b-list) (cdar b-list) currency-frac GNC-RND-ROUND)
- (sum-basis (cdr b-list) currency-frac) currency-frac GNC-RND-ROUND)
- (gnc-numeric-zero)
- )
- )
-
- ;; sum up the total number of units in the b-list built by basis-builder below
- (define (units-basis b-list)
- (if (not (eqv? b-list '()))
- (gnc-numeric-add (caar b-list) (units-basis (cdr b-list))
- units-denom GNC-RND-ROUND)
- (gnc-numeric-zero)
- )
- )
-
- ;; apply a ratio to an existing basis-list, useful for splits/mergers and spinoffs
- ;; I need to get a brain and use (map) for this.
- (define (apply-basis-ratio b-list units-ratio value-ratio)
- (if (not (eqv? b-list '()))
- (cons (cons (gnc-numeric-mul units-ratio (caar b-list) units-denom GNC-RND-ROUND)
- (gnc-numeric-mul value-ratio (cdar b-list) price-denom GNC-RND-ROUND))
- (apply-basis-ratio (cdr b-list) units-ratio value-ratio))
- '()
- )
- )
-
- ;; this builds a list for basis calculation and handles average, fifo and lifo methods
- ;; the list is cons cells of (units-of-stock . price-per-unit)... average method produces only one
- ;; cell that mutates to the new average. Need to add a date checker so that we allow for prices
- ;; coming in out of order, such as a transfer with a price adjusted to carryover the basis.
- (define (basis-builder b-list b-units b-value b-method currency-frac)
- (gnc:debug "actually in basis-builder")
- (gnc:debug "b-list is " b-list " b-units is " (gnc-numeric-to-string b-units)
- " b-value is " (gnc-numeric-to-string b-value) " b-method is " b-method)
-
- ;; if there is no b-value, then this is a split/merger and needs special handling
- (cond
-
- ;; we have value and positive units, add units to basis
- ((and (not (gnc-numeric-zero-p b-value))
- (gnc-numeric-positive-p b-units))
- (case b-method
- ((average-basis)
- (if (not (eqv? b-list '()))
- (list (cons (gnc-numeric-add b-units
- (caar b-list) units-denom GNC-RND-ROUND)
- (gnc-numeric-div
- (gnc-numeric-add b-value
- (gnc-numeric-mul (caar b-list)
- (cdar b-list)
- GNC-DENOM-AUTO GNC-DENOM-REDUCE)
- GNC-DENOM-AUTO GNC-DENOM-REDUCE)
- (let ((denom (gnc-numeric-add b-units
- (caar b-list) GNC-DENOM-AUTO GNC-DENOM-REDUCE)))
- (if (zero? denom)
- (throw 'div/0 (format #f "buying ~0,4f share units" b-units))
- denom))
- price-denom GNC-RND-ROUND)))
- (append b-list
- (list (cons b-units (gnc-numeric-div
- b-value b-units price-denom GNC-RND-ROUND))))))
- (else (append b-list
- (list (cons b-units (gnc-numeric-div
- b-value b-units price-denom GNC-RND-ROUND)))))))
-
- ;; we have value and negative units, remove units from basis
- ((and (not (gnc-numeric-zero-p b-value))
- (gnc-numeric-negative-p b-units))
- (if (not (eqv? b-list '()))
- (case b-method
- ((fifo-basis)
- (case (gnc-numeric-compare (gnc-numeric-abs b-units) (caar b-list))
- ((-1)
- ;; Sold less than the first lot, create a new first lot from the remainder
- (let ((new-units (gnc-numeric-add b-units (caar b-list) units-denom GNC-RND-ROUND)))
- (cons (cons new-units (cdar b-list)) (cdr b-list))))
- ((0)
- ;; Sold all of the first lot
- (cdr b-list))
- ((1)
- ;; Sold more than the first lot, delete it and recurse
- (basis-builder (cdr b-list) (gnc-numeric-add b-units (caar b-list) units-denom GNC-RND-ROUND)
- b-value ;; Only the sign of b-value matters since the new b-units is negative
- b-method currency-frac))))
- ((filo-basis)
- (let ((rev-b-list (reverse b-list)))
- (case (gnc-numeric-compare (gnc-numeric-abs b-units) (caar rev-b-list))
- ((-1)
- ;; Sold less than the last lot
- (let ((new-units (gnc-numeric-add b-units (caar rev-b-list) units-denom GNC-RND-ROUND)))
- (reverse (cons (cons new-units (cdar rev-b-list)) (cdr rev-b-list)))))
- ((0)
- ;; Sold all of the last lot
- (reverse (cdr rev-b-list))
- )
- ((1)
- ;; Sold more than the last lot
- (basis-builder (reverse (cdr rev-b-list)) (gnc-numeric-add b-units (caar rev-b-list) units-denom GNC-RND-ROUND)
- b-value b-method currency-frac)
- ))))
- ((average-basis)
- (list (cons (gnc-numeric-add
- (caar b-list) b-units units-denom GNC-RND-ROUND)
- (cdar b-list)))))
- '()
- ))
-
- ;; no value, just units, this is a split/merge...
- ((and (gnc-numeric-zero-p b-value)
- (not (gnc-numeric-zero-p b-units)))
- (let* ((current-units (units-basis b-list))
- ;; If current-units is zero then so should be everything else.
- (units-ratio (if (zero? current-units) (gnc-numeric-zero)
- (gnc-numeric-div (gnc-numeric-add b-units current-units GNC-DENOM-AUTO GNC-DENOM-REDUCE)
- current-units GNC-DENOM-AUTO GNC-DENOM-REDUCE)))
- ;; 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 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)
- " value ratio is " (gnc-numeric-to-string value-ratio)
- " units ratio is " (gnc-numeric-to-string units-ratio))
- (apply-basis-ratio b-list units-ratio value-ratio)
- ))
-
- ;; If there are no units, just a value, then its a spin-off,
- ;; calculate a ratio for the values, but leave the units alone
- ;; with a ratio of 1
- ((and (gnc-numeric-zero-p b-units)
- (not (gnc-numeric-zero-p b-value)))
- (let* ((current-value (sum-basis b-list GNC-DENOM-AUTO))
- (value-ratio (if (zero? current-value)
- (throw 'div/0 (format #f "spinoff of ~,2f currency units" current-value))
- (gnc-numeric-div (gnc-numeric-add b-value current-value GNC-DENOM-AUTO GNC-DENOM-REDUCE)
- current-value GNC-DENOM-AUTO GNC-DENOM-REDUCE))))
-
- (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 1/1 value-ratio))
- )
-
- ;; when all else fails, just send the b-list back
- (else
- b-list)
- )
- )
-
;; Given a price list and a currency find the price for that currency on the list.
;; If there is none for the requested currency, return the first one.
;; The price list is released but the price returned is ref counted.
Summary of changes:
.../report/reports/standard/advanced-portfolio.scm | 304 ++++++++++-----------
.../reports/standard/test/test-portfolios.scm | 74 +++++
2 files changed, 226 insertions(+), 152 deletions(-)
More information about the gnucash-changes
mailing list