[test-report-utilities] test list, monetary->str, commodity-collector

- list-set-safe - gnc:monetary->string - commodity-collector
Gnucash · Sep 9, 2018 · 125dcfb · 125dcfb
1 parent 8822937
commit 125dcfb
Showing 1 changed file with 116 additions and 2 deletions.
diff --git a/gnucash/report/report-system/test/test-report-utilities.scm b/gnucash/report/report-system/test/test-report-utilities.scm
@@ -14,14 +14,21 @@
   (test-begin "report-utilities")
   (test-account-get-trans-type-splits-interval)
   (test-list-ref-safe)
-  (test-end "report-utilities")
-  )
+  (test-list-set-safe)
+  (test-gnc:monetary->string)
+  (test-commodity-collector)
+  (test-end "report-utilities"))
 
 (define (NDayDelta t64 n)
   (let* ((day-secs (* 60 60 24 n)) ; n days in seconds is n times 60 sec/min * 60 min/h * 24 h/day
          (new-secs (- t64 day-secs)))
     new-secs))
 
+(define (collector->list coll)
+  ;; input:  collector
+  ;; output: list of strings e.g. '("$25.00" "-£15.00")
+  (map gnc:monetary->string (coll 'format gnc:make-gnc-monetary #f)))
+
 (define (test-account-get-trans-type-splits-interval)
   (let* ((env (create-test-env))
          (ts-now (gnc-localtime (current-time)))
@@ -64,3 +71,110 @@
       #f
       (list-ref-safe lst 3)))
   (test-end "list-ref-safe"))
+
+(define (test-list-set-safe)
+  (test-begin "list-set-safe")
+  (let ((lst (list 1 2)))
+    (list-set-safe! lst 1 3)
+    (test-equal "list-set-safe normal"
+      '(1 3)
+      lst)
+    (list-set-safe! lst 5 1)
+    (test-equal "list-set-safe out-of-bounds"
+      '(1 3 #f #f #f 1)
+      lst))
+  (test-end "list-set-safe"))
+
+(define (test-gnc:monetary->string)
+  (test-group-with-cleanup "gnc:monetary->string"
+    (let* ((book (gnc-get-current-book))
+           (comm-table (gnc-commodity-table-get-table book))
+           (monetary (gnc:make-gnc-monetary
+                      (gnc-commodity-table-lookup comm-table "CURRENCY" "USD")
+                      100)))
+      (test-equal "gnc:monetary->string"
+        "$100.00"
+        (gnc:monetary->string monetary)))
+    (teardown)))
+
+(define (test-commodity-collector)
+  (test-group-with-cleanup "test-commodity-collector"
+    (let* ((book (gnc-get-current-book))
+           (comm-table (gnc-commodity-table-get-table book))
+           (USD (gnc-commodity-table-lookup comm-table "CURRENCY" "USD"))
+           (GBP (gnc-commodity-table-lookup comm-table "CURRENCY" "GBP"))
+           (EUR (gnc-commodity-table-lookup comm-table "CURRENCY" "EUR"))
+           (coll-A (gnc:make-commodity-collector))
+           (coll-B (gnc:make-commodity-collector)))
+
+      (test-equal "commodity-collector empty"
+        '()
+        (collector->list coll-A))
+
+      (coll-A 'add USD 25)
+      (test-equal "coll-A 'add USD25"
+        '("$25.00")
+        (collector->list coll-A))
+
+      (coll-A 'add USD 25)
+      (test-equal "coll-A 'add USD25"
+        '("$50.00")
+        (collector->list coll-A))
+
+      (coll-A 'add GBP 20)
+      (test-equal "coll-A 'add GBP20"
+        '("£20.00" "$50.00")
+        (collector->list coll-A))
+
+      (coll-A 'reset #f #f)
+      (test-equal "coll-A 'reset"
+        '()
+        (collector->list coll-A))
+
+      (coll-A 'add USD 25)
+      (coll-B 'add GBP 20)
+      (test-equal "coll-B 'add GBP20"
+        '("£20.00")
+        (collector->list coll-B))
+
+      (coll-A 'merge coll-B #f)
+      (test-equal "coll-A 'merge coll-B"
+        '("£20.00" "$25.00")
+        (collector->list coll-A))
+
+      (coll-A 'reset #f #f)
+      (coll-A 'add USD 25)
+      (coll-A 'minusmerge coll-B #f)
+      (test-equal "coll-A 'minusmerge coll-B"
+        '("-£20.00" "$25.00")
+        (collector->list coll-A))
+
+      (test-equal "coll-A 'getpair USD"
+        (list USD 25)
+        (coll-A 'getpair USD #f))
+
+      (test-equal "coll-A 'getmonetary USD"
+        (gnc:make-gnc-monetary USD 25)
+        (coll-A 'getmonetary USD #f))
+
+      (test-equal "gnc:commodity-collector-get-negated"
+        '("-$25.00" "£20.00")
+        (collector->list
+         (gnc:commodity-collector-get-negated coll-A)))
+
+      (test-equal "gnc:commodity-collectorlist-get-merged"
+        '("$25.00" "£0.00")
+        (collector->list
+         (gnc:commodity-collectorlist-get-merged (list coll-A coll-B))))
+
+      (test-equal "gnc-commodity-collector-allzero? #f"
+        #f
+        (gnc-commodity-collector-allzero? coll-A))
+
+      ;; coll-A has -GBP20 and USD25 for now, bring bal to 0 each
+      (coll-A 'add GBP 20)
+      (coll-A 'add USD -25)
+      (test-equal "gnc-commodity-collector-allzero? #t"
+        #t
+        (gnc-commodity-collector-allzero? coll-A)))
+    (teardown)))