gnucash maint: Multiple changes pushed

Christopher Lam clam at code.gnucash.org
Tue Apr 9 09:19:39 EDT 2019


Updated	 via  https://github.com/Gnucash/gnucash/commit/0cce764e (commit)
	 via  https://github.com/Gnucash/gnucash/commit/58e79e5a (commit)
	 via  https://github.com/Gnucash/gnucash/commit/e4d5e2c9 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/eab53d44 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/ad51c5e0 (commit)
	from  https://github.com/Gnucash/gnucash/commit/1c9ad3af (commit)



commit 0cce764e78a3ec32ced22fd82305a9153633f561
Merge: 58e79e5aa 1c9ad3af3
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Tue Apr 9 21:19:11 2019 +0800

    Merge branch 'maint' of https://github.com/Gnucash/gnucash into maint


commit 58e79e5aa75c35e12cd8efe903c77fd7997937f8
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Tue Apr 9 19:56:47 2019 +0800

    [test-commodity-utils] upgrade to 100% coverage of pricing funcs
    
    and add optional coverage analysis

diff --git a/gnucash/report/report-system/test/test-commodity-utils.scm b/gnucash/report/report-system/test/test-commodity-utils.scm
index 6c61bab2a..3a17d62ab 100644
--- a/gnucash/report/report-system/test/test-commodity-utils.scm
+++ b/gnucash/report/report-system/test/test-commodity-utils.scm
@@ -30,10 +30,11 @@
 (use-modules (sw_engine))
 (use-modules (sw_app_utils))
 (use-modules (gnucash report report-system))
+(use-modules (system vm coverage))
 
 (setlocale LC_ALL "C")
 
-(define (run-test)
+(define (run-test-proper)
   (test-runner-factory gnc:test-runner)
   (test-begin "commodity-utils")
   ;; Tests go here
@@ -46,8 +47,26 @@
   (test-exchange-by-pricedb-nearest)
   (test-get-commodity-totalavg-prices)
   (test-get-commodity-inst-prices)
+  (test-weighted-average)
   (test-end "commodity-utils"))
 
+(define (coverage-test)
+  (let* ((currfile (dirname (current-filename)))
+         (path (string-take currfile (string-rindex currfile #\/))))
+    (add-to-load-path path))
+  (call-with-values
+      (lambda()
+        (with-code-coverage run-test-proper))
+    (lambda (data result)
+      (let ((port (open-output-file "/tmp/lcov.info")))
+        (coverage-data->lcov data port)
+        (close port)))))
+
+(define (run-test)
+  (if #f                                ;switch to #t to run coverage
+      (coverage-test)
+      (run-test-proper)))
+
 (define test-accounts
   (list "Root" (list (cons 'type ACCT-TYPE-ROOT))
         (list "Assets"(list (cons 'type ACCT-TYPE-ASSET))
@@ -639,3 +658,94 @@
                       report-list))))
      (test-end "Daimler-DEM"))
    (teardown)))
+
+(define (test-weighted-average)
+  (test-group-with-cleanup "test-weighted-average"
+    (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")))
+
+      (let ((exchange-fn (gnc:case-exchange-time-fn
+                          'weighted-average USD
+                          (list EUR USD GBP DEM AAPL)
+                          (gnc-dmy2time64-neutral 20 02 2016)
+                          #f #f)))
+        (test-equal "gnc:case-exchange-time-fn weighted-average 20/02/2012"
+          307/5
+          (gnc:gnc-monetary-amount
+           (exchange-fn
+            (gnc:make-gnc-monetary AAPL 1)
+            USD
+            (gnc-dmy2time64-neutral 20 02 2012))))
+
+        (test-equal "gnc:case-exchange-time-fn weighted-average 20/02/2014"
+          9366/125
+          (gnc:gnc-monetary-amount
+           (exchange-fn
+            (gnc:make-gnc-monetary AAPL 1)
+            USD
+            (gnc-dmy2time64-neutral 20 02 2014)))))
+
+      (let ((exchange-fn (gnc:case-exchange-time-fn
+                          'average-cost USD
+                          (list EUR USD GBP DEM AAPL)
+                          (gnc-dmy2time64-neutral 20 02 2016)
+                          #f #f)))
+        (test-equal "gnc:case-exchange-time-fn average-cost 20/02/2012"
+          8073/100
+          (gnc:gnc-monetary-amount
+           (exchange-fn
+            (gnc:make-gnc-monetary AAPL 1)
+            USD
+            (gnc-dmy2time64-neutral 20 02 2012)))))
+
+      (let ((exchange-fn (gnc:case-exchange-time-fn
+                          'pricedb-latest USD
+                          (list EUR USD GBP DEM AAPL)
+                          (gnc-dmy2time64-neutral 20 02 2016)
+                          #f #f)))
+        (test-equal "gnc:case-exchange-time-fn pricedb-latest 20/02/2012"
+          5791/50
+          (gnc:gnc-monetary-amount
+           (exchange-fn
+            (gnc:make-gnc-monetary AAPL 1)
+            USD
+            (gnc-dmy2time64-neutral 20 02 2012)))))
+
+      (let ((exchange-fn (gnc:case-exchange-time-fn
+                          'pricedb-nearest USD
+                          (list EUR USD GBP DEM AAPL)
+                          (gnc-dmy2time64-neutral 20 02 2016)
+                          #f #f)))
+        (test-equal "gnc:case-exchange-time-fn pricedb-nearest 20/02/2012"
+          307/5
+          (gnc:gnc-monetary-amount
+           (exchange-fn
+            (gnc:make-gnc-monetary AAPL 1)
+            USD
+            (gnc-dmy2time64-neutral 20 02 2012)))))
+
+      (let ((exchange-fn (gnc:case-exchange-time-fn
+                          'actual-transactions USD
+                          (list EUR USD GBP DEM AAPL)
+                          (gnc-dmy2time64-neutral 20 02 2016)
+                          #f #f)))
+        (test-equal "gnc:case-exchange-time-fn actual-transactions 20/02/2012"
+          307/5
+          (gnc:gnc-monetary-amount
+           (exchange-fn
+            (gnc:make-gnc-monetary AAPL 1)
+            USD
+            (gnc-dmy2time64-neutral 20 02 2012)))))
+
+      (teardown))))
+

commit e4d5e2c94d4029042a1a8bbb160416a12c3dded5
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Tue Apr 9 20:59:31 2019 +0800

    [commodity-utils] fix issue-deprecation-warning typo

diff --git a/gnucash/report/report-system/commodity-utilities.scm b/gnucash/report/report-system/commodity-utilities.scm
index de8026f9e..972672717 100644
--- a/gnucash/report/report-system/commodity-utilities.scm
+++ b/gnucash/report/report-system/commodity-utilities.scm
@@ -319,7 +319,7 @@ construct with gnc:make-gnc-monetary and gnc:monetary->string instead.")
 (define (gnc:get-commoditylist-inst-prices
          commodity-list report-currency end-date
          start-percent delta-percent)
-  (issue-depcrecation-warning
+  (issue-deprecation-warning
    "gnc:get-commoditylist-inst-prices is deprecated.")
   (let ((currency-accounts
          (gnc-account-get-descendants-sorted (gnc-get-current-root-account)))

commit eab53d44b3bc8cf1828c45a3134d85c0180b0e76
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Mon Apr 8 22:56:25 2019 +0800

    [report] rewrite gnc:report-template-has-unique-name?

diff --git a/gnucash/report/report-system/report.scm b/gnucash/report/report-system/report.scm
index 30874460c..5d6f1e874 100644
--- a/gnucash/report/report-system/report.scm
+++ b/gnucash/report/report-system/report.scm
@@ -489,16 +489,12 @@ not found.")))
 ;; to test if the new name is unique among the existting custom reports.
 ;; If not the calling function can prevent the name from being updated.
 (define (gnc:report-template-has-unique-name? templ-guid new-name)
-  (let* ((unique? #t))
-    (if new-name
-        (hash-for-each
-         (lambda (id rec)
-           (if (and (not (equal? templ-guid id))
-                    (gnc:report-template-is-custom/template-guid? id)
-                    (equal? new-name (gnc:report-template-name rec)))
-               (set! unique? #f)))
-         *gnc:_report-templates_*))
-    unique?))
+  (or (not new-name)
+      (not (any
+            (lambda (tmpl)
+              (and (not (equal? (car tmpl) templ-guid))
+                   (equal? (gnc:report-template-name (cdr tmpl)) new-name)))
+            (gnc:custom-report-templates-list)))))
 
 ;; Generate a unique custom template name using the given string as a base
 ;; If this string already exists as a custom template name, a
diff --git a/gnucash/report/report-system/test/test-report-system.scm b/gnucash/report/report-system/test/test-report-system.scm
index 22ba89b4c..a683e375f 100644
--- a/gnucash/report/report-system/test/test-report-system.scm
+++ b/gnucash/report/report-system/test/test-report-system.scm
@@ -196,6 +196,19 @@
     (test-equal "(gnc:is-custom-report-type report) #f"
       #f
       (gnc:is-custom-report-type report))
+    (test-assert "gnc:report-template-has-unique-name? #t"
+      (gnc:report-template-has-unique-name?
+       "54c2fc051af64a08ba2334c2e9179e24"
+       "Test Report Templatx"))
+    (test-assert "gnc:report-template-has-unique-name? #f"
+      (not
+       (gnc:report-template-has-unique-name?
+        "54c2fc051af64a08ba2334c2e9179e24"
+        "Test Report Template")))
+    (test-assert "gnc:report-template-has-unique-name? #t"
+      (gnc:report-template-has-unique-name?
+       "54c2fc051af64a08ba2334c2e9179e24"
+       #f))
     (test-assert "gnc:report-serialize = string"
       (string?
        (gnc:report-serialize report)))))

commit ad51c5e00a0d000fb108d9ca7b376737a5772f2c
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Sun Apr 7 10:23:55 2019 +0800

    [report] rewrite gnc:report-template-make-unique-name

diff --git a/gnucash/report/report-system/report.scm b/gnucash/report/report-system/report.scm
index 6e300c28a..30874460c 100644
--- a/gnucash/report/report-system/report.scm
+++ b/gnucash/report/report-system/report.scm
@@ -504,15 +504,12 @@ not found.")))
 ;; If this string already exists as a custom template name, a
 ;; number will be appended to it.
 (define (gnc:report-template-make-unique-name new-name)
-  (let* ((unique-name new-name)
-         (counter 0)
-         (unique? (gnc:report-template-has-unique-name? #f unique-name)))
-    (while (not unique?)
-      (begin
-        (set! counter (+ counter 1))
-        (set! unique-name (string-append new-name (number->string counter)))
-        (set! unique? (gnc:report-template-has-unique-name? #f unique-name))))
-    unique-name))
+  (let loop ((name new-name)
+             (counter 1))
+    (if (gnc:report-template-has-unique-name? #f name)
+        name
+        (loop (string-append new-name (number->string counter))
+              (1+ counter)))))
 
 
 ;; Load and save functions



Summary of changes:
 .../report/report-system/commodity-utilities.scm   |   2 +-
 gnucash/report/report-system/report.scm            |  31 +++---
 .../report-system/test/test-commodity-utils.scm    | 112 ++++++++++++++++++++-
 .../report-system/test/test-report-system.scm      |  13 +++
 4 files changed, 137 insertions(+), 21 deletions(-)



More information about the gnucash-changes mailing list