From b30f4d7c901884b1ce1d6ce8d0438551a3c42461 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sun, 27 May 2018 14:20:14 +0800 Subject: [PATCH 1/8] [easy-invoice.scm] fix html to be parsable by sxml Without this change the HTML cannot be parsed by sxml. --- gnucash/report/business-reports/easy-invoice.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnucash/report/business-reports/easy-invoice.scm b/gnucash/report/business-reports/easy-invoice.scm index ecf14a2746..351efc7489 100644 --- a/gnucash/report/business-reports/easy-invoice.scm +++ b/gnucash/report/business-reports/easy-invoice.scm @@ -655,7 +655,7 @@ ; framing table (add-html! document "
") + (add-html! document "' cellpadding='0' cellspacing='0'>") (add-html! document "
") From 746219926aa765a1df23f5436dd3d7ee02b60b6a Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sun, 27 May 2018 15:55:04 +0800 Subject: [PATCH 2/8] [test-extras.scm] upgrade options->sxml to parse   entities The default xml->sxml parser handles only > < & ' " entities. We need to add handler for   as well. --- gnucash/report/report-system/test/test-extras.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/gnucash/report/report-system/test/test-extras.scm b/gnucash/report/report-system/test/test-extras.scm index b8a74c29e6..46023f3801 100644 --- a/gnucash/report/report-system/test/test-extras.scm +++ b/gnucash/report/report-system/test/test-extras.scm @@ -117,7 +117,8 @@ (lambda () (display render))) (catch 'parser-error - (lambda () (xml->sxml render)) + (lambda () (xml->sxml render + #:entities '((nbsp . "\xa0")))) (lambda (k . args) (format #t "*** XML error. see render output at ~a\n~a" filename (gnc:html-render-options-changed options #t)) From 7918c0317ea6d30df0829be86861cfb3292fb743 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sun, 27 May 2018 22:54:50 +0800 Subject: [PATCH 3/8] [test-extras.scm] options->sxml to whitespace Previously whitespace was encoded onto SXML, but it seems to make travis complain, i.e. on my branch no errors, however, on main Gnucash branch would occasionally strip whitespace. This change will parse XHTML and strip whitespace, which means some tests need amending. --- gnucash/report/report-system/test/test-extras.scm | 1 + .../standard-reports/test/test-income-gst.scm | 8 ++++---- .../standard-reports/test/test-transaction.scm | 15 ++++++--------- 3 files changed, 11 insertions(+), 13 deletions(-) diff --git a/gnucash/report/report-system/test/test-extras.scm b/gnucash/report/report-system/test/test-extras.scm index 46023f3801..bdbd92be58 100644 --- a/gnucash/report/report-system/test/test-extras.scm +++ b/gnucash/report/report-system/test/test-extras.scm @@ -118,6 +118,7 @@ (display render))) (catch 'parser-error (lambda () (xml->sxml render + #:trim-whitespace? #t #:entities '((nbsp . "\xa0")))) (lambda (k . args) (format #t "*** XML error. see render output at ~a\n~a" diff --git a/gnucash/report/standard-reports/test/test-income-gst.scm b/gnucash/report/standard-reports/test/test-income-gst.scm index a11bbf816d..88f778677e 100644 --- a/gnucash/report/standard-reports/test/test-income-gst.scm +++ b/gnucash/report/standard-reports/test/test-income-gst.scm @@ -188,15 +188,15 @@ (set-option! options "Sorting" "Secondary Subtotal" 'account-name) (let ((sxml (options->sxml options "initial setup"))) (test-equal "totals are as expected" - '("Grand Total" " " " " "$1,055.00" "$1,000.00" "$55.00" "$248.00" "$230.00" "$18.00") + '("Grand Total" "$1,055.00" "$1,000.00" "$55.00" "$248.00" "$230.00" "$18.00") (sxml->table-row-col sxml 1 -1 #f)) (test-equal "tax on sales as expected" - '(" " "\n" "$20.00" "$20.00" " " " " "\n" "$20.00" "$20.00" "\n" "$15.00" "$15.00" "$55.00") + '("$20.00" "$20.00" "$20.00" "$20.00" "$15.00" "$15.00" "$55.00") (sxml->table-row-col sxml 1 #f 6)) (test-equal "tax on purchases as expected" - '(" " " " " " " " "\n" "$8.00" "\n" "$10.00" "$18.00" " " " " "$18.00") + '("$8.00" "$10.00" "$18.00" "$18.00") (sxml->table-row-col sxml 1 #f 9))) (set-option! options "Display" "Individual tax columns" #t) @@ -207,7 +207,7 @@ (set-option! options "Display" "Tax payable" #t) (let ((sxml (options->sxml options "display options enabled"))) (test-equal "all display columns enabled" - '("Grand Total" " " " " "$1,055.00" "$1,000.00" "$20.00" "$35.00" "$248.00" "$230.00" "$18.00" "$807.00" "$770.00" "$37.00") + '("Grand Total" "$1,055.00" "$1,000.00" "$20.00" "$35.00" "$248.00" "$230.00" "$18.00" "$807.00" "$770.00" "$37.00") (sxml->table-row-col sxml 1 -1 #f)))) (test-end "display options"))) diff --git a/gnucash/report/standard-reports/test/test-transaction.scm b/gnucash/report/standard-reports/test/test-transaction.scm index 7e4d0c736a..5919ec74f1 100644 --- a/gnucash/report/standard-reports/test/test-transaction.scm +++ b/gnucash/report/standard-reports/test/test-transaction.scm @@ -277,9 +277,6 @@ (test-equal "default headers" default-headers (get-row-col sxml 0 #f)) - (test-equal "last row has same number of cols as header" - (length default-headers) - (length (get-row-col sxml -1 #f))) (test-equal "grand total present" '("Grand Total") (get-row-col sxml -1 1)) @@ -300,7 +297,7 @@ (set-option! options "Sorting" "Secondary Subtotal for Date Key" 'monthly) (let ((sxml (options->sxml options "test basic column headers, and original currency"))) (test-equal "default headers, indented, includes common-currency" - '(" " " " "Date" "Num" "Description" "Memo/Notes" "Account" "Amount (USD)" "Amount") + '("Date" "Num" "Description" "Memo/Notes" "Account" "Amount (USD)" "Amount") (get-row-col sxml 0 #f)) (test-equal "grand total present, no blank cells, and is $2,280 in both common-currency and original-currency" '("Grand Total" "$2,280.00" "$2,280.00") @@ -515,7 +512,7 @@ (string-null? (string-trim-both reconcile-date-string)))) (get-row-col sxml #f 2))) (test-equal "reconciled status subtotal" - (list "Total For Unreconciled" " " " " " " " " " " " " " " " " "$0.00" " ") + (list "Total For Unreconciled" "$0.00") (get-row-col sxml -3 #f)) ) @@ -642,10 +639,10 @@ "Debit (USD)" "Credit (USD)" "Debit" "Credit") (get-row-col sxml 0 #f)) (test-equal "dual amount column, grand totals available" - (list "Grand Total" " " " " " " " " "$2,280.00" "$2,280.00") + (list "Grand Total" "$2,280.00" "$2,280.00") (get-row-col sxml -1 #f)) (test-equal "dual amount column, first transaction correct" - (list "01/03/18" "$103 income" "Root.Asset.Bank" "\n" "$103.00" " " "\n" "$103.00" " ") + (list "01/03/18" "$103 income" "Root.Asset.Bank" "$103.00" "$103.00") (get-row-col sxml 1 #f))) ) @@ -743,10 +740,10 @@ (set-option! options "Sorting" "Show Account Description" #t) (let* ((sxml (options->sxml options "sorting=date, friendly headers"))) (test-equal "expense acc friendly headers" - '("\n" "Expenses" "\n" "Expense" "\n" "Rebate") + '("Expenses" "Expense" "Rebate") (get-row-col sxml 69 #f)) (test-equal "income acc friendly headers" - '("\n" "Income" "\n" "Charge" "\n" "Income") + '("Income" "Charge" "Income") (get-row-col sxml 91 #f))) (set-option! options "Accounts" "Accounts" (list bank)) From da1d1b9a47939ad08ac645024f448a4820103ad8 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Thu, 10 May 2018 23:20:57 +0800 Subject: [PATCH 4/8] [test-invoice] initial commit --- .../business-reports/test/CMakeLists.txt | 1 + .../business-reports/test/test-invoice.scm | 536 ++++++++++++++++++ 2 files changed, 537 insertions(+) create mode 100644 gnucash/report/business-reports/test/test-invoice.scm diff --git a/gnucash/report/business-reports/test/CMakeLists.txt b/gnucash/report/business-reports/test/CMakeLists.txt index 9c62903395..26fe436939 100644 --- a/gnucash/report/business-reports/test/CMakeLists.txt +++ b/gnucash/report/business-reports/test/CMakeLists.txt @@ -1,5 +1,6 @@ set(scm_test_business_reports_with_srfi64_SOURCES + test-invoice.scm ) set(GUILE_DEPENDS diff --git a/gnucash/report/business-reports/test/test-invoice.scm b/gnucash/report/business-reports/test/test-invoice.scm new file mode 100644 index 0000000000..2f196b11ab --- /dev/null +++ b/gnucash/report/business-reports/test/test-invoice.scm @@ -0,0 +1,536 @@ +(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 'invoice "5123a759ceb9483abf2182d01c140e8d") + (cons 'fancy-invoice "3ce293441e894423a2425d7a22dd1ac6") + (cons 'easy-invoice "67112f318bef4fc496bdc27d106bbda4"))) + +(setlocale LC_ALL "C") + +(define (run-test) + (if #f + (coverage-test run-test-proper) + (run-test-proper))) + +(define (coverage-test tester) + (add-to-load-path "/home/chris/sources/gnucash/gnucash/report/business-reports") + (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) + (test-runner-factory gnc:test-runner) + (test-begin "test-invoice.scm") + (inv-tests 'invoice) + ;; (inv-tests 'easy-invoice) + ;; (inv-tests 'fancy-invoice) + (test-end "test-invoice.scm")) + +(define (sxml-main-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 structure + (list "Root" (list (cons 'type ACCT-TYPE-ASSET) + (cons 'commodity (gnc-default-report-currency))) + (list "Asset" + (list "Bank")) + (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 "A/Receivable" (list (cons 'type ACCT-TYPE-RECEIVABLE))))) + +(define (inv-tests variant) + ;; This function will perform implementation testing on the printable invoice. + (define uuid (cdr (assq variant uuid-list))) + (define (options->sxml options test-title) + (gnc:options->sxml uuid options (format #f "test-~a" variant) test-title)) + + (format #t "\n\n**** starting tests for variant ~a ****\n\n" variant) + + (let* ((env (create-test-env)) + (account-alist (env-create-account-structure-alist env structure)) + (bank (cdr (assoc "Bank" account-alist))) + (income (cdr (assoc "Income" account-alist))) + (vat-sales (cdr (assoc "VAT-on-Sales" account-alist))) + (vat-purchases (cdr (assoc "VAT-on-Purchases" account-alist))) + (receivable (cdr (assoc "A/Receivable" account-alist))) + (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 (gnc-default-report-currency)) + (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") + 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") + inv-2)) + + (vend-1 (let ((vend-1 (gncVendorCreate (gnc-get-current-book)))) + (gncVendorSetID vend-1 "vend-1-id") + (gncVendorSetName vend-1 "vend-1-name") + (gncVendorSetNotes vend-1 "vend-1-notes") + (gncVendorSetCurrency vend-1 (gnc-default-report-currency)) + (gncVendorSetTaxIncluded vend-1 1) ;1 = GNC-TAXINCLUDED-YES + vend-1)) + + (owner-3 (let ((owner-3 (gncOwnerNew))) + (gncOwnerInitVendor owner-3 vend-1) + owner-3)) + + ;; inv-3 is generated from a vendor + (inv-3 (let ((inv-3 (gncInvoiceCreate (gnc-get-current-book)))) + (gncInvoiceSetOwner inv-3 owner-3) + (gncInvoiceSetNotes inv-3 "inv-3-notes") + inv-3)) + + (emp-1 (let ((emp-1 (gncEmployeeCreate (gnc-get-current-book)))) + (gncEmployeeSetID emp-1 "emp-1-id") + (gncEmployeeSetCurrency emp-1 (gnc-default-report-currency)) + (gncEmployeeSetName emp-1 "emp-1-name") + emp-1)) + + (owner-4 (let ((owner-4 (gncOwnerNew))) + (gncOwnerInitEmployee owner-4 emp-1) + owner-4)) + + ;; inv-4 is generated for an employee + (inv-4 (let ((inv-4 (gncInvoiceCreate (gnc-get-current-book)))) + (gncInvoiceSetOwner inv-4 owner-4) + (gncInvoiceSetNotes inv-4 "inv-4-notes") + inv-4)) + + ;; inv-5 cust-credit-note + (inv-5 (let ((inv-5 (gncInvoiceCopy inv-1))) + (gncInvoiceSetIsCreditNote inv-5 #t) + inv-5)) + + ;; inv-6 vend-credit-note + (inv-6 (let ((inv-6 (gncInvoiceCopy inv-3))) + (gncInvoiceSetIsCreditNote inv-6 #t) + inv-6)) + + ;; inv-7 emp-credit-note + (inv-7 (let ((inv-7 (gncInvoiceCopy inv-4))) + (gncInvoiceSetIsCreditNote inv-7 #t) + inv-7)) + + (standard-vat-sales-tt (let ((tt (gncTaxTableCreate (gnc-get-current-book)))) + (gncTaxTableIncRef tt) + (gncTaxTableSetName tt "10% vat on sales") + (let ((entry (gncTaxTableEntryCreate))) + (gncTaxTableEntrySetAccount entry vat-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 vat-purchases) + (gncTaxTableEntrySetType entry GNC-AMT-TYPE-PERCENT) + (gncTaxTableEntrySetAmount entry 10) + (gncTaxTableAddEntry tt entry)) + tt))) + + (define (default-testing-options inv) + (let ((options (gnc:make-report-options uuid))) + (set-option! options "General" "Invoice Number" inv) + (for-each + (lambda (disp-col-name) + (set-option! options "Display Columns" disp-col-name #t)) + '("Date" "Description" "Action" "Quantity" "Price" "Discount" + "Taxable" "Tax Amount" "Total")) + (for-each + (lambda (disp-col-name) + (set-option! options "Display" disp-col-name #t)) + '("Individual Taxes" "Totals" "References" "Billing Terms" + "Billing ID" "Invoice Notes" "Payments" "Job Details")) + options)) + + ;; entry-1 2 widgets of $3 = $6 + (let ((entry-1 (gncEntryCreate (gnc-get-current-book)))) + (gncEntrySetDateGDate entry-1 (time64-to-gdate (current-time))) + (gncEntrySetDescription entry-1 "entry-1-desc") + (gncEntrySetAction entry-1 "entry-1-action") + (gncEntrySetNotes entry-1 "entry-1-notes") + (gncEntrySetInvAccount entry-1 income) + (gncEntrySetDocQuantity entry-1 2 #f) + (gncEntrySetInvPrice entry-1 3) + (gncInvoiceAddEntry inv-1 entry-1)) + + (test-begin "inv-1 simple entry") + (let* ((options (default-testing-options inv-1)) + (sxml (options->sxml options "inv-1 simple entry"))) + (test-equal "inv-1 simple entry amounts are correct" + '("$6.00" "$6.00" "$6.00" "$6.00") + (sxml-main-get-row-col sxml #f -1)) + (test-equal "inv-1 simple entry details are correct" + '("entry-1-desc" "entry-1-action" "2.00" "$3.00" "0.00 %" "T" "$0.00" "$6.00") + (cdr (sxml-main-get-row-col sxml 1 #f))) + (test-equal "inv-1 cust-name is correct" + '("cust-1-name") + ((sxpath '(// (table 2) // tbody // tr // td // *text*)) + sxml)) + (test-assert "inv-1-billing-id is in invoice body" + (member + "Reference:\xa0inv-1-billing-id" + ((sxpath '(// body // *text*)) sxml))) + (test-assert "inv-1 inv-notes is in invoice body" + (member + "inv-1-notes" + ((sxpath '(// body // *text*)) sxml)))) + (test-end "inv-1 simple entry") + + (test-begin "inv-1 simple entry, sparse options") + (let* ((options (let ((options (default-testing-options inv-1))) + (for-each + (lambda (disp-col-name) + (set-option! options "Display Columns" disp-col-name #f)) + '("Date" "Description" "Action" "Quantity" "Price" "Discount" + "Taxable" "Tax Amount" "Total")) + (for-each + (lambda (disp-col-name) + (set-option! options "Display" disp-col-name #f)) + '("Individual Taxes" "Totals" "References" "Billing Terms" + "Billing ID" "Invoice Notes" "Payments" "Job Details")) + options)) + (sxml (options->sxml options "inv-1 simple entry sparse"))) + (test-equal "inv-1 sparse simple entry headers are correct" + '("Net Price" "Tax" "Total Price" "Amount Due") + (sxml-main-get-row-col sxml #f 1)) + (test-equal "inv-1 sparse simple entry amounts are correct" + '("$6.00" "$0.00" "$6.00" "$6.00") + (sxml-main-get-row-col sxml #f -1))) + (test-end "inv-1 simple entry, sparse options") + + (test-begin "inv-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 income) + (gncEntrySetInvTaxable entry-2 #f) + (gncEntrySetDocQuantity entry-2 5 #f) + (gncEntrySetInvPrice entry-2 11) + (gncEntrySetInvDiscount entry-2 10) + (gncInvoiceAddEntry inv-1 entry-2)) + ;; entry-inv-2 2 widgets of $3 = $6 + (let ((entry-inv-2 (gncEntryCreate (gnc-get-current-book)))) + (gncEntrySetDateGDate entry-inv-2 (time64-to-gdate (current-time))) + (gncEntrySetDescription entry-inv-2 "entry-inv-2-desc") + (gncEntrySetAction entry-inv-2 "entry-inv-2-action") + (gncEntrySetNotes entry-inv-2 "entry-inv-2-notes") + (gncEntrySetInvAccount entry-inv-2 income) + (gncEntrySetDocQuantity entry-inv-2 2 #f) + (gncEntrySetInvPrice entry-inv-2 3) + (gncInvoiceAddEntry inv-2 entry-inv-2)) + (let* ((options (default-testing-options inv-2)) + (sxml (options->sxml options "inv-2 simple entry"))) + (test-equal "inv-2 simple entry amounts are correct" + '("$6.00" "$6.00" "$6.00" "$6.00") + (sxml-main-get-row-col sxml #f -1)) + (test-equal "inv-2 simple entry details are correct" + '("entry-inv-2-desc" "entry-inv-2-action" "2.00" "$3.00" "0.00 %" "T" "$0.00" "$6.00") + (cdr (sxml-main-get-row-col sxml 1 #f))) + (test-equal "inv-2 cust-name is correct" + '("cust-1-name") + ((sxpath '(// (table 2) // tbody // tr // td // *text*)) + sxml)) + (test-assert "inv-2 inv-notes is in invoice body" + (member + "inv-2-notes" + ((sxpath '(// body // *text*)) sxml))) + (test-assert "inv-2 jobnumber is in invoice body" + (member + "Job number:\xa0job-1-id" + ((sxpath '(// body // *text*)) sxml))) + (test-assert "inv-2 jobname is in invoice body" + (member + "Job name:\xa0job-1-name" + ((sxpath '(// body // *text*)) sxml))) + ) + (test-end "inv-2") + + (test-begin "inv-3") + ;; entry-inv-3 2 widgets of $3 = $6 + (let ((entry-inv-3 (gncEntryCreate (gnc-get-current-book)))) + (gncEntrySetDateGDate entry-inv-3 (time64-to-gdate (current-time))) + (gncEntrySetDescription entry-inv-3 "entry-inv-3-desc") + (gncEntrySetAction entry-inv-3 "entry-inv-3-action") + (gncEntrySetNotes entry-inv-3 "entry-inv-3-notes") + (gncEntrySetInvAccount entry-inv-3 income) + (gncEntrySetDocQuantity entry-inv-3 2 #f) + (gncEntrySetBillPrice entry-inv-3 3) + (gncInvoiceAddEntry inv-3 entry-inv-3)) + (let* ((options (default-testing-options inv-3)) + (sxml (options->sxml options "inv-3 simple entry"))) + (test-equal "inv-3 simple entry amounts are correct" + '("$6.00" "$6.00" "$6.00" "$6.00") + (sxml-main-get-row-col sxml #f -1)) + (test-equal "inv-3 simple entry details are correct" + '("entry-inv-3-desc" "entry-inv-3-action" "2.00" "$3.00" "T" "$0.00" "$6.00") + (cdr (sxml-main-get-row-col sxml 1 #f))) + (test-equal "inv-3 vend-name is correct" + '("vend-1-name") + ((sxpath '(// (table 2) // tbody // tr // td // *text*)) + sxml)) + (test-assert "inv-3 inv-notes is in invoice body" + (member + "inv-3-notes" + ((sxpath '(// body // *text*)) sxml)))) + (test-end "inv-3") + + + (test-begin "inv-4") + ;; entry-inv-4 2 widgets of $3 = $6 + (let ((entry-inv-4 (gncEntryCreate (gnc-get-current-book)))) + (gncEntrySetDateGDate entry-inv-4 (time64-to-gdate (current-time))) + (gncEntrySetDescription entry-inv-4 "entry-inv-4-desc") + (gncEntrySetAction entry-inv-4 "entry-inv-4-action") + (gncEntrySetNotes entry-inv-4 "entry-inv-4-notes") + (gncEntrySetInvAccount entry-inv-4 income) + (gncEntrySetDocQuantity entry-inv-4 2 #f) + (gncEntrySetBillPrice entry-inv-4 3) + (gncInvoiceAddEntry inv-4 entry-inv-4)) + (let* ((options (default-testing-options inv-4)) + (sxml (options->sxml options "inv-4 simple entry"))) + (test-equal "inv-4 simple entry amounts are correct" + '("$6.00" "$6.00" "$6.00" "$6.00") + (sxml->table-row-col sxml 3 #f -1)) + (test-equal "inv-4 simple entry details are correct" + '("entry-inv-4-desc" "entry-inv-4-action" "2.00" "$3.00" "T" "$0.00" "$6.00") + (cdr (sxml->table-row-col sxml 3 1 #f))) + (test-equal "inv-4 vend-name is correct" + '("emp-1-name" "emp-1-name") ;FIXME: why is this duplicated???? + ((sxpath '(// (table 2) // tbody // tr // td // *text*)) + sxml)) + (test-assert "inv-4 inv-notes is in invoice body" + (member + "inv-4-notes" + ((sxpath '(// body // *text*)) sxml)))) + (test-end "inv-4") + + (test-begin "inv-5 simple entry") + ;; entry-5 2 widgets of $3 = $6 + (let ((entry-5 (gncEntryCreate (gnc-get-current-book)))) + (gncEntrySetDateGDate entry-5 (time64-to-gdate (current-time))) + (gncEntrySetDescription entry-5 "entry-5-desc") + (gncEntrySetAction entry-5 "entry-5-action") + (gncEntrySetNotes entry-5 "entry-5-notes") + (gncEntrySetInvAccount entry-5 income) + (gncEntrySetDocQuantity entry-5 2 #t) + (gncEntrySetInvPrice entry-5 3) + (gncInvoiceAddEntry inv-5 entry-5)) + (let* ((options (default-testing-options inv-5)) + (sxml (options->sxml options "inv-5 simple entry"))) + (test-equal "inv-5 simple entry amounts are correct" + '("$6.00" "$6.00" "$6.00" "$6.00") + (sxml-main-get-row-col sxml #f -1)) + (test-equal "inv-5 simple entry details are correct" + '("entry-5-desc" "entry-5-action" "2.00" "$3.00" "0.00 %" "T" "$0.00" "$6.00") + (cdr (sxml-main-get-row-col sxml 1 #f))) + (test-equal "inv-5 cust-name is correct" + '("cust-1-name") + ((sxpath '(// (table 2) // tbody // tr // td // *text*)) + sxml))) + (test-end "inv-5 simple entry") + + (test-begin "inv-6") + (let ((entry-inv-6 (gncEntryCreate (gnc-get-current-book)))) + (gncEntrySetDateGDate entry-inv-6 (time64-to-gdate (current-time))) + (gncEntrySetDescription entry-inv-6 "entry-inv-6-desc") + (gncEntrySetAction entry-inv-6 "entry-inv-6-action") + (gncEntrySetNotes entry-inv-6 "entry-inv-6-notes") + (gncEntrySetInvAccount entry-inv-6 income) + (gncEntrySetDocQuantity entry-inv-6 2 #t) + (gncEntrySetBillPrice entry-inv-6 3) + (gncInvoiceAddEntry inv-6 entry-inv-6)) + (let* ((options (default-testing-options inv-6)) + (sxml (options->sxml options "inv-6 simple entry"))) + (test-equal "inv-6 simple entry amounts are correct" + '("$6.00" "$6.00" "$6.00" "$6.00") + (sxml-main-get-row-col sxml #f -1)) + (test-equal "inv-6 simple entry details are correct" + '("entry-inv-6-desc" "entry-inv-6-action" "2.00" "$3.00" "T" "$0.00" "$6.00") + (cdr (sxml-main-get-row-col sxml 1 #f))) + (test-equal "inv-6 vend-name is correct" + '("vend-1-name") + ((sxpath '(// (table 2) // tbody // tr // td // *text*)) + sxml)) + (test-assert "inv-6 inv-3-notes is in invoice body" + (member + "inv-3-notes" + ((sxpath '(// body // *text*)) sxml)))) + (test-end "inv-6") + + (test-begin "inv-7") + ;; entry-inv-7 2 widgets of $3 = $6 + (let ((entry-inv-7 (gncEntryCreate (gnc-get-current-book)))) + (gncEntrySetDateGDate entry-inv-7 (time64-to-gdate (current-time))) + (gncEntrySetDescription entry-inv-7 "entry-inv-7-desc") + (gncEntrySetAction entry-inv-7 "entry-inv-7-action") + (gncEntrySetNotes entry-inv-7 "entry-inv-7-notes") + (gncEntrySetInvAccount entry-inv-7 income) + (gncEntrySetDocQuantity entry-inv-7 2 #t) + (gncEntrySetBillPrice entry-inv-7 3) + (gncInvoiceAddEntry inv-7 entry-inv-7)) + (let* ((options (default-testing-options inv-7)) + (sxml (options->sxml options "inv-7 simple entry"))) + (test-equal "inv-7 simple entry amounts are correct" + '("$6.00" "$6.00" "$6.00" "$6.00") + (sxml-main-get-row-col sxml #f -1)) + (test-equal "inv-7 simple entry details are correct" + '("entry-inv-7-desc" "entry-inv-7-action" "2.00" "$3.00" "T" "$0.00" "$6.00") + (cdr (sxml-main-get-row-col sxml 1 #f))) + (test-equal "inv-7 vend-name is correct" + '("emp-1-name" "emp-1-name") ;FIXME: why is this duplicated???? + ((sxpath '(// (table 2) // tbody // tr // td // *text*)) + sxml)) + (test-assert "inv-7 inv-4-notes is in invoice body" + (member + "inv-4-notes" + ((sxpath '(// body // *text*)) sxml)))) + (test-end "inv-7") + + (test-begin "combinations of gncEntry options") + (let* ((inv-8 (gncInvoiceCreate (gnc-get-current-book))) + (taxrate 109/10) + (discount 7/2) + (unitprice 777/4) + (quantity 11) + (combo-vat-sales-tt (let ((tt (gncTaxTableCreate (gnc-get-current-book)))) + (gncTaxTableIncRef tt) + (gncTaxTableSetName tt (format #f "~a% vat on sales" taxrate)) + (let ((entry (gncTaxTableEntryCreate))) + (gncTaxTableEntrySetAccount entry vat-sales) + (gncTaxTableEntrySetType entry GNC-AMT-TYPE-PERCENT) + (gncTaxTableEntrySetAmount entry taxrate) + (gncTaxTableAddEntry tt entry)) + tt)) + (billterm (let ((term (gncBillTermCreate (gnc-get-current-book)))) + (gncBillTermSetName term "billterm-name") + (gncBillTermSetDescription term "billterm-desc") + (gncBillTermSetType term 1) ;1 = GNC-TERM-TYPE-DAYS + (gncBillTermSetDueDays term 8) + term))) + (gncInvoiceSetOwner inv-8 owner-1) + (gncInvoiceSetCurrency inv-8 (gnc-default-report-currency)) + (gncInvoiceSetTerms inv-8 billterm) + (for-each + (lambda (combo) + (let* ((each-entry (gncEntryCreate (gnc-get-current-book))) + (taxable? (= (vector-ref combo 0) 1)) + (tax-included? (= (vector-ref combo 1) 1)) + (discount-type (vector-ref combo 2)) + (discount-how (vector-ref combo 3)) + (desc (format #f "taxable=~a tax-included=~a discount-type=~a discount-how=~a" + (if taxable? "Y" "N") + (if tax-included? "Y" "N") + (gncAmountTypeToString discount-type) + (gncEntryDiscountHowToString discount-how)))) + (gncEntrySetDateGDate each-entry (time64-to-gdate (current-time))) + (gncEntrySetDescription each-entry desc) + (gncEntrySetAction each-entry "action") + (gncEntrySetInvAccount each-entry income) + (gncEntrySetDocQuantity each-entry quantity #f) + (gncEntrySetInvPrice each-entry unitprice) + (gncEntrySetInvDiscount each-entry discount) + (gncEntrySetInvDiscountType each-entry discount-type) + (gncEntrySetInvDiscountHow each-entry discount-how) + (gncEntrySetInvTaxable each-entry taxable?) + (gncEntrySetInvTaxIncluded each-entry tax-included?) + (gncEntrySetInvTaxTable each-entry combo-vat-sales-tt) + (gncInvoiceAddEntry inv-8 each-entry))) + (list + ;; the following list specifies combinations to test gncEntry options + ;; thanks to rgmerk and to jenny for idea how to generate list of options + ;; (vector Taxable?(1=#t) Tax-included?(1=#t) DiscountType DiscountHow) + (vector 1 2 1 1) + (vector 2 1 2 2) + (vector 1 1 2 3) + (vector 2 2 1 3) + (vector 2 1 1 1) + (vector 1 2 2 2) + (vector 1 2 1 2) + (vector 1 1 2 1))) + (gncInvoiceSetNotes inv-8 (format #f "tax=~a%, discount=~a, qty=~a, price=~a" taxrate discount quantity unitprice)) + + (gncInvoicePostToAccount inv-8 receivable (current-time) + (current-time) "trans-posting-memo" + #t #f) + + (gncInvoiceApplyPayment inv-8 '() bank 1747918/100 1 + (current-time) "trans-payment-memo-1" "trans-payment-num-1") + (let* ((options (default-testing-options inv-8)) + (sxml (options->sxml options "inv-8 combinatorics"))) + (test-assert "inv-8 billterm-desc is in invoice body" + (member + "Terms:\xa0billterm-desc" + ((sxpath '(// body // *text*)) sxml))) + (test-equal "inv-8 invoice date is in invoice body" + '("Invoice Date:\xa0") + (sxml->table-row-col sxml 2 1 1)) + (test-equal "inv-8 due date is in invoice body" + '("Due Date:\xa0") + (sxml->table-row-col sxml 2 2 1)) + (test-equal "inv-8 combo amounts are correct" + '("$2,133.25" "$2,061.96" "$2,133.25" "$2,061.96" "$2,133.25" "$2,133.25" + "$1,851.95" "$1,859.30" "$16,368.17" "$1,111.01" "$17,479.18" + "-$17,479.18" "$0.00") + (sxml->table-row-col sxml 4 #f -1)) + )) + (test-end "combinations of gncEntry options") + )) From 81303b4193dd9466af69a28cc299d3e672ca354b Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sun, 27 May 2018 17:18:06 +0800 Subject: [PATCH 5/8] [test-invoice] last test inv-8 is paid up Note there is a debugging display which unexpectedly causes test failure. Calling gncEntryGetDocValue for each entry, with any combination of booleans, would cause the amounts to change slightly. --- .../business-reports/test/test-invoice.scm | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/gnucash/report/business-reports/test/test-invoice.scm b/gnucash/report/business-reports/test/test-invoice.scm index 2f196b11ab..b60b03165d 100644 --- a/gnucash/report/business-reports/test/test-invoice.scm +++ b/gnucash/report/business-reports/test/test-invoice.scm @@ -493,6 +493,19 @@ (gncEntrySetInvTaxable each-entry taxable?) (gncEntrySetInvTaxIncluded each-entry tax-included?) (gncEntrySetInvTaxTable each-entry combo-vat-sales-tt) + ;; FIXME: Note: The following function hides a subtle + ;; bug. It aims to retrieve & dump the entry description + ;; and amount. Unfortunately the (gncEntryGetDocValue) + ;; function will subtly modify the entry amounts by a + ;; fraction; this means that the subsequent invoice payment + ;; will not make the invoice amount completely zero. If the + ;; following statement is uncommented, the invoice + ;; generated will not change, however, the test will fail + ;; because the (gncInvoiceIsPaid) final test will fail. + + ;; (format #t "inv-8: adding ~a to invoice, entry amount is ~a\n" + ;; desc + ;; (exact->inexact (gncEntryGetDocValue each-entry #f #t #f))) (gncInvoiceAddEntry inv-8 each-entry))) (list ;; the following list specifies combinations to test gncEntry options @@ -531,6 +544,6 @@ "$1,851.95" "$1,859.30" "$16,368.17" "$1,111.01" "$17,479.18" "-$17,479.18" "$0.00") (sxml->table-row-col sxml 4 #f -1)) - )) - (test-end "combinations of gncEntry options") - )) + (test-assert "inv-8 is fully paid up!" + (gncInvoiceIsPaid inv-8)))) + (test-end "combinations of gncEntry options"))) From bb37adc3ec86b803e56edc4072b2e1a019851c12 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sun, 27 May 2018 18:27:42 +0800 Subject: [PATCH 6/8] [test-invoice] also test easy-invoice --- .../business-reports/test/test-invoice.scm | 95 +++++++++++-------- 1 file changed, 58 insertions(+), 37 deletions(-) diff --git a/gnucash/report/business-reports/test/test-invoice.scm b/gnucash/report/business-reports/test/test-invoice.scm index b60b03165d..1c30a18425 100644 --- a/gnucash/report/business-reports/test/test-invoice.scm +++ b/gnucash/report/business-reports/test/test-invoice.scm @@ -39,7 +39,7 @@ (test-runner-factory gnc:test-runner) (test-begin "test-invoice.scm") (inv-tests 'invoice) - ;; (inv-tests 'easy-invoice) + (inv-tests 'easy-invoice) ;; (inv-tests 'fancy-invoice) (test-end "test-invoice.scm")) @@ -184,19 +184,34 @@ (gncTaxTableAddEntry tt entry)) tt))) - (define (default-testing-options inv) + (define* (default-testing-options inv #:optional (setting #t)) (let ((options (gnc:make-report-options uuid))) (set-option! options "General" "Invoice Number" inv) (for-each (lambda (disp-col-name) - (set-option! options "Display Columns" disp-col-name #t)) - '("Date" "Description" "Action" "Quantity" "Price" "Discount" - "Taxable" "Tax Amount" "Total")) + (set-option! options "Display Columns" disp-col-name setting)) + (case variant + ((invoice fancy-invoice) + '("Date" "Description" "Action" "Quantity" "Price" "Discount" + "Taxable" "Tax Amount" "Total")) + ((easy-invoice) + '("Date" "Description" "Charge Type" "Quantity" + "Price" "Discount" "Taxable" "Tax Amount" "Total")))) (for-each (lambda (disp-col-name) - (set-option! options "Display" disp-col-name #t)) - '("Individual Taxes" "Totals" "References" "Billing Terms" - "Billing ID" "Invoice Notes" "Payments" "Job Details")) + (set-option! options "Display" disp-col-name setting)) + (case variant + ((invoice) + '("Individual Taxes" "Totals" "References" "Billing Terms" + "Billing ID" "Invoice Notes" "Payments" "Job Details")) + ((fancy-invoice) + '("Individual Taxes" "Totals" "References" "Billing Terms" + "Billing ID" "Invoice Notes" "Payments")) + ((easy-invoice) + '("My Company" "My Company ID" "Due Date" + "Individual Taxes" "Totals" "Subtotal" "References" + "Billing Terms" "Billing ID" "Invoice Notes" + "Payments")))) options)) ;; entry-1 2 widgets of $3 = $6 @@ -225,7 +240,10 @@ sxml)) (test-assert "inv-1-billing-id is in invoice body" (member - "Reference:\xa0inv-1-billing-id" + (case variant + ((invoice) "Reference:\xa0inv-1-billing-id") + ((easy-invoice) "Billing ID:\xa0inv-1-billing-id") + (else "")) ((sxpath '(// body // *text*)) sxml))) (test-assert "inv-1 inv-notes is in invoice body" (member @@ -234,24 +252,17 @@ (test-end "inv-1 simple entry") (test-begin "inv-1 simple entry, sparse options") - (let* ((options (let ((options (default-testing-options inv-1))) - (for-each - (lambda (disp-col-name) - (set-option! options "Display Columns" disp-col-name #f)) - '("Date" "Description" "Action" "Quantity" "Price" "Discount" - "Taxable" "Tax Amount" "Total")) - (for-each - (lambda (disp-col-name) - (set-option! options "Display" disp-col-name #f)) - '("Individual Taxes" "Totals" "References" "Billing Terms" - "Billing ID" "Invoice Notes" "Payments" "Job Details")) - options)) + (let* ((options (default-testing-options inv-1 #f)) (sxml (options->sxml options "inv-1 simple entry sparse"))) (test-equal "inv-1 sparse simple entry headers are correct" - '("Net Price" "Tax" "Total Price" "Amount Due") + (case variant + ((invoice) '("Net Price" "Tax" "Total Price" "Amount Due")) + (else '("Tax" "Total Price" "Amount Due"))) (sxml-main-get-row-col sxml #f 1)) (test-equal "inv-1 sparse simple entry amounts are correct" - '("$6.00" "$0.00" "$6.00" "$6.00") + (case variant + ((invoice) '("$6.00" "$0.00" "$6.00" "$6.00")) + (else '("$0.00" "$6.00" "$6.00"))) (sxml-main-get-row-col sxml #f -1))) (test-end "inv-1 simple entry, sparse options") @@ -293,14 +304,15 @@ (member "inv-2-notes" ((sxpath '(// body // *text*)) sxml))) - (test-assert "inv-2 jobnumber is in invoice body" - (member - "Job number:\xa0job-1-id" - ((sxpath '(// body // *text*)) sxml))) - (test-assert "inv-2 jobname is in invoice body" - (member - "Job name:\xa0job-1-name" - ((sxpath '(// body // *text*)) sxml))) + (when (eq? variant 'invoice) + (test-assert "inv-2 jobnumber is in invoice body" + (member + "Job number:\xa0job-1-id" + ((sxpath '(// body // *text*)) sxml))) + (test-assert "inv-2 jobname is in invoice body" + (member + "Job name:\xa0job-1-name" + ((sxpath '(// body // *text*)) sxml)))) ) (test-end "inv-2") @@ -533,12 +545,21 @@ (member "Terms:\xa0billterm-desc" ((sxpath '(// body // *text*)) sxml))) - (test-equal "inv-8 invoice date is in invoice body" - '("Invoice Date:\xa0") - (sxml->table-row-col sxml 2 1 1)) - (test-equal "inv-8 due date is in invoice body" - '("Due Date:\xa0") - (sxml->table-row-col sxml 2 2 1)) + (case variant + ((invoice fancy-invoice) + (test-equal "inv-8 invoice date is in invoice body" + '("Invoice Date:\xa0") + (sxml->table-row-col sxml 2 1 1)) + (test-equal "inv-8 due date is in invoice body" + '("Due Date:\xa0") + (sxml->table-row-col sxml 2 2 1))) + (else + (test-equal "inv-8 invoice date is in invoice body" + '("Date:\xa0") + (sxml->table-row-col sxml 3 1 1)) + (test-equal "inv-8 invoice date is in invoice body" + '("Due:\xa0") + (sxml->table-row-col sxml 3 2 1)))) (test-equal "inv-8 combo amounts are correct" '("$2,133.25" "$2,061.96" "$2,133.25" "$2,061.96" "$2,133.25" "$2,133.25" "$1,851.95" "$1,859.30" "$16,368.17" "$1,111.01" "$17,479.18" From aa4dfb0ead04a0eb4b55e35becc9d429443336cc Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sun, 27 May 2018 20:48:32 +0800 Subject: [PATCH 7/8] [test-invoice] also test fancy-invoice --- .../business-reports/test/test-invoice.scm | 85 ++++++++++--------- 1 file changed, 47 insertions(+), 38 deletions(-) diff --git a/gnucash/report/business-reports/test/test-invoice.scm b/gnucash/report/business-reports/test/test-invoice.scm index 1c30a18425..8c4fa0ed06 100644 --- a/gnucash/report/business-reports/test/test-invoice.scm +++ b/gnucash/report/business-reports/test/test-invoice.scm @@ -40,7 +40,7 @@ (test-begin "test-invoice.scm") (inv-tests 'invoice) (inv-tests 'easy-invoice) - ;; (inv-tests 'fancy-invoice) + (inv-tests 'fancy-invoice) (test-end "test-invoice.scm")) (define (sxml-main-get-row-col sxml row col) @@ -234,16 +234,16 @@ (test-equal "inv-1 simple entry details are correct" '("entry-1-desc" "entry-1-action" "2.00" "$3.00" "0.00 %" "T" "$0.00" "$6.00") (cdr (sxml-main-get-row-col sxml 1 #f))) - (test-equal "inv-1 cust-name is correct" - '("cust-1-name") - ((sxpath '(// (table 2) // tbody // tr // td // *text*)) - sxml)) + (unless (eq? variant 'fancy-invoice) + (test-equal "inv-1 cust-name is correct" + '("cust-1-name") + ((sxpath '(// (table 2) // tbody // tr // td // *text*)) + sxml))) (test-assert "inv-1-billing-id is in invoice body" (member (case variant - ((invoice) "Reference:\xa0inv-1-billing-id") - ((easy-invoice) "Billing ID:\xa0inv-1-billing-id") - (else "")) + ((invoice fancy-invoice) "Reference:\xa0inv-1-billing-id") + ((easy-invoice) "Billing ID:\xa0inv-1-billing-id")) ((sxpath '(// body // *text*)) sxml))) (test-assert "inv-1 inv-notes is in invoice body" (member @@ -257,12 +257,13 @@ (test-equal "inv-1 sparse simple entry headers are correct" (case variant ((invoice) '("Net Price" "Tax" "Total Price" "Amount Due")) - (else '("Tax" "Total Price" "Amount Due"))) + ((fancy-invoice) '("Net Price" "Tax" "Total\xa0Price" "Amount\xa0Due")) + ((easy-invoice) '("Tax" "Total Price" "Amount Due"))) (sxml-main-get-row-col sxml #f 1)) (test-equal "inv-1 sparse simple entry amounts are correct" (case variant - ((invoice) '("$6.00" "$0.00" "$6.00" "$6.00")) - (else '("$0.00" "$6.00" "$6.00"))) + ((invoice fancy-invoice) '("$6.00" "$0.00" "$6.00" "$6.00")) + ((easy-invoice) '("$0.00" "$6.00" "$6.00"))) (sxml-main-get-row-col sxml #f -1))) (test-end "inv-1 simple entry, sparse options") @@ -296,10 +297,11 @@ (test-equal "inv-2 simple entry details are correct" '("entry-inv-2-desc" "entry-inv-2-action" "2.00" "$3.00" "0.00 %" "T" "$0.00" "$6.00") (cdr (sxml-main-get-row-col sxml 1 #f))) - (test-equal "inv-2 cust-name is correct" - '("cust-1-name") - ((sxpath '(// (table 2) // tbody // tr // td // *text*)) - sxml)) + (unless (eq? variant 'fancy-invoice) + (test-equal "inv-2 cust-name is correct" + '("cust-1-name") + ((sxpath '(// (table 2) // tbody // tr // td // *text*)) + sxml))) (test-assert "inv-2 inv-notes is in invoice body" (member "inv-2-notes" @@ -335,10 +337,11 @@ (test-equal "inv-3 simple entry details are correct" '("entry-inv-3-desc" "entry-inv-3-action" "2.00" "$3.00" "T" "$0.00" "$6.00") (cdr (sxml-main-get-row-col sxml 1 #f))) - (test-equal "inv-3 vend-name is correct" - '("vend-1-name") - ((sxpath '(// (table 2) // tbody // tr // td // *text*)) - sxml)) + (unless (eq? variant 'fancy-invoice) + (test-equal "inv-3 vend-name is correct" + '("vend-1-name") + ((sxpath '(// (table 2) // tbody // tr // td // *text*)) + sxml))) (test-assert "inv-3 inv-notes is in invoice body" (member "inv-3-notes" @@ -365,10 +368,11 @@ (test-equal "inv-4 simple entry details are correct" '("entry-inv-4-desc" "entry-inv-4-action" "2.00" "$3.00" "T" "$0.00" "$6.00") (cdr (sxml->table-row-col sxml 3 1 #f))) - (test-equal "inv-4 vend-name is correct" - '("emp-1-name" "emp-1-name") ;FIXME: why is this duplicated???? - ((sxpath '(// (table 2) // tbody // tr // td // *text*)) - sxml)) + (unless (eq? variant 'fancy-invoice) + (test-equal "inv-4 vend-name is correct" + '("emp-1-name" "emp-1-name") ;FIXME: why is this duplicated???? + ((sxpath '(// (table 2) // tbody // tr // td // *text*)) + sxml))) (test-assert "inv-4 inv-notes is in invoice body" (member "inv-4-notes" @@ -394,10 +398,11 @@ (test-equal "inv-5 simple entry details are correct" '("entry-5-desc" "entry-5-action" "2.00" "$3.00" "0.00 %" "T" "$0.00" "$6.00") (cdr (sxml-main-get-row-col sxml 1 #f))) - (test-equal "inv-5 cust-name is correct" - '("cust-1-name") - ((sxpath '(// (table 2) // tbody // tr // td // *text*)) - sxml))) + (unless (eq? variant 'fancy-invoice) + (test-equal "inv-5 cust-name is correct" + '("cust-1-name") + ((sxpath '(// (table 2) // tbody // tr // td // *text*)) + sxml)))) (test-end "inv-5 simple entry") (test-begin "inv-6") @@ -418,10 +423,11 @@ (test-equal "inv-6 simple entry details are correct" '("entry-inv-6-desc" "entry-inv-6-action" "2.00" "$3.00" "T" "$0.00" "$6.00") (cdr (sxml-main-get-row-col sxml 1 #f))) - (test-equal "inv-6 vend-name is correct" - '("vend-1-name") - ((sxpath '(// (table 2) // tbody // tr // td // *text*)) - sxml)) + (unless (eq? variant 'fancy-invoice) + (test-equal "inv-6 vend-name is correct" + '("vend-1-name") + ((sxpath '(// (table 2) // tbody // tr // td // *text*)) + sxml))) (test-assert "inv-6 inv-3-notes is in invoice body" (member "inv-3-notes" @@ -447,10 +453,11 @@ (test-equal "inv-7 simple entry details are correct" '("entry-inv-7-desc" "entry-inv-7-action" "2.00" "$3.00" "T" "$0.00" "$6.00") (cdr (sxml-main-get-row-col sxml 1 #f))) - (test-equal "inv-7 vend-name is correct" - '("emp-1-name" "emp-1-name") ;FIXME: why is this duplicated???? - ((sxpath '(// (table 2) // tbody // tr // td // *text*)) - sxml)) + (unless (eq? variant 'fancy-invoice) + (test-equal "inv-7 vend-name is correct" + '("emp-1-name" "emp-1-name") ;FIXME: why is this duplicated???? + ((sxpath '(// (table 2) // tbody // tr // td // *text*)) + sxml))) (test-assert "inv-7 inv-4-notes is in invoice body" (member "inv-4-notes" @@ -546,14 +553,14 @@ "Terms:\xa0billterm-desc" ((sxpath '(// body // *text*)) sxml))) (case variant - ((invoice fancy-invoice) + ((invoice) (test-equal "inv-8 invoice date is in invoice body" '("Invoice Date:\xa0") (sxml->table-row-col sxml 2 1 1)) (test-equal "inv-8 due date is in invoice body" '("Due Date:\xa0") (sxml->table-row-col sxml 2 2 1))) - (else + ((easy-invoice) (test-equal "inv-8 invoice date is in invoice body" '("Date:\xa0") (sxml->table-row-col sxml 3 1 1)) @@ -564,7 +571,9 @@ '("$2,133.25" "$2,061.96" "$2,133.25" "$2,061.96" "$2,133.25" "$2,133.25" "$1,851.95" "$1,859.30" "$16,368.17" "$1,111.01" "$17,479.18" "-$17,479.18" "$0.00") - (sxml->table-row-col sxml 4 #f -1)) + (if (eq? variant 'fancy-invoice) + (sxml->table-row-col sxml 3 #f -1) + (sxml->table-row-col sxml 4 #f -1))) (test-assert "inv-8 is fully paid up!" (gncInvoiceIsPaid inv-8)))) (test-end "combinations of gncEntry options"))) From e4407dee9b4f0bfe8a75e7415c7ddeb60a98a60f Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sat, 2 Jun 2018 22:51:29 +0800 Subject: [PATCH 8/8] [test-invoice] add gncOrder display and testing --- gnucash/report/business-reports/test/test-invoice.scm | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/gnucash/report/business-reports/test/test-invoice.scm b/gnucash/report/business-reports/test/test-invoice.scm index 8c4fa0ed06..3db7c4a864 100644 --- a/gnucash/report/business-reports/test/test-invoice.scm +++ b/gnucash/report/business-reports/test/test-invoice.scm @@ -479,6 +479,12 @@ (gncTaxTableEntrySetAmount entry taxrate) (gncTaxTableAddEntry tt entry)) tt)) + (order (let ((order (gncOrderCreate (gnc-get-current-book)))) + (gncOrderSetID order "order-id") + (gncOrderSetOwner order owner-1) + (gncOrderSetReference order "order-ref") + (gncOrderSetActive order #t) + order)) (billterm (let ((term (gncBillTermCreate (gnc-get-current-book)))) (gncBillTermSetName term "billterm-name") (gncBillTermSetDescription term "billterm-desc") @@ -525,6 +531,7 @@ ;; (format #t "inv-8: adding ~a to invoice, entry amount is ~a\n" ;; desc ;; (exact->inexact (gncEntryGetDocValue each-entry #f #t #f))) + (gncOrderAddEntry order each-entry) (gncInvoiceAddEntry inv-8 each-entry))) (list ;; the following list specifies combinations to test gncEntry options @@ -552,6 +559,10 @@ (member "Terms:\xa0billterm-desc" ((sxpath '(// body // *text*)) sxml))) + (test-assert "inv-8 gncOrder reference is in invoice body" + (member + "REF:\xa0order-ref" + ((sxpath '(// body // *text*)) sxml))) (case variant ((invoice) (test-equal "inv-8 invoice date is in invoice body"