Hi, not sure if .scm tests are welcome in engine/tests; test-business-core.scm in maint is running well however in master it fails to access the engine. ACCT-TYPE-LIABILITY is undefined, ditto gnc-commodity-table-lookup etc. The following is not adequate to allow test-business-core.scm to access core engine. How to fix?
modified 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 ---------- Forwarded message --------- From: Christopher Lam <c...@code.gnucash.org> Date: Fri, 19 Jul 2019 at 14:25 Subject: gnucash maint: Multiple changes pushed To: <gnucash-chan...@gnucash.org> Updated 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) from https://github.com/Gnucash/gnucash/commit/8adcacbd (commit) commit 0c433e02f7d0003c10e1244f572d0a9badd46e33 Author: Christopher Lam <christopher....@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....@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 <mi...@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....@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....@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) Summary of changes: gnucash/report/business-reports/invoice.scm | 2 +- gnucash/report/report-system/report-utilities.scm | 17 +- .../report-system/test/test-report-utilities.scm | 22 +- libgnucash/engine/business-core.scm | 46 ++--- libgnucash/engine/test/CMakeLists.txt | 5 + .../engine/test/test-business-core.scm | 222 ++++++++------------- 6 files changed, 140 insertions(+), 174 deletions(-) copy gnucash/report/business-reports/test/test-owner-report.scm => libgnucash/engine/test/test-business-core.scm (65%) _______________________________________________ gnucash-changes mailing list gnucash-chan...@gnucash.org https://lists.gnucash.org/mailman/listinfo/gnucash-changes _______________________________________________ gnucash-devel mailing list gnucash-devel@gnucash.org https://lists.gnucash.org/mailman/listinfo/gnucash-devel