[GNC-dev] gnucash maint: Multiple changes pushed

John Ralls jralls at ceridwen.us
Sat Jul 20 00:00:54 EDT 2019


Testing the Swig bindings would be a good thing, the more thorough the better. For the most part the Swig binding tests just make sure that they can load a module, which isn't much of a test.

Regards,
John Ralls


> On Jul 19, 2019, at 8:44 AM, Christopher Lam <christopher.lck at gmail.com> wrote:
> 
> 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 <clam at code.gnucash.org>
> Date: Fri, 19 Jul 2019 at 14:25
> Subject: gnucash maint: Multiple changes pushed
> To: <gnucash-changes at 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.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)
> 
> 
> 
> 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-changes at gnucash.org
> https://lists.gnucash.org/mailman/listinfo/gnucash-changes
> _______________________________________________
> gnucash-devel mailing list
> gnucash-devel at gnucash.org
> https://lists.gnucash.org/mailman/listinfo/gnucash-devel



More information about the gnucash-devel mailing list