gnucash master: Multiple changes pushed
Christopher Lam
clam at code.gnucash.org
Fri Jul 19 12:25:08 EDT 2019
Updated via https://github.com/Gnucash/gnucash/commit/35146008 (commit)
via https://github.com/Gnucash/gnucash/commit/d3f43fe3 (commit)
via https://github.com/Gnucash/gnucash/commit/6d75be3b (commit)
via https://github.com/Gnucash/gnucash/commit/d0af343e (commit)
via https://github.com/Gnucash/gnucash/commit/0c433e02 (commit)
via https://github.com/Gnucash/gnucash/commit/e654bd34 (commit)
via https://github.com/Gnucash/gnucash/commit/57f291af (commit)
via https://github.com/Gnucash/gnucash/commit/75d5d810 (commit)
via https://github.com/Gnucash/gnucash/commit/8adcacbd (commit)
via https://github.com/Gnucash/gnucash/commit/dae26da0 (commit)
via https://github.com/Gnucash/gnucash/commit/fee383e8 (commit)
via https://github.com/Gnucash/gnucash/commit/74169114 (commit)
via https://github.com/Gnucash/gnucash/commit/105f5396 (commit)
via https://github.com/Gnucash/gnucash/commit/89749a1b (commit)
via https://github.com/Gnucash/gnucash/commit/ec28835d (commit)
via https://github.com/Gnucash/gnucash/commit/c05ba641 (commit)
via https://github.com/Gnucash/gnucash/commit/43c8b16b (commit)
via https://github.com/Gnucash/gnucash/commit/1ad4ae30 (commit)
via https://github.com/Gnucash/gnucash/commit/6c4ae890 (commit)
via https://github.com/Gnucash/gnucash/commit/560b313f (commit)
from https://github.com/Gnucash/gnucash/commit/cee64007 (commit)
commit 35146008414bceb581a797b65d11dd58d6a6796b
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Jul 19 23:09:11 2019 +0800
[engine/test/CMakeLists] add new section for scheme tests
diff --git a/libgnucash/engine/test/CMakeLists.txt b/libgnucash/engine/test/CMakeLists.txt
index 4b402c4a2..a65035f51 100644
--- a/libgnucash/engine/test/CMakeLists.txt
+++ b/libgnucash/engine/test/CMakeLists.txt
@@ -247,7 +247,14 @@ if (HAVE_SRFI64)
test-business-core.scm
)
- gnc_add_scheme_tests("${scm_tests_with_srfi64_SOURCES}")
+ gnc_add_scheme_test_targets (scm-test-with-srfi64
+ "${scm_tests_with_srfi64_SOURCES}"
+ "tests"
+ "${GUILE_DEPENDS};scm-test-engine-extras;scm-srfi64-extras;gncmod-engine"
+ FALSE
+ )
+
+ gnc_add_scheme_tests ("${scm_tests_with_srfi64_SOURCES}")
endif (HAVE_SRFI64)
gnc_add_scheme_test_targets(scm-test-engine
@@ -322,6 +329,7 @@ set(test_engine_SCHEME_DIST
test-create-account.scm
test-engine-extras.scm
test-scm-query-import.scm
+ test-business-core.scm
)
set(test_engine_EXTRA_DIST
commit d3f43fe36048119f7c7195f52f770019fd8cf03d
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Jul 19 23:09:00 2019 +0800
[test-business-core] fix: module names were changed
diff --git a/libgnucash/engine/test/test-business-core.scm b/libgnucash/engine/test/test-business-core.scm
index 9662450d7..c597ccc0d 100644
--- a/libgnucash/engine/test/test-business-core.scm
+++ b/libgnucash/engine/test/test-business-core.scm
@@ -1,9 +1,10 @@
(use-modules (srfi srfi-1))
(use-modules (srfi srfi-64))
(use-modules (gnucash gnc-module))
-(use-modules (gnucash engine test srfi64-extras))
-(use-modules (gnucash engine test test-extras))
-(gnc:module-begin-syntax (gnc:module-load "gnucash/report/report-system" 0))
+(gnc:module-load "gnucash/engine" 0)
+(gnc:module-load "gnucash/app-utils" 0)
+(use-modules (tests srfi64-extras))
+(use-modules (tests test-engine-extras))
(use-modules (gnucash utilities))
(use-modules (gnucash business-core))
commit 6d75be3b5edd8b0bf5fddddd5bc81ea105a0a18c
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Jul 19 22:56:18 2019 +0800
[test-owner-report] fix: module names were changed
diff --git a/gnucash/report/reports/standard/test/test-owner-report.scm b/gnucash/report/reports/standard/test/test-owner-report.scm
index df8940bb7..2da615f10 100644
--- a/gnucash/report/reports/standard/test/test-owner-report.scm
+++ b/gnucash/report/reports/standard/test/test-owner-report.scm
@@ -1,13 +1,12 @@
(use-modules (gnucash gnc-module))
(gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
-(use-modules (gnucash engine test test-extras))
-(use-modules (gnucash report invoice))
-(use-modules (gnucash report stylesheets))
-(use-modules (gnucash report report-system))
-(use-modules (gnucash report report-system test test-extras))
+(use-modules (tests test-engine-extras))
+(use-modules (gnucash reports standard owner-report))
+(use-modules (gnucash report))
+(use-modules (tests test-report-extras))
(use-modules (srfi srfi-1))
(use-modules (srfi srfi-64))
-(use-modules (gnucash engine test srfi64-extras))
+(use-modules (tests srfi64-extras))
(use-modules (sxml simple))
(use-modules (sxml xpath))
(use-modules (system vm coverage))
commit d0af343ee4f163903ff273c579a1e47677075913
Merge: cee640077 0c433e02f
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Jul 19 22:41:17 2019 +0800
Merge branch 'maint'
diff --cc gnucash/report/reports/standard/test/CMakeLists.txt
index 330e21fad,7cd7159e7..b79517c45
--- a/gnucash/report/reports/standard/test/CMakeLists.txt
+++ b/gnucash/report/reports/standard/test/CMakeLists.txt
@@@ -14,7 -14,6 +14,8 @@@ set(scm_test_with_srfi64_SOURCE
test-budget.scm
test-register.scm
test-average-balance.scm
+ test-invoice.scm
++ test-owner-report.scm
)
set(scm_test_with_textual_ports_SOURCES
diff --cc gnucash/report/reports/standard/test/test-owner-report.scm
index 000000000,df8940bb7..df8940bb7
mode 000000,100644..100644
--- a/gnucash/report/reports/standard/test/test-owner-report.scm
+++ b/gnucash/report/reports/standard/test/test-owner-report.scm
diff --cc libgnucash/engine/test/CMakeLists.txt
index 6dac16aa1,abeb38b3d..4b402c4a2
--- a/libgnucash/engine/test/CMakeLists.txt
+++ b/libgnucash/engine/test/CMakeLists.txt
@@@ -241,12 -243,20 +241,18 @@@ if (HAVE_SRFI64
FALSE
)
- set(srfi64_extras_SCHEME_DIST
- srfi64-extras.scm
- )
+ gnc_add_scheme_deprecated_module ("gnucash engine test srfi64-extras" "tests srfi64-extras" "scm-srfi64-extras" "")
+
+ set (scm_tests_with_srfi64_SOURCES
+ test-business-core.scm
+ )
+
+ gnc_add_scheme_tests("${scm_tests_with_srfi64_SOURCES}")
endif (HAVE_SRFI64)
-gnc_add_scheme_targets(scm-test-engine
+gnc_add_scheme_test_targets(scm-test-engine
"${engine_test_SCHEME}"
- ""
+ "tests"
"${GUILE_DEPENDS};scm-test-engine-extras"
FALSE
)
commit 0c433e02f7d0003c10e1244f572d0a9badd46e33
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Jul 19 02:15:13 2019 +0800
[business-core] deprecate gnc:entry-type-percent-p
This function is only used once. deprecate it.
diff --git a/gnucash/report/business-reports/invoice.scm b/gnucash/report/business-reports/invoice.scm
index 7b99e1d08..b5c9e3f32 100644
--- a/gnucash/report/business-reports/invoice.scm
+++ b/gnucash/report/business-reports/invoice.scm
@@ -105,7 +105,7 @@
(_ "Total"))))
(define (monetary-or-percent numeric currency entry-type)
- (if (gnc:entry-type-percent-p entry-type)
+ (if (eqv? entry-type GNC-AMT-TYPE-PERCENT)
(string-append (gnc:default-html-gnc-numeric-renderer numeric #f) " " (_ "%"))
(gnc:make-gnc-monetary currency numeric)))
diff --git a/libgnucash/engine/business-core.scm b/libgnucash/engine/business-core.scm
index 80e9737f9..f20d39044 100644
--- a/libgnucash/engine/business-core.scm
+++ b/libgnucash/engine/business-core.scm
@@ -94,6 +94,8 @@
(else ""))))
(define (gnc:entry-type-percent-p type-val)
+ (issue-deprecation-warning
+ "gnc:entry-type-percent-p is deprecated.")
(let ((type type-val))
(equal? type GNC-AMT-TYPE-PERCENT)))
commit e654bd34af64235b5f9ac0dd8a05f6db9d8c912b
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Jul 19 02:24:45 2019 +0800
[business-core] simplify functions
diff --git a/libgnucash/engine/business-core.scm b/libgnucash/engine/business-core.scm
index a05204528..80e9737f9 100644
--- a/libgnucash/engine/business-core.scm
+++ b/libgnucash/engine/business-core.scm
@@ -50,35 +50,25 @@
;
(define (gnc:owner-get-name-dep owner)
- (define (just-name name)
- (if name name ""))
-
- (let ((type (gncOwnerGetType owner)))
- (cond
- ((eqv? type GNC-OWNER-JOB)
- (gnc:owner-get-name-dep (gncJobGetOwner
- (gncOwnerGetJob owner))))
- (else (just-name (gncOwnerGetName owner))))))
+ (cond
+ ((eqv? (gncOwnerGetType owner) GNC-OWNER-JOB)
+ (gnc:owner-get-name-dep (gncJobGetOwner (gncOwnerGetJob owner))))
+ (else (or (gncOwnerGetName owner) ""))))
(define (gnc:owner-get-address-dep owner)
- (define (add-if-exists lst new)
- (if (and new (> (string-length new) 0))
- (cons new lst)
- lst))
- (define (build-string lst)
- (cond
- ((null? lst) "")
- ((null? (cdr lst)) (car lst))
- (else (string-append (build-string (cdr lst)) "\n" (car lst)))))
- (let ((lst '())
- (addr (gnc:owner-get-address owner)))
-; Added gncAddressGetName <mikee at saxicola.co.uk>
- (set! lst (add-if-exists lst (gncAddressGetName addr)))
- (set! lst (add-if-exists lst (gncAddressGetAddr1 addr)))
- (set! lst (add-if-exists lst (gncAddressGetAddr2 addr)))
- (set! lst (add-if-exists lst (gncAddressGetAddr3 addr)))
- (set! lst (add-if-exists lst (gncAddressGetAddr4 addr)))
- (build-string lst)))
+ (define (addif elt)
+ (if (and elt (> (string-length elt) 0))
+ (list elt)
+ '()))
+ (let ((addr (gnc:owner-get-address owner)))
+ (string-join
+ (append
+ (addif (gncAddressGetName addr))
+ (addif (gncAddressGetAddr1 addr))
+ (addif (gncAddressGetAddr2 addr))
+ (addif (gncAddressGetAddr3 addr))
+ (addif (gncAddressGetAddr4 addr)))
+ "\n")))
(define (gnc:owner-get-name-and-address-dep owner)
(let ((name (gnc:owner-get-name-dep owner))
commit 57f291af861d6ab7a15e633acf70e890d282b043
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Jul 19 00:03:27 2019 +0800
[test-business-core] initial commit
diff --git a/libgnucash/engine/test/CMakeLists.txt b/libgnucash/engine/test/CMakeLists.txt
index 1a27ea7f4..abeb38b3d 100644
--- a/libgnucash/engine/test/CMakeLists.txt
+++ b/libgnucash/engine/test/CMakeLists.txt
@@ -247,6 +247,11 @@ if (HAVE_SRFI64)
srfi64-extras.scm
)
+ set (scm_tests_with_srfi64_SOURCES
+ test-business-core.scm
+ )
+
+ gnc_add_scheme_tests("${scm_tests_with_srfi64_SOURCES}")
endif (HAVE_SRFI64)
gnc_add_scheme_targets(scm-test-engine
diff --git a/libgnucash/engine/test/test-business-core.scm b/libgnucash/engine/test/test-business-core.scm
new file mode 100644
index 000000000..9662450d7
--- /dev/null
+++ b/libgnucash/engine/test/test-business-core.scm
@@ -0,0 +1,299 @@
+(use-modules (srfi srfi-1))
+(use-modules (srfi srfi-64))
+(use-modules (gnucash gnc-module))
+(use-modules (gnucash engine test srfi64-extras))
+(use-modules (gnucash engine test test-extras))
+(gnc:module-begin-syntax (gnc:module-load "gnucash/report/report-system" 0))
+(use-modules (gnucash utilities))
+(use-modules (gnucash business-core))
+
+(define (run-test)
+ (test-runner-factory gnc:test-runner)
+ (test-begin "test-business-core")
+ (core-tests)
+ (test-end "test-business-core"))
+
+(define (get-currency sym)
+ (gnc-commodity-table-lookup
+ (gnc-commodity-table-get-table (gnc-get-current-book))
+ (gnc-commodity-get-namespace (gnc-default-report-currency))
+ sym))
+
+(define structure
+ (list "Root" (list (cons 'type ACCT-TYPE-ASSET)
+ (cons 'commodity (get-currency "USD")))
+ (list "Asset"
+ (list "Bank-GBP" (list (cons 'commodity (get-currency "GBP"))))
+ (list "Bank-EUR" (list (cons 'commodity (get-currency "EUR"))))
+ (list "Bank-USD"))
+ (list "VAT"
+ (list "VAT-on-Purchases")
+ (list "VAT-on-Sales" (list (cons 'type ACCT-TYPE-LIABILITY))))
+ (list "Income" (list (cons 'type ACCT-TYPE-INCOME))
+ (list "Income-USD")
+ (list "Income-GBP" (list (cons 'commodity (get-currency "GBP"))))
+ (list "Income-EUR" (list (cons 'commodity (get-currency "EUR")))))
+ (list "A/Receivable" (list (cons 'type ACCT-TYPE-RECEIVABLE))
+ (list "AR-USD")
+ (list "AR-GBP" (list (cons 'commodity (get-currency "GBP"))))
+ (list "AR-EUR" (list (cons 'commodity (get-currency "EUR")))))
+ (list "A/Payable" (list (cons 'type ACCT-TYPE-PAYABLE))
+ (list "AP-USD")
+ (list "AP-GBP" (list (cons 'commodity (get-currency "GBP"))))
+ (list "AP-EUR" (list (cons 'commodity (get-currency "EUR")))))))
+
+(define (core-tests)
+ (let* ((env (create-test-env))
+ (account-alist (env-create-account-structure-alist env structure))
+ (get-acct (lambda (name)
+ (or (assoc-ref account-alist name)
+ (error "invalid account name" name))))
+ (YEAR (gnc:time64-get-year (gnc:get-today)))
+
+ (cust-1 (let ((cust-1 (gncCustomerCreate (gnc-get-current-book))))
+ (gncCustomerSetID cust-1 "cust-1-id")
+ (gncCustomerSetName cust-1 "cust-1-name")
+ (gncCustomerSetNotes cust-1 "cust-1-notes")
+ (gncCustomerSetCurrency cust-1 (get-currency "USD"))
+ (gncCustomerSetTaxIncluded cust-1 1) ;1 = GNC-TAXINCLUDED-YES
+ cust-1))
+
+ (owner-1 (let ((owner-1 (gncOwnerNew)))
+ (gncOwnerInitCustomer owner-1 cust-1)
+ owner-1))
+
+ ;; inv-1 is generated for a customer
+ (inv-1 (let ((inv-1 (gncInvoiceCreate (gnc-get-current-book))))
+ (gncInvoiceSetOwner inv-1 owner-1)
+ (gncInvoiceSetNotes inv-1 "inv-1-notes")
+ (gncInvoiceSetBillingID inv-1 "inv-1-billing-id")
+ (gncInvoiceSetCurrency inv-1 (get-currency "USD"))
+ inv-1))
+
+ (job-1 (let ((job-1 (gncJobCreate (gnc-get-current-book))))
+ (gncJobSetID job-1 "job-1-id")
+ (gncJobSetName job-1 "job-1-name")
+ (gncJobSetOwner job-1 owner-1)
+ job-1))
+ (owner-2 (let ((owner-2 (gncOwnerNew)))
+ (gncOwnerInitJob owner-2 job-1)
+ owner-2))
+ ;; inv-2 is generated from a customer's job
+ (inv-2 (let ((inv-2 (gncInvoiceCreate (gnc-get-current-book))))
+ (gncInvoiceSetOwner inv-2 owner-2)
+ (gncInvoiceSetNotes inv-2 "inv-2-notes")
+ (gncInvoiceSetCurrency inv-2 (get-currency "USD"))
+ inv-2))
+
+ (entry (lambda (amt)
+ (let ((entry (gncEntryCreate (gnc-get-current-book))))
+ (gncEntrySetDateGDate entry (time64-to-gdate (current-time)))
+ (gncEntrySetDescription entry "entry-desc")
+ (gncEntrySetAction entry "entry-action")
+ (gncEntrySetNotes entry "entry-notes")
+ (gncEntrySetInvAccount entry (get-acct "Income-USD"))
+ (gncEntrySetDocQuantity entry 1 #f)
+ (gncEntrySetInvPrice entry amt)
+ entry)))
+
+ ;; entry-1 1 widgets of $6 = $6
+ (entry-1 (entry 6))
+
+ ;; entry-2 3 widgets of EUR4 = EUR12
+ (entry-2 (let ((entry-2 (gncEntryCreate (gnc-get-current-book))))
+ (gncEntrySetDateGDate entry-2 (time64-to-gdate (current-time)))
+ (gncEntrySetDescription entry-2 "entry-2-desc")
+ (gncEntrySetAction entry-2 "entry-2-action")
+ (gncEntrySetNotes entry-2 "entry-2-notes")
+ (gncEntrySetInvAccount entry-2 (get-acct "Income-EUR"))
+ (gncEntrySetDocQuantity entry-2 3 #f)
+ (gncEntrySetInvPrice entry-2 4)
+ entry-2))
+
+ ;; entry-3 5 widgets of GBP7 = GBP35
+ (entry-3 (let ((entry-3 (gncEntryCreate (gnc-get-current-book))))
+ (gncEntrySetDateGDate entry-3 (time64-to-gdate (current-time)))
+ (gncEntrySetDescription entry-3 "entry-3-desc")
+ (gncEntrySetAction entry-3 "entry-3-action")
+ (gncEntrySetNotes entry-3 "entry-3-notes")
+ (gncEntrySetInvAccount entry-3 (get-acct "Income-GBP"))
+ (gncEntrySetDocQuantity entry-3 5 #f)
+ (gncEntrySetInvPrice entry-3 7)
+ entry-3))
+
+ (standard-vat-sales-tt
+ (let ((tt (gncTaxTableCreate (gnc-get-current-book))))
+ (gncTaxTableIncRef tt)
+ (gncTaxTableSetName tt "10% vat on sales")
+ (let ((entry (gncTaxTableEntryCreate)))
+ (gncTaxTableEntrySetAccount entry (get-acct "VAT-on-Sales"))
+ (gncTaxTableEntrySetType entry GNC-AMT-TYPE-PERCENT)
+ (gncTaxTableEntrySetAmount entry 10)
+ (gncTaxTableAddEntry tt entry))
+ tt))
+
+ (standard-vat-purchases-tt
+ (let ((tt (gncTaxTableCreate (gnc-get-current-book))))
+ (gncTaxTableIncRef tt)
+ (gncTaxTableSetName tt "10% vat on purchases")
+ (let ((entry (gncTaxTableEntryCreate)))
+ (gncTaxTableEntrySetAccount entry (get-acct "VAT-on-Purchases"))
+ (gncTaxTableEntrySetType entry GNC-AMT-TYPE-PERCENT)
+ (gncTaxTableEntrySetAmount entry 10)
+ (gncTaxTableAddEntry tt entry))
+ tt)))
+
+ ;; inv-1 $6, due 18.7.1980 after report-date i.e. "current"
+ (let ((inv-1-copy (gncInvoiceCopy inv-1)))
+ (gncInvoiceAddEntry inv-1-copy (entry 27/4))
+ (gncInvoicePostToAccount inv-1-copy
+ (get-acct "AR-USD") ;post-to acc
+ (gnc-dmy2time64 13 05 1980) ;posted
+ (gnc-dmy2time64 18 07 1980) ;due
+ "inv current $6.75" #t #f))
+
+ ;; inv-1-copy due 18.6.1980, <30days before report date
+ ;; amount due $12
+ (let ((inv-1-copy (gncInvoiceCopy inv-1)))
+ (gncInvoiceAddEntry inv-1-copy (entry 4))
+ (gncInvoicePostToAccount inv-1-copy
+ (get-acct "AR-USD") ;post-to acc
+ (gnc-dmy2time64 13 04 1980) ;posted
+ (gnc-dmy2time64 18 06 1980) ;due
+ "inv <30days $4.00" #t #f))
+
+ ;; inv-1-copy due 18.5.1980, 30-60days before report date
+ ;; amount due $6
+ (let ((inv-1-copy (gncInvoiceCopy inv-1)))
+ (gncInvoiceAddEntry inv-1-copy (entry 17/2))
+ (gncInvoicePostToAccount inv-1-copy
+ (get-acct "AR-USD") ;post-to acc
+ (gnc-dmy2time64 13 03 1980) ;posted
+ (gnc-dmy2time64 18 05 1980) ;due
+ "inv 30-60 $8.50" #t #f))
+
+ ;; inv-1-copy due 18.4.1980, 60-90days before report date
+ ;; amount due $6
+ (let ((inv-1-copy (gncInvoiceCopy inv-1)))
+ (gncInvoiceAddEntry inv-1-copy (entry 15/2))
+ (gncInvoicePostToAccount inv-1-copy
+ (get-acct "AR-USD") ;post-to acc
+ (gnc-dmy2time64 13 02 1980) ;posted
+ (gnc-dmy2time64 18 04 1980) ;due
+ "inv 60-90 $7.50" #t #f))
+
+ ;; inv-1-copy due 18.3.1980, >90days before report date
+ ;; amount due $11.50, drip-payments
+ (let ((inv-1-copy (gncInvoiceCopy inv-1)))
+ (gncInvoiceAddEntry inv-1-copy (entry 23/2))
+ (gncInvoicePostToAccount inv-1-copy
+ (get-acct "AR-USD") ;post-to acc
+ (gnc-dmy2time64 13 01 1980) ;posted
+ (gnc-dmy2time64 18 03 1980) ;due
+ "inv >90 $11.50" #t #f)
+ (gncInvoiceApplyPayment
+ inv-1-copy '() (get-acct "Bank-USD") 3/2 1
+ (gnc-dmy2time64 18 03 1980)
+ "inv >90 payment" "pay only $1.50")
+ (gncInvoiceApplyPayment
+ inv-1-copy '() (get-acct "Bank-USD") 2 1
+ (gnc-dmy2time64 20 03 1980)
+ "inv >90 payment" "pay only $2.00"))
+
+ ;; inv-1-copy due 18.3.1980, >90days before report date
+ ;; amount due $11.50, drip-payments
+ (let ((inv-1-copy (gncInvoiceCopy inv-1)))
+ (gncInvoiceAddEntry inv-1-copy (entry 200))
+ (gncInvoicePostToAccount inv-1-copy
+ (get-acct "AR-USD") ;post-to acc
+ (gnc-dmy2time64 18 04 1980) ;posted
+ (gnc-dmy2time64 18 04 1980) ;due
+ "inv $200" #t #f)
+ (gncInvoiceApplyPayment
+ inv-1-copy '() (get-acct "Bank-USD") 200 1
+ (gnc-dmy2time64 19 04 1980)
+ "inv $200" "fully paid"))
+
+ (let ((inv-1-copy (gncInvoiceCopy inv-1)))
+ (gncInvoiceAddEntry inv-1-copy (entry -5/2))
+ (gncInvoiceSetIsCreditNote inv-1-copy #t)
+ (gncInvoicePostToAccount inv-1-copy
+ (get-acct "AR-USD") ;post-to acc
+ (gnc-dmy2time64 22 06 1980) ;posted
+ (gnc-dmy2time64 22 06 1980) ;due
+ "inv $2.50 CN" #t #f))
+
+ (test-equal "gnc:owner-get-name-dep"
+ "cust-1-name"
+ (gnc:owner-get-name-dep owner-1))
+
+ (test-equal "gnc:owner-get-address-dep"
+ ""
+ (gnc:owner-get-address-dep owner-1))
+
+ (test-equal "gnc:owner-get-name-and-address-dep"
+ "cust-1-name\n"
+ (gnc:owner-get-name-and-address-dep owner-1))
+
+ (test-equal "gnc:owner-get-owner-id"
+ "cust-1-id"
+ (gnc:owner-get-owner-id owner-1))
+
+ ;; a non-business transaction
+ (env-transfer env 01 01 1990
+ (get-acct "Income-GBP") (get-acct "Bank-GBP") 10)
+
+ (let ((new-owner (gncOwnerNew)))
+
+ (test-equal "new-owner is initially empty"
+ ""
+ (gncOwnerGetName new-owner))
+
+ (test-equal "gnc:owner-from-split (from AR) return"
+ "cust-1-name"
+ (gncOwnerGetName
+ (gnc:owner-from-split
+ (last (xaccAccountGetSplitList (get-acct "AR-USD")))
+ new-owner)))
+
+ (test-equal "gnc:owner-from-split (from AR) mutated"
+ "cust-1-name"
+ (gncOwnerGetName new-owner))
+
+ (set! new-owner (gncOwnerNew))
+ (test-equal "gnc:owner-from-split (from inc-acct) return"
+ "cust-1-name"
+ (gncOwnerGetName
+ (gnc:owner-from-split
+ (last (xaccAccountGetSplitList (get-acct "Income-USD")))
+ new-owner)))
+
+ (test-equal "gnc:owner-from-split (from inc-acct) mutated"
+ "cust-1-name"
+ (gncOwnerGetName new-owner))
+
+ (set! new-owner (gncOwnerNew))
+ (test-equal "gnc:owner-from-split (from payment txn) return"
+ "cust-1-name"
+ (gncOwnerGetName
+ (gnc:owner-from-split
+ (last (xaccAccountGetSplitList (get-acct "Bank-USD")))
+ new-owner)))
+
+ (test-equal "gnc:owner-from-split (from payment txn) mutated"
+ "cust-1-name"
+ (gncOwnerGetName new-owner))
+
+ (set! new-owner 'reset)
+ (test-equal "gnc:owner-from-split (non-business split) return"
+ ""
+ (gncOwnerGetName
+ (gnc:owner-from-split
+ (last (xaccAccountGetSplitList (get-acct "Bank-GBP")))
+ new-owner)))
+
+ (test-equal "gnc:owner-from-split (non-business split) mutated"
+ 'reset
+ new-owner))
+
+ ))
commit 75d5d8106b37e3a666355c18cf8ded0f201d8027
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Jul 14 21:20:52 2019 +0800
[report-utilities] fix gnc:strify
Try monetary-collector and value-collector printers earlier; output is
fixed and will be "coll<([$200.00])>" for commodity-collectors or
"coll<23>" for value-collectors
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index f5b6446c9..66f6e18f8 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -1098,21 +1098,20 @@ flawed. see report-utilities.scm. please update reports.")
(define (account->str acc)
(format #f "Acc<~a>" (xaccAccountGetName acc)))
(define (monetary-collector->str coll)
- (format #f "Mon-coll<~a>"
+ (format #f "coll<~a>"
(map gnc:strify (coll 'format gnc:make-gnc-monetary #f))))
(define (value-collector->str coll)
- (format #f "Val-coll<~a>"
- (map gnc:strify (coll 'total gnc:make-gnc-monetary))))
+ (format #f "coll<~a>" (coll 'total #f)))
(define (procedure->str proc)
(format #f "Proc<~a>"
(or (procedure-name proc) "unk")))
(define (monetary->string mon)
- (format #f "Mon<~a>"
+ (format #f "[~a]"
(gnc:monetary->string mon)))
(define (try proc)
- ;; Try proc with d as a parameter, catching 'wrong-type-arg
- ;; exceptions to return #f to the (or) evaluator below.
- (catch 'wrong-type-arg
+ ;; Try proc with d as a parameter, catching exceptions to return
+ ;; #f to the (or) evaluator below.
+ (catch #t
(lambda () (proc d))
(const #f)))
(or (and (boolean? d) (if d "#t" "#f"))
@@ -1128,13 +1127,13 @@ flawed. see report-utilities.scm. please update reports.")
(if (eq? (car d) 'absolute)
(qof-print-date (cdr d))
(gnc:strify (cdr d)))))
+ (try monetary-collector->str)
+ (try value-collector->str)
(try procedure->str)
(try gnc-commodity-get-mnemonic)
(try account->str)
(try split->str)
(try trans->str)
- (try monetary-collector->str)
- (try value-collector->str)
(try monetary->string)
(try gnc-budget-get-name)
(object->string d)))
diff --git a/gnucash/report/report-system/test/test-report-utilities.scm b/gnucash/report/report-system/test/test-report-utilities.scm
index 9fd44504d..a017eb358 100644
--- a/gnucash/report/report-system/test/test-report-utilities.scm
+++ b/gnucash/report/report-system/test/test-report-utilities.scm
@@ -130,8 +130,26 @@
"('a . 2)"
(gnc:strify (cons 'a 2)))
(test-equal "gnc:strify cons"
- "Proc<cons>"
- (gnc:strify cons))
+ "Proc<identity>"
+ (gnc:strify identity))
+ (let ((coll (gnc:make-commodity-collector)))
+ (test-equal "gnc:strify <mon-coll>"
+ "coll<()>"
+ (gnc:strify coll))
+ (coll 'add (gnc-commodity-table-lookup
+ (gnc-commodity-table-get-table
+ (gnc-get-current-book)) "CURRENCY" "USD") 10)
+ (test-equal "gnc:strify <mon-coll $10>"
+ "coll<([$10.00])>"
+ (gnc:strify coll)))
+ (let ((coll (gnc:make-value-collector)))
+ (test-equal "gnc:strify <val-coll 0>"
+ "coll<0>"
+ (gnc:strify coll))
+ (coll 'add 10)
+ (test-equal "gnc:strify <val-coll 10>"
+ "coll<10>"
+ (gnc:strify coll)))
(test-end "debugging tools"))
(define (test-commodity-collector)
commit 8adcacbdd259ceab3bc49f0de650070c3f93538f
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Jul 12 21:54:53 2019 +0800
[test-owner-report] basic tests for customer and job reports
create invoices, due dates at various points in the past
diff --git a/gnucash/report/business-reports/test/CMakeLists.txt b/gnucash/report/business-reports/test/CMakeLists.txt
index 26fe43693..2976ec48e 100644
--- a/gnucash/report/business-reports/test/CMakeLists.txt
+++ b/gnucash/report/business-reports/test/CMakeLists.txt
@@ -1,6 +1,7 @@
set(scm_test_business_reports_with_srfi64_SOURCES
test-invoice.scm
+ test-owner-report.scm
)
set(GUILE_DEPENDS
diff --git a/gnucash/report/business-reports/test/test-owner-report.scm b/gnucash/report/business-reports/test/test-owner-report.scm
new file mode 100644
index 000000000..df8940bb7
--- /dev/null
+++ b/gnucash/report/business-reports/test/test-owner-report.scm
@@ -0,0 +1,347 @@
+(use-modules (gnucash gnc-module))
+(gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
+(use-modules (gnucash engine test test-extras))
+(use-modules (gnucash report invoice))
+(use-modules (gnucash report stylesheets))
+(use-modules (gnucash report report-system))
+(use-modules (gnucash report report-system test test-extras))
+(use-modules (srfi srfi-1))
+(use-modules (srfi srfi-64))
+(use-modules (gnucash engine test srfi64-extras))
+(use-modules (sxml simple))
+(use-modules (sxml xpath))
+(use-modules (system vm coverage))
+(use-modules (system vm vm))
+
+(define uuid-list
+ (list (cons 'employee "08ae9c2e884b4f9787144f47eacd7f44")
+ (cons 'vendor "d7d1e53505ee4b1b82efad9eacedaea0")
+ (cons 'customer "c146317be32e4948a561ec7fc89d15c1")
+ (cons 'job "5518ac227e474f47a34439f2d4d049de")))
+
+(setlocale LC_ALL "C")
+
+(define (run-test)
+ (if #f
+ (coverage-test run-test-proper)
+ (run-test-proper)))
+
+(define (coverage-test tester)
+ (let* ((currfile (dirname (current-filename)))
+ (path (string-take currfile (string-rindex currfile #\/))))
+ (add-to-load-path path))
+ (call-with-values
+ (lambda()
+ (with-code-coverage tester))
+ (lambda (data result)
+ (let ((port (open-output-file "/tmp/lcov.info")))
+ (coverage-data->lcov data port)
+ (close port)))))
+
+(define (run-test-proper)
+ (let ((saved-format (qof-date-format-get)))
+ (qof-date-format-set QOF-DATE-FORMAT-ISO)
+ (test-runner-factory gnc:test-runner)
+ (test-begin "test-owner-report")
+ (owner-tests)
+ (qof-date-format-set saved-format)
+ (test-end "test-owner-report")))
+
+(define (sxml-get-row-col sxml row col)
+ (sxml->table-row-col sxml 3 row col))
+
+(define (set-option! options section name value)
+ (let ((option (gnc:lookup-option options section name)))
+ (if option
+ (gnc:option-set-value option value)
+ (test-assert (format #f "wrong-option ~a ~a" section name) #f))))
+
+(define (get-currency sym)
+ (gnc-commodity-table-lookup
+ (gnc-commodity-table-get-table (gnc-get-current-book))
+ (gnc-commodity-get-namespace (gnc-default-report-currency))
+ sym))
+
+(define structure
+ (list "Root" (list (cons 'type ACCT-TYPE-ASSET)
+ (cons 'commodity (get-currency "USD")))
+ (list "Asset"
+ (list "Bank-GBP" (list (cons 'commodity (get-currency "GBP"))))
+ (list "Bank-EUR" (list (cons 'commodity (get-currency "EUR"))))
+ (list "Bank-USD"))
+ (list "VAT"
+ (list "VAT-on-Purchases")
+ (list "VAT-on-Sales" (list (cons 'type ACCT-TYPE-LIABILITY))))
+ (list "Income" (list (cons 'type ACCT-TYPE-INCOME))
+ (list "Income-USD")
+ (list "Income-GBP" (list (cons 'commodity (get-currency "GBP"))))
+ (list "Income-EUR" (list (cons 'commodity (get-currency "EUR")))))
+ (list "A/Receivable" (list (cons 'type ACCT-TYPE-RECEIVABLE))
+ (list "AR-USD")
+ (list "AR-GBP" (list (cons 'commodity (get-currency "GBP"))))
+ (list "AR-EUR" (list (cons 'commodity (get-currency "EUR")))))
+ (list "A/Payable" (list (cons 'type ACCT-TYPE-PAYABLE))
+ (list "AP-USD")
+ (list "AP-GBP" (list (cons 'commodity (get-currency "GBP"))))
+ (list "AP-EUR" (list (cons 'commodity (get-currency "EUR")))))))
+
+(define (owner-tests)
+ ;; This function will perform implementation testing on the customer report.
+ (define (options->sxml variant options test-title)
+ (define uuid (cdr (assq variant uuid-list)))
+ ;; (format #t "[~a] Options:\n~a"
+ ;; test-title
+ ;; (gnc:html-render-options-changed options #t))
+ (gnc:options->sxml uuid options (format #f "test-~a" variant) test-title))
+ (define (options->invoice inv)
+ (let* ((inv-uuid "5123a759ceb9483abf2182d01c140e8d") ;invoice
+ (inv-options (gnc:make-report-options inv-uuid)))
+ (set-option! inv-options "General" "Invoice Number" inv)
+ (gnc:options->sxml inv-uuid inv-options "test" "test-invoice")))
+
+ (let* ((env (create-test-env))
+ (account-alist (env-create-account-structure-alist env structure))
+ (get-acct (lambda (name)
+ (or (assoc-ref account-alist name)
+ (error "invalid account name" name))))
+ (YEAR (gnc:time64-get-year (gnc:get-today)))
+
+ (cust-1 (let ((cust-1 (gncCustomerCreate (gnc-get-current-book))))
+ (gncCustomerSetID cust-1 "cust-1-id")
+ (gncCustomerSetName cust-1 "cust-1-name")
+ (gncCustomerSetNotes cust-1 "cust-1-notes")
+ (gncCustomerSetCurrency cust-1 (get-currency "USD"))
+ (gncCustomerSetTaxIncluded cust-1 1) ;1 = GNC-TAXINCLUDED-YES
+ cust-1))
+
+ (owner-1 (let ((owner-1 (gncOwnerNew)))
+ (gncOwnerInitCustomer owner-1 cust-1)
+ owner-1))
+
+ ;; inv-1 is generated for a customer
+ (inv-1 (let ((inv-1 (gncInvoiceCreate (gnc-get-current-book))))
+ (gncInvoiceSetOwner inv-1 owner-1)
+ (gncInvoiceSetNotes inv-1 "inv-1-notes")
+ (gncInvoiceSetBillingID inv-1 "inv-1-billing-id")
+ (gncInvoiceSetCurrency inv-1 (get-currency "USD"))
+ inv-1))
+
+ (job-1 (let ((job-1 (gncJobCreate (gnc-get-current-book))))
+ (gncJobSetID job-1 "job-1-id")
+ (gncJobSetName job-1 "job-1-name")
+ (gncJobSetOwner job-1 owner-1)
+ job-1))
+ (owner-2 (let ((owner-2 (gncOwnerNew)))
+ (gncOwnerInitJob owner-2 job-1)
+ owner-2))
+ ;; inv-2 is generated from a customer's job
+ (inv-2 (let ((inv-2 (gncInvoiceCreate (gnc-get-current-book))))
+ (gncInvoiceSetOwner inv-2 owner-2)
+ (gncInvoiceSetNotes inv-2 "inv-2-notes")
+ (gncInvoiceSetCurrency inv-2 (get-currency "USD"))
+ inv-2))
+
+ (entry (lambda (amt)
+ (let ((entry (gncEntryCreate (gnc-get-current-book))))
+ (gncEntrySetDateGDate entry (time64-to-gdate (current-time)))
+ (gncEntrySetDescription entry "entry-desc")
+ (gncEntrySetAction entry "entry-action")
+ (gncEntrySetNotes entry "entry-notes")
+ (gncEntrySetInvAccount entry (get-acct "Income-USD"))
+ (gncEntrySetDocQuantity entry 1 #f)
+ (gncEntrySetInvPrice entry amt)
+ entry)))
+
+ ;; entry-1 1 widgets of $6 = $6
+ (entry-1 (entry 6))
+
+ ;; entry-2 3 widgets of EUR4 = EUR12
+ (entry-2 (let ((entry-2 (gncEntryCreate (gnc-get-current-book))))
+ (gncEntrySetDateGDate entry-2 (time64-to-gdate (current-time)))
+ (gncEntrySetDescription entry-2 "entry-2-desc")
+ (gncEntrySetAction entry-2 "entry-2-action")
+ (gncEntrySetNotes entry-2 "entry-2-notes")
+ (gncEntrySetInvAccount entry-2 (get-acct "Income-EUR"))
+ (gncEntrySetDocQuantity entry-2 3 #f)
+ (gncEntrySetInvPrice entry-2 4)
+ entry-2))
+
+ ;; entry-3 5 widgets of GBP7 = GBP35
+ (entry-3 (let ((entry-3 (gncEntryCreate (gnc-get-current-book))))
+ (gncEntrySetDateGDate entry-3 (time64-to-gdate (current-time)))
+ (gncEntrySetDescription entry-3 "entry-3-desc")
+ (gncEntrySetAction entry-3 "entry-3-action")
+ (gncEntrySetNotes entry-3 "entry-3-notes")
+ (gncEntrySetInvAccount entry-3 (get-acct "Income-GBP"))
+ (gncEntrySetDocQuantity entry-3 5 #f)
+ (gncEntrySetInvPrice entry-3 7)
+ entry-3))
+
+ (standard-vat-sales-tt
+ (let ((tt (gncTaxTableCreate (gnc-get-current-book))))
+ (gncTaxTableIncRef tt)
+ (gncTaxTableSetName tt "10% vat on sales")
+ (let ((entry (gncTaxTableEntryCreate)))
+ (gncTaxTableEntrySetAccount entry (get-acct "VAT-on-Sales"))
+ (gncTaxTableEntrySetType entry GNC-AMT-TYPE-PERCENT)
+ (gncTaxTableEntrySetAmount entry 10)
+ (gncTaxTableAddEntry tt entry))
+ tt))
+
+ (standard-vat-purchases-tt
+ (let ((tt (gncTaxTableCreate (gnc-get-current-book))))
+ (gncTaxTableIncRef tt)
+ (gncTaxTableSetName tt "10% vat on purchases")
+ (let ((entry (gncTaxTableEntryCreate)))
+ (gncTaxTableEntrySetAccount entry (get-acct "VAT-on-Purchases"))
+ (gncTaxTableEntrySetType entry GNC-AMT-TYPE-PERCENT)
+ (gncTaxTableEntrySetAmount entry 10)
+ (gncTaxTableAddEntry tt entry))
+ tt)))
+
+ (define* (default-testing-options variant owner account)
+ ;; owner-report will run from 1.1.1980 to 1.7.1980
+ (let ((options (gnc:make-report-options
+ (assq-ref uuid-list variant))))
+ (set-option! options "General"
+ (case variant
+ ((customer) "Customer")
+ ((job) "Job"))
+ owner)
+ (set-option! options "General" "From"
+ (cons 'absolute (gnc-dmy2time64 1 1 1980)))
+ (set-option! options "General" "To"
+ (cons 'absolute (gnc-dmy2time64 1 7 1980)))
+ (set-option! options "General" "Account" account)
+ options))
+
+ ;; inv-1 $6, due 18.7.1980 after report-date i.e. "current"
+ (let ((inv-1-copy (gncInvoiceCopy inv-1)))
+ (gncInvoiceAddEntry inv-1-copy (entry 27/4))
+ (gncInvoicePostToAccount inv-1-copy
+ (get-acct "AR-USD") ;post-to acc
+ (gnc-dmy2time64 13 05 1980) ;posted
+ (gnc-dmy2time64 18 07 1980) ;due
+ "inv current $6.75" #t #f))
+
+ ;; inv-1-copy due 18.6.1980, <30days before report date
+ ;; amount due $12
+ (let ((inv-1-copy (gncInvoiceCopy inv-1)))
+ (gncInvoiceAddEntry inv-1-copy (entry 4))
+ (gncInvoicePostToAccount inv-1-copy
+ (get-acct "AR-USD") ;post-to acc
+ (gnc-dmy2time64 13 04 1980) ;posted
+ (gnc-dmy2time64 18 06 1980) ;due
+ "inv <30days $4.00" #t #f))
+
+ ;; inv-1-copy due 18.5.1980, 30-60days before report date
+ ;; amount due $6
+ (let ((inv-1-copy (gncInvoiceCopy inv-1)))
+ (gncInvoiceAddEntry inv-1-copy (entry 17/2))
+ (gncInvoicePostToAccount inv-1-copy
+ (get-acct "AR-USD") ;post-to acc
+ (gnc-dmy2time64 13 03 1980) ;posted
+ (gnc-dmy2time64 18 05 1980) ;due
+ "inv 30-60 $8.50" #t #f))
+
+ ;; inv-1-copy due 18.4.1980, 60-90days before report date
+ ;; amount due $6
+ (let ((inv-1-copy (gncInvoiceCopy inv-1)))
+ (gncInvoiceAddEntry inv-1-copy (entry 15/2))
+ (gncInvoicePostToAccount inv-1-copy
+ (get-acct "AR-USD") ;post-to acc
+ (gnc-dmy2time64 13 02 1980) ;posted
+ (gnc-dmy2time64 18 04 1980) ;due
+ "inv 60-90 $7.50" #t #f))
+
+ ;; inv-1-copy due 18.3.1980, >90days before report date
+ ;; amount due $11.50, drip-payments
+ (let ((inv-1-copy (gncInvoiceCopy inv-1)))
+ (gncInvoiceAddEntry inv-1-copy (entry 23/2))
+ (gncInvoicePostToAccount inv-1-copy
+ (get-acct "AR-USD") ;post-to acc
+ (gnc-dmy2time64 13 01 1980) ;posted
+ (gnc-dmy2time64 18 03 1980) ;due
+ "inv >90 $11.50" #t #f)
+ (gncInvoiceApplyPayment
+ inv-1-copy '() (get-acct "Bank-USD") 3/2 1
+ (gnc-dmy2time64 18 03 1980)
+ "inv >90 payment" "pay only $1.50")
+ (gncInvoiceApplyPayment
+ inv-1-copy '() (get-acct "Bank-USD") 2 1
+ (gnc-dmy2time64 20 03 1980)
+ "inv >90 payment" "pay only $2.00"))
+
+ ;; inv-1-copy due 18.3.1980, >90days before report date
+ ;; amount due $11.50, drip-payments
+ (let ((inv-1-copy (gncInvoiceCopy inv-1)))
+ (gncInvoiceAddEntry inv-1-copy (entry 200))
+ (gncInvoicePostToAccount inv-1-copy
+ (get-acct "AR-USD") ;post-to acc
+ (gnc-dmy2time64 18 04 1980) ;posted
+ (gnc-dmy2time64 18 04 1980) ;due
+ "inv $200" #t #f)
+ (gncInvoiceApplyPayment
+ inv-1-copy '() (get-acct "Bank-USD") 200 1
+ (gnc-dmy2time64 19 04 1980)
+ "inv $200" "fully paid"))
+
+ (let ((inv-1-copy (gncInvoiceCopy inv-1)))
+ (gncInvoiceAddEntry inv-1-copy (entry -3))
+ (gncInvoiceSetIsCreditNote inv-1-copy #t)
+ (gncInvoicePostToAccount inv-1-copy
+ (get-acct "AR-USD") ;post-to acc
+ (gnc-dmy2time64 22 06 1980) ;posted
+ (gnc-dmy2time64 22 06 1980) ;due
+ "inv $3 CN" #t #f))
+
+ ;; (gnc:dump-book) (newline)
+ ;; (gnc:dump-invoices) (newline)
+ (display "customer-report tests:\n")
+ (test-begin "customer-report")
+ (let* ((options (default-testing-options 'customer owner-1 (get-acct "AR-USD")))
+ (sxml (options->sxml 'customer options "customer-report basic")))
+ (test-equal "inv-descriptions"
+ '("inv >90 $11.50" "inv 60-90 $7.50" "inv 30-60 $8.50"
+ "inv >90 payment" "inv >90 payment" "inv <30days $4.00"
+ "inv $200" "inv $200" "inv current $6.75" "inv $3 CN"
+ "$31.75" "$8.00" "$8.00")
+ (sxml-get-row-col sxml #f 5))
+ (test-equal "debit-amounts"
+ '("$11.50" "$7.50" "$8.50" "$4.00" "$200.00" "$6.75")
+ (sxml-get-row-col sxml #f 6))
+ (test-equal "crebit-amounts"
+ '("-$1.50" "-$2.00" "-$200.00" "-$3.00")
+ (sxml-get-row-col sxml #f 7))
+ ;; from the report, find the 3rd table, last row, find embedded
+ ;; table, retrieve tr contents
+ (test-equal "aging-table"
+ '("$6.75" "$1.00" "$8.50" "$7.50" "$8.00")
+ ((sxpath `(// (table 3) // (tr -1) // table // tbody // tr // *text*))
+ sxml)))
+ (test-end "customer-report")
+
+ (display "job-report tests:\n")
+ ;; inv for job
+ (let ((inv-2-copy (gncInvoiceCopy inv-2)))
+ (gncInvoiceAddEntry inv-2-copy (entry 25/4))
+ (gncInvoicePostToAccount inv-2-copy
+ (get-acct "AR-USD") ;post-to acc
+ (gnc-dmy2time64 13 05 1980) ;posted
+ (gnc-dmy2time64 18 06 1980) ;due
+ "inv for job" #t #f)
+ (gncInvoiceApplyPayment
+ inv-2-copy '() (get-acct "Bank-USD") 25/4 1
+ (gnc-dmy2time64 18 06 1980)
+ "inv for job" "fully paid"))
+
+ (test-begin "job-report")
+ (let* ((options (default-testing-options 'job owner-2 (get-acct "AR-USD")))
+ (sxml (options->sxml 'job options "job-report basic")))
+ (test-equal "inv-descriptions"
+ '("inv for job" "inv for job")
+ (sxml-get-row-col sxml #f 5))
+ (test-equal "amounts"
+ '("$6.25" "-$6.25")
+ (sxml-get-row-col sxml #f 6)))
+ (test-end "job-report")))
commit dae26da037744a129a1bfc78b0dd62343d249bd6
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat Jul 13 22:55:50 2019 +0800
[owner-report] sanitize strings in preparation for tests
diff --git a/gnucash/report/business-reports/owner-report.scm b/gnucash/report/business-reports/owner-report.scm
index 47dd06985..d71664229 100644
--- a/gnucash/report/business-reports/owner-report.scm
+++ b/gnucash/report/business-reports/owner-report.scm
@@ -285,11 +285,11 @@
(qof-print-date due-date)
"")))
(if (num-col column-vector)
- (addto! row-contents num))
+ (addto! row-contents (gnc:html-string-sanitize num)))
(if (type-col column-vector)
(addto! row-contents type-str))
(if (memo-col column-vector)
- (addto! row-contents memo))
+ (addto! row-contents (gnc:html-string-sanitize memo)))
(if (sale-col column-vector)
(addto! row-contents
(gnc:make-html-table-cell/markup "number-cell" sale)))
commit fee383e85e441ce2a50b741ac7049b6a5075b4d3
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat Jul 13 23:17:43 2019 +0800
[job-report] sanitize strings in preparation for tests
diff --git a/gnucash/report/business-reports/job-report.scm b/gnucash/report/business-reports/job-report.scm
index e0bc4053d..60954b02d 100644
--- a/gnucash/report/business-reports/job-report.scm
+++ b/gnucash/report/business-reports/job-report.scm
@@ -480,8 +480,8 @@
(gnc:html-table-append-row!
table
(list
- (string-append label ": ")
- (string-expand (qof-print-date date) #\space " "))))
+ (string-append label " ")
+ (qof-print-date date))))
(define (make-date-table)
(let ((table (gnc:make-html-table)))
@@ -569,7 +569,7 @@
(gnc:html-document-set-headline!
document (gnc:html-markup
- "!"
+ "span"
report-title-str ": "
(gnc:html-markup-anchor
(gnc:job-anchor-text (gncOwnerGetJob owner))
commit 74169114d55e3b25c333d43c47672e1c754ac653
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat Jul 13 13:42:23 2019 +0800
[report-utilities] add gnc:dump-book and gnc:dump-invoices
(gnc:dump-book)
utility function for tests. dumps the whole book. sample output:
Account: <Root> Comm<USD> Type<Asset>
Account: <Root.Asset> Comm<USD> Type<Asset>
Account: <Root.Asset.Bank> Comm<USD> Type<Asset>
Split: 07/13/19 Amt<$17,479.18> Val<$17,479.18> Desc<cust-1-name>
Account: <Root.VAT> Comm<USD> Type<Asset>
Account: <Root.VAT.VAT-on-Sales> Comm<USD> Type<Liability>
Split: 07/13/19 Amt<-$1,111.01> Val<-$1,111.01> Desc<cust-1-name>
Account: <Root.A/Receivable> Comm<USD> Type<A/Receivable>
Split: 07/13/19 Amt<-$17,479.18> Val<-$17,479.18> Desc<cust-1-name>
Split: 07/13/19 Amt<$17,479.18> Val<$17,479.18> Desc<cust-1-name>
Account: <Root.Income> Comm<USD> Type<Income>
Split: 07/13/19 Amt<-$16,368.17> Val<-$16,368.17> Desc<cust-1-name>
(gnc:dump-invoices)
Invoice: ID<> Owner<cust-1-name>
Date: Open<?> Post<07/13/19> Due<07/13/19>
Entry: Date<07/13/19> Desc<taxable=N tax-inc...> Action<action> Notes<> Qty<11>
Entry: Date<07/13/19> Desc<taxable=N tax-inc...> Action<action> Notes<> Qty<11>
Entry: Date<07/13/19> Desc<taxable=N tax-inc...> Action<action> Notes<> Qty<11>
Entry: Date<07/13/19> Desc<taxable=Y tax-inc...> Action<action> Notes<> Qty<11>
Entry: Date<07/13/19> Desc<taxable=Y tax-inc...> Action<action> Notes<> Qty<11>
Entry: Date<07/13/19> Desc<taxable=Y tax-inc...> Action<action> Notes<> Qty<11>
Entry: Date<07/13/19> Desc<taxable=Y tax-inc...> Action<action> Notes<> Qty<11>
Entry: Date<07/13/19> Desc<taxable=Y tax-inc...> Action<action> Notes<> Qty<11>
Totals: Total<$17,479.18> TotalSubtotal<$16,368.17> TotalTax<$1,111.01>
diff --git a/gnucash/report/report-system/report-system.scm b/gnucash/report/report-system/report-system.scm
index de16b73fc..ed4f2a0d8 100644
--- a/gnucash/report/report-system/report-system.scm
+++ b/gnucash/report/report-system/report-system.scm
@@ -743,6 +743,8 @@
(export make-file-url)
(export gnc:strify)
(export gnc:pk)
+(export gnc:dump-book)
+(export gnc:dump-invoices)
;; trep-engine.scm
(export gnc:trep-options-generator)
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index a77bc0b3d..f5b6446c9 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -1160,3 +1160,75 @@ flawed. see report-utilities.scm. please update reports.")
(display (map gnc:strify args))
(newline)
(last args))))
+
+;; utility function for testing. dumps the whole book contents to
+;; console.
+(define (gnc:dump-book)
+ (for-each
+ (lambda (acc)
+ (format #t "\nAccount: <~a> Comm<~a> Type<~a>\n"
+ (gnc-account-get-full-name acc)
+ (gnc-commodity-get-mnemonic
+ (xaccAccountGetCommodity acc))
+ (xaccAccountGetTypeStr
+ (xaccAccountGetType acc)))
+ (for-each
+ (lambda (s)
+ (let ((txn (xaccSplitGetParent s)))
+ (format #t " Split: ~a Amt<~a> Val<~a> Desc<~a>\n"
+ (qof-print-date (xaccTransGetDate txn))
+ (gnc:monetary->string
+ (gnc:make-gnc-monetary
+ (xaccAccountGetCommodity acc)
+ (xaccSplitGetAmount s)))
+ (gnc:monetary->string
+ (gnc:make-gnc-monetary
+ (xaccTransGetCurrency txn)
+ (xaccSplitGetValue s)))
+ (xaccTransGetDescription txn))))
+ (xaccAccountGetSplitList acc)))
+ (gnc-account-get-descendants-sorted
+ (gnc-get-current-root-account))))
+
+;; dump all invoices posted into an AP/AR account
+(define (gnc:dump-invoices)
+ (let* ((acc-APAR (filter (compose xaccAccountIsAPARType xaccAccountGetType)
+ (gnc-account-get-descendants-sorted
+ (gnc-get-current-root-account))))
+ (inv-txns (filter (lambda (t) (eqv? (xaccTransGetTxnType t) TXN-TYPE-INVOICE))
+ (map xaccSplitGetParent
+ (append-map xaccAccountGetSplitList acc-APAR))))
+ (invoices (map gncInvoiceGetInvoiceFromTxn inv-txns)))
+ (define (maybe-date time64) ;handle INT-MAX differently
+ (if (= 9223372036854775807 time64) "?" (qof-print-date time64)))
+ (define (maybe-trunc str)
+ (if (> (string-length str) 20) (string-append (substring str 0 17) "...") str))
+ (define (inv-amt->string inv amt)
+ (gnc:monetary->string
+ (gnc:make-gnc-monetary
+ (gncInvoiceGetCurrency inv) amt)))
+ (for-each
+ (lambda (inv)
+ (format #t "\nInvoice: ID<~a> Owner<~a> Account<~a>\n"
+ (gncInvoiceGetID inv)
+ (gncOwnerGetName (gncInvoiceGetOwner inv))
+ (xaccAccountGetName (gncInvoiceGetPostedAcc inv)))
+ (format #t " Date: Open<~a> Post<~a> Due<~a>\n"
+ (maybe-date (gncInvoiceGetDateOpened inv))
+ (maybe-date (gncInvoiceGetDatePosted inv))
+ (maybe-date (gncInvoiceGetDateDue inv)))
+ (for-each
+ (lambda (entry)
+ (format #t " Entry: Date<~a> Desc<~a> Action<~a> Notes<~a> Qty<~a>\n"
+ (maybe-date (gncEntryGetDate entry))
+ (maybe-trunc (gncEntryGetDescription entry))
+ (maybe-trunc (gncEntryGetAction entry))
+ (maybe-trunc (gncEntryGetNotes entry))
+ (gncEntryGetQuantity entry)))
+ (gncInvoiceGetEntries inv))
+ (format #t " Totals: Total<~a> TotalSubtotal<~a> TotalTax<~a>\n"
+ (inv-amt->string inv (gncInvoiceGetTotal inv))
+ (inv-amt->string inv (gncInvoiceGetTotalSubtotal inv))
+ (inv-amt->string inv (gncInvoiceGetTotalTax inv)))
+ (newline))
+ invoices)))
commit 105f5396fc27cc0cd6f69511523bf03cda2cf935
Merge: 1ad4ae30b 89749a1b6
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat Jul 13 10:50:16 2019 +0800
Merge branch 'maint-budget-ytd-upgrade' into maint
commit 89749a1b63dfe5987e88871fd5e7c62c9c953977
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat Jul 13 10:11:42 2019 +0800
[test-budget] add tests for envelope budgeting
diff --git a/gnucash/report/standard-reports/test/test-budget.scm b/gnucash/report/standard-reports/test/test-budget.scm
index f1fb8ce23..6a6870af3 100644
--- a/gnucash/report/standard-reports/test/test-budget.scm
+++ b/gnucash/report/standard-reports/test/test-budget.scm
@@ -165,4 +165,11 @@
'("Bank" "$40.00" "-$20.00" "$60.00" "." "$67.00" "-$67.00"
"$60.00" "$77.00" "-$17.00" "$100.00" "$124.00" "-$24.00")
(sxml->table-row-col sxml 1 5 #f)))
+
+ (set-option options "General" "Use envelope budgeting" #t)
+ (let ((sxml (options->sxml options "envelope budgeting")))
+ (test-equal "envelope budgeting"
+ '("Bank" "$60.00" "$15.00" "$45.00" "$60.00" "$82.00" "-$22.00"
+ "$120.00" "$159.00" "-$39.00" "$120.00" "$159.00" "-$39.00")
+ (sxml->table-row-col sxml 1 5 #f)))
))
commit ec28835d78d7f8915aea830d5f299c0101cea04a
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Jul 3 21:51:25 2019 +0800
[budget] upgrade to support envelope budgeting
merges ideas from Phil Longstaff's ytd-budget.scm report. differences
from non-envelope budget:
* envelope budgeting accumulates bgt/act/diff amounts from period=0
e.g. selecting periods 2 to 4 means amounts must accumulate from
period 0 to 1 (not shown) and accumulated amounts 2 to 4 (shown).
* total column must encompass all periods from 0 to maxperiod
diff --git a/gnucash/report/standard-reports/budget.scm b/gnucash/report/standard-reports/budget.scm
index 3d30603fd..0c74ec7dc 100644
--- a/gnucash/report/standard-reports/budget.scm
+++ b/gnucash/report/standard-reports/budget.scm
@@ -55,6 +55,8 @@
(define opthelp-show-actual (N_ "Display a column for the actual values."))
(define optname-show-difference (N_ "Show Difference"))
(define opthelp-show-difference (N_ "Display the difference as budget - actual."))
+(define optname-use-envelope (N_ "Use envelope budgeting"))
+(define opthelp-use-envelope (N_ "Values are accumulated across periods."))
(define optname-show-totalcol (N_ "Show Column with Totals"))
(define opthelp-show-totalcol (N_ "Display a column with the row totals."))
(define optname-show-zb-accounts (N_ "Include accounts with zero total balances and budget values"))
@@ -135,6 +137,11 @@
gnc:pagename-general optname-budget
"a" (N_ "Budget to use.")))
+ (add-option
+ (gnc:make-simple-boolean-option
+ gnc:pagename-general optname-use-envelope
+ "b" opthelp-use-envelope #f))
+
(add-option
(gnc:make-complex-boolean-option
gnc:pagename-general optname-use-budget-period-range
@@ -262,6 +269,7 @@
(show-actual? (get-val params 'show-actual))
(show-budget? (get-val params 'show-budget))
(show-diff? (get-val params 'show-difference))
+ (use-envelope? (get-val params 'use-envelope))
(show-totalcol? (get-val params 'show-totalcol))
(use-ranges? (get-val params 'use-ranges))
(num-rows (gnc:html-acct-table-num-rows acct-table))
@@ -309,6 +317,17 @@
(gnc-budget-get-account-period-actual-value budget acct period))
periodlist)))
+ (define (flatten lst)
+ (reverse!
+ (let loop ((lst lst) (result '()))
+ (if (null? lst)
+ result
+ (let ((elt (car lst))
+ (rest (cdr lst)))
+ (if (pair? elt)
+ (loop rest (append (loop elt '()) result))
+ (loop rest (cons elt result))))))))
+
;; Adds a line to tbe budget report.
;;
;; Parameters:
@@ -323,6 +342,10 @@
column-list exchange-fn)
(let* ((comm (xaccAccountGetCommodity acct))
(reverse-balance? (gnc-reverse-balance acct))
+ (allperiods (filter number? (flatten column-list)))
+ (total-periods (if use-envelope?
+ (iota (1+ (apply max allperiods)))
+ allperiods))
(income-acct? (eqv? (xaccAccountGetType acct) ACCT-TYPE-INCOME)))
;; Displays a set of budget column values
@@ -362,8 +385,6 @@
col3))
(let loop ((column-list column-list)
- (bgt-total 0)
- (act-total 0)
(current-col (1+ colnum)))
(cond
@@ -371,19 +392,22 @@
#f)
((eq? (car column-list) 'total)
- (loop (cdr column-list)
- bgt-total
- act-total
- (disp-cols "total-number-cell" current-col
- bgt-total act-total
- (if income-acct?
- (- act-total bgt-total)
- (- bgt-total act-total)))))
+ (let* ((bgt-total (gnc:get-account-periodlist-budget-value
+ budget acct total-periods))
+ (act-total (gnc:get-account-periodlist-actual-value
+ budget acct total-periods))
+ (dif-total (if income-acct?
+ (- act-total bgt-total)
+ (- bgt-total act-total))))
+ (loop (cdr column-list)
+ (disp-cols "total-number-cell" current-col
+ bgt-total act-total dif-total))))
(else
- (let* ((period-list (if (list? (car column-list))
- (car column-list)
- (list (car column-list))))
+ (let* ((period-list (cond
+ ((list? (car column-list)) (car column-list))
+ (use-envelope? (iota (1+ (car column-list))))
+ (else (list (car column-list)))))
(bgt-val (gnc:get-account-periodlist-budget-value
budget acct period-list))
(act-abs (gnc:get-account-periodlist-actual-value
@@ -395,8 +419,6 @@
(- act-val bgt-val)
(- bgt-val act-val))))
(loop (cdr column-list)
- (+ bgt-total bgt-val)
- (+ act-total act-val)
(disp-cols "number-cell" current-col
bgt-val act-val dif-val))))))))
@@ -653,6 +675,7 @@
(if show-zb-accts? 'show-leaf-acct 'omit-leaf-acct))
(list 'report-budget budget)))
(accounts (sort accounts account-full-name<?))
+ (use-envelope? (get-option gnc:pagename-general optname-use-envelope))
(acct-table (gnc:make-html-acct-table/env/accts env accounts))
(paramsBudget
(list
@@ -662,6 +685,7 @@
(get-option gnc:pagename-display optname-show-budget))
(list 'show-difference
(get-option gnc:pagename-display optname-show-difference))
+ (list 'use-envelope use-envelope?)
(list 'show-totalcol
(get-option gnc:pagename-display optname-show-totalcol))
(list 'use-ranges use-ranges?)
@@ -681,8 +705,10 @@
gnc:optname-reportname)))
(gnc:html-document-set-title!
- doc (format #f (_ "~a: ~a")
- report-name (gnc-budget-get-name budget)))
+ doc (format #f "~a: ~a ~a"
+ report-name (gnc-budget-get-name budget)
+ (if use-envelope? (_ "using envelope budgeting")
+ "")))
;; We do this in two steps: First the account names... the
;; add-account-balances will actually compute and add a
commit c05ba6415f55cb7114ed523e55494aa4c212a4da
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat Jul 13 10:27:05 2019 +0800
[budget] compact functions in options-generator
diff --git a/gnucash/report/standard-reports/budget.scm b/gnucash/report/standard-reports/budget.scm
index 3f3cd12e8..3d30603fd 100644
--- a/gnucash/report/standard-reports/budget.scm
+++ b/gnucash/report/standard-reports/budget.scm
@@ -137,38 +137,29 @@
(add-option
(gnc:make-complex-boolean-option
- gnc:pagename-general
- optname-use-budget-period-range
- "f"
- opthelp-use-budget-period-range
- #f
- #f
- ;; Make period only option widgets
- ;; selectable only when we are running the report for a budget period
- ;; range.
+ gnc:pagename-general optname-use-budget-period-range
+ "f" opthelp-use-budget-period-range #f #f
(lambda (value)
- (let ((enabler (lambda (target-opt enabled)
- (set-option-enabled
- options gnc:pagename-general target-opt enabled))))
- (for-each
- (lambda (target-opt)
- (enabler target-opt value))
- (list optname-budget-period-start optname-budget-period-end
- optname-period-collapse-before optname-period-collapse-after))
- (enabler optname-budget-period-start-exact
- (and value
- (eq? 'manual ui-start-period-type)))
- (enabler optname-budget-period-end-exact
- (and value
- (eq? 'manual ui-end-period-type)))
- (set! ui-use-periods value)))))
+ (for-each
+ (lambda (opt)
+ (set-option-enabled options gnc:pagename-general opt value))
+ (list optname-budget-period-start optname-budget-period-end
+ optname-period-collapse-before optname-period-collapse-after))
+
+ (set-option-enabled options gnc:pagename-general
+ optname-budget-period-start-exact
+ (and value (eq? 'manual ui-start-period-type)))
+
+ (set-option-enabled options gnc:pagename-general
+ optname-budget-period-end-exact
+ (and value (eq? 'manual ui-end-period-type)))
+
+ (set! ui-use-periods value))))
(add-option
(gnc:make-multichoice-callback-option
gnc:pagename-general optname-budget-period-start
- "g1.1" opthelp-budget-period-start 'current
- period-options
- #f
+ "g1.1" opthelp-budget-period-start 'current period-options #f
(lambda (new-val)
(set-option-enabled options gnc:pagename-general
optname-budget-period-start-exact
@@ -187,9 +178,7 @@
(add-option
(gnc:make-multichoice-callback-option
gnc:pagename-general optname-budget-period-end
- "g2.1" opthelp-budget-period-end 'next
- period-options
- #f
+ "g2.1" opthelp-budget-period-end 'next period-options #f
(lambda (new-val)
(set-option-enabled options gnc:pagename-general
optname-budget-period-end-exact
@@ -217,15 +206,15 @@
"g4" opthelp-period-collapse-after #t))
(gnc:options-add-account-selection!
- options gnc:pagename-accounts
- optname-display-depth optname-show-subaccounts
- optname-accounts "a" 2
+ options gnc:pagename-accounts optname-display-depth
+ optname-show-subaccounts optname-accounts "a" 2
(lambda ()
(gnc:filter-accountlist-type
(list ACCT-TYPE-ASSET ACCT-TYPE-LIABILITY ACCT-TYPE-INCOME
ACCT-TYPE-EXPENSE)
(gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
#f)
+
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-accounts optname-bottom-behavior
commit 43c8b16ba53d24dc24bf76b1726f0a3daba0c747
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat Jul 13 10:18:44 2019 +0800
[budget] remove unused options
these options are unused
* general/price-source
* general/show-full-names?
diff --git a/gnucash/report/standard-reports/budget.scm b/gnucash/report/standard-reports/budget.scm
index bcbaa9979..3f3cd12e8 100644
--- a/gnucash/report/standard-reports/budget.scm
+++ b/gnucash/report/standard-reports/budget.scm
@@ -48,9 +48,6 @@
(define optname-show-subaccounts (N_ "Always show sub-accounts"))
(define optname-accounts (N_ "Account"))
-(define optname-price-source (N_ "Price Source"))
-(define optname-show-rates (N_ "Show Exchange Rates"))
-(define optname-show-full-names (N_ "Show Full Account Names"))
(define optname-select-columns (N_ "Select Columns"))
(define optname-show-budget (N_ "Show Budget"))
(define opthelp-show-budget (N_ "Display a column for the budget values."))
@@ -138,15 +135,6 @@
gnc:pagename-general optname-budget
"a" (N_ "Budget to use.")))
- (gnc:options-add-price-source!
- options gnc:pagename-general optname-price-source "c" 'pricedb-nearest)
-
- (gnc:register-option
- options
- (gnc:make-simple-boolean-option
- gnc:pagename-general optname-show-full-names
- "e" (N_ "Show full account names (including parent accounts).") #t))
-
(add-option
(gnc:make-complex-boolean-option
gnc:pagename-general
@@ -638,8 +626,6 @@
(include-collapse-after? (and use-ranges?
(get-option gnc:pagename-general
optname-period-collapse-after)))
- (show-full-names? (get-option gnc:pagename-general
- optname-show-full-names))
(doc (gnc:make-html-document))
(accounts (append accounts
(filter (lambda (acc) (not (member acc accounts)))
commit 1ad4ae30be3aea7122a410a3d8371695cfb3b85a
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Jul 12 21:54:24 2019 +0800
[owner-report] fix html to be parsable by sxml
in preparation for tests
diff --git a/gnucash/report/business-reports/owner-report.scm b/gnucash/report/business-reports/owner-report.scm
index b6a0a48ce..47dd06985 100644
--- a/gnucash/report/business-reports/owner-report.scm
+++ b/gnucash/report/business-reports/owner-report.scm
@@ -691,8 +691,8 @@
(gnc:html-table-append-row!
table
(list
- (string-append label ": ")
- (string-expand (qof-print-date date) #\space " "))))
+ (string-append label ": ")
+ (qof-print-date date))))
(define (make-date-table)
(let ((table (gnc:make-html-table)))
@@ -777,7 +777,7 @@
(gnc:html-document-set-headline!
document (gnc:html-markup
- "!"
+ "span"
(doctype-str type)
" " (_ "Report:") " "
(gnc:html-markup-anchor
commit 6c4ae8901257a5a1364d04428a48b51240f86e94
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Jul 12 21:08:15 2019 +0800
[business-options] fix whitespace
diff --git a/libgnucash/app-utils/business-options.scm b/libgnucash/app-utils/business-options.scm
index dfbc3f939..7b89c1c58 100644
--- a/libgnucash/app-utils/business-options.scm
+++ b/libgnucash/app-utils/business-options.scm
@@ -351,8 +351,8 @@
section name sort-tag 'owner documentation-string getter
(lambda (owner)
(if (null? owner) (set! owner (default-getter)))
- (set! owner (convert-to-owner owner))
- (let* ((result (validator owner))
+ (set! owner (convert-to-owner owner))
+ (let* ((result (validator owner))
(valid (car result))
(value (cadr result)))
(if valid
@@ -456,13 +456,22 @@
sort-tag
documentation-string
default-value)
- (let ((option (gnc:make-number-range-option section name sort-tag documentation-string default-value 0 999999999 0 1)))
- (gnc:set-option-scm->kvp option (lambda (b p) (qof-book-set-option b (inexact->exact ((gnc:option-getter option))) (list "counters" key))))
- (gnc:set-option-kvp->scm option (lambda (b p)
- (let ((v (qof-book-get-option b (list "counters" key))))
- (if (and v (integer? v))
- ((gnc:option-setter option) v)))))
- option))
+ (let ((option (gnc:make-number-range-option
+ section name sort-tag documentation-string
+ default-value 0 999999999 0 1)))
+ (gnc:set-option-scm->kvp
+ option
+ (lambda (b p)
+ (qof-book-set-option
+ b (inexact->exact ((gnc:option-getter option)))
+ (list "counters" key))))
+ (gnc:set-option-kvp->scm
+ option
+ (lambda (b p)
+ (let ((v (qof-book-get-option b (list "counters" key))))
+ (if (and v (integer? v))
+ ((gnc:option-setter option) v)))))
+ option))
;; This defines an option to set a counter format, which has the same
;; exception as gnc:make-counter-option above.
@@ -476,19 +485,23 @@
sort-tag
documentation-string
default-value)
- (let ((option (gnc:make-string-option section name sort-tag documentation-string #f)))
- (gnc:option-set-value option default-value)
- (gnc:set-option-scm->kvp option
- (lambda (b p)
- (let ((value ((gnc:option-getter option)))
- (path (string-concatenate (list "counter_formats/" key))))
- (qof-book-set-string-option b path value))))
- (gnc:set-option-kvp->scm option (lambda (b p)
- (let* ((path (string-concatenate (list "counter_formats/" key)))
- (v (qof-book-get-string-option b path)))
- (if (and v (string? v))
- ((gnc:option-setter option) v)))))
- option))
+ (let ((option (gnc:make-string-option
+ section name sort-tag documentation-string #f)))
+ (gnc:option-set-value option default-value)
+ (gnc:set-option-scm->kvp
+ option
+ (lambda (b p)
+ (let ((value ((gnc:option-getter option)))
+ (path (string-concatenate (list "counter_formats/" key))))
+ (qof-book-set-string-option b path value))))
+ (gnc:set-option-kvp->scm
+ option
+ (lambda (b p)
+ (let* ((path (string-concatenate (list "counter_formats/" key)))
+ (v (qof-book-get-string-option b path)))
+ (if (and v (string? v))
+ ((gnc:option-setter option) v)))))
+ option))
(export gnc:make-invoice-option)
(export gnc:make-customer-option)
commit 560b313f8536b9e8a1bebae3e3e515887d663204
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Jul 12 20:36:57 2019 +0800
[business-options] deprecate unused option-types
diff --git a/libgnucash/app-utils/business-options.scm b/libgnucash/app-utils/business-options.scm
index 8331590ce..dfbc3f939 100644
--- a/libgnucash/app-utils/business-options.scm
+++ b/libgnucash/app-utils/business-options.scm
@@ -104,6 +104,8 @@
(if (string? item)
(gncCustomerLookupFlip item (gnc-get-current-book))
item))
+ (issue-deprecation-warning
+ "gnc:make-customer-option is unused.")
(let* ((option (convert-to-guid (default-getter)))
(option-set #f)
@@ -166,6 +168,9 @@
(gncVendorLookupFlip item (gnc-get-current-book))
item))
+ (issue-deprecation-warning
+ "gnc:make-vendor-option is unused.")
+
(let* ((option (convert-to-guid (default-getter)))
(option-set #f)
(getter (lambda () (convert-to-vendor
@@ -226,6 +231,8 @@
(if (string? item)
(gncEmployeeLookupFlip item (gnc-get-current-book))
item))
+ (issue-deprecation-warning
+ "gnc:make-employee-option is unused.")
(let* ((option (convert-to-guid (default-getter)))
(option-set #f)
Summary of changes:
gnucash/report/report-utilities.scm | 89 +++++-
gnucash/report/report.scm | 2 +
gnucash/report/reports/standard/budget.scm | 125 ++++----
gnucash/report/reports/standard/invoice.scm | 2 +-
gnucash/report/reports/standard/job-report.scm | 6 +-
gnucash/report/reports/standard/owner-report.scm | 10 +-
.../report/reports/standard/test/CMakeLists.txt | 1 +
.../report/reports/standard/test/test-budget.scm | 7 +
.../reports/standard/test/test-owner-report.scm | 346 +++++++++++++++++++++
gnucash/report/test/test-report-utilities.scm | 22 +-
libgnucash/app-utils/business-options.scm | 64 ++--
libgnucash/engine/business-core.scm | 46 ++-
libgnucash/engine/test/CMakeLists.txt | 14 +
libgnucash/engine/test/test-business-core.scm | 300 ++++++++++++++++++
14 files changed, 903 insertions(+), 131 deletions(-)
create mode 100644 gnucash/report/reports/standard/test/test-owner-report.scm
create mode 100644 libgnucash/engine/test/test-business-core.scm
More information about the gnucash-changes
mailing list