[test-invoice] modified to call (create-test-invoice-data)

test-invoice will call (create-business-test-data) to create the 8
sample invoices as previously generated.
This commit is contained in:
Christopher Lam 2019-07-22 21:24:28 +08:00
parent 681e023cd5
commit 54c0765044

View File

@ -84,110 +84,15 @@
(vat-purchases (cdr (assoc "VAT-on-Purchases" account-alist))) (vat-purchases (cdr (assoc "VAT-on-Purchases" account-alist)))
(receivable (cdr (assoc "A/Receivable" account-alist))) (receivable (cdr (assoc "A/Receivable" account-alist)))
(YEAR (gnc:time64-get-year (gnc:get-today))) (YEAR (gnc:time64-get-year (gnc:get-today)))
(invoices (create-test-invoice-data))
(cust-1 (let ((cust-1 (gncCustomerCreate (gnc-get-current-book)))) (inv-1 (vector-ref invoices 0))
(gncCustomerSetID cust-1 "cust-1-id") (inv-2 (vector-ref invoices 1))
(gncCustomerSetName cust-1 "cust-1-name") (inv-3 (vector-ref invoices 2))
(gncCustomerSetNotes cust-1 "cust-1-notes") (inv-4 (vector-ref invoices 3))
(gncCustomerSetCurrency cust-1 (gnc-default-report-currency)) (inv-5 (vector-ref invoices 4))
(gncCustomerSetTaxIncluded cust-1 1) ;1 = GNC-TAXINCLUDED-YES (inv-6 (vector-ref invoices 5))
cust-1)) (inv-7 (vector-ref invoices 6))
(inv-8 (vector-ref invoices 7)))
(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 #:optional (setting #t)) (define* (default-testing-options inv #:optional (setting #t))
(let ((options (gnc:make-report-options uuid))) (let ((options (gnc:make-report-options uuid)))
@ -206,17 +111,6 @@
"Payments" "Job Details")) "Payments" "Job Details"))
options)) 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") (test-begin "inv-1 simple entry")
(let* ((options (default-testing-options inv-1)) (let* ((options (default-testing-options inv-1))
(sxml (options->sxml options "inv-1 simple entry"))) (sxml (options->sxml options "inv-1 simple entry")))
@ -251,27 +145,6 @@
(test-end "inv-1 simple entry, sparse options") (test-end "inv-1 simple entry, sparse options")
(test-begin "inv-2") (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)) (let* ((options (default-testing-options inv-2))
(sxml (options->sxml options "inv-2 simple entry"))) (sxml (options->sxml options "inv-2 simple entry")))
(test-equal "inv-2 simple entry amounts are correct" (test-equal "inv-2 simple entry amounts are correct"
@ -298,16 +171,6 @@
(test-end "inv-2") (test-end "inv-2")
(test-begin "inv-3") (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)) (let* ((options (default-testing-options inv-3))
(sxml (options->sxml options "inv-3 simple entry"))) (sxml (options->sxml options "inv-3 simple entry")))
(test-equal "inv-3 simple entry amounts are correct" (test-equal "inv-3 simple entry amounts are correct"
@ -325,18 +188,7 @@
((sxpath '(// body // *text*)) sxml)))) ((sxpath '(// body // *text*)) sxml))))
(test-end "inv-3") (test-end "inv-3")
(test-begin "inv-4") (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)) (let* ((options (default-testing-options inv-4))
(sxml (options->sxml options "inv-4 simple entry"))) (sxml (options->sxml options "inv-4 simple entry")))
(test-equal "inv-4 simple entry amounts are correct" (test-equal "inv-4 simple entry amounts are correct"
@ -355,16 +207,6 @@
(test-end "inv-4") (test-end "inv-4")
(test-begin "inv-5 simple entry") (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)) (let* ((options (default-testing-options inv-5))
(sxml (options->sxml options "inv-5 simple entry"))) (sxml (options->sxml options "inv-5 simple entry")))
(test-equal "inv-5 simple entry amounts are correct" (test-equal "inv-5 simple entry amounts are correct"
@ -379,15 +221,6 @@
(test-end "inv-5 simple entry") (test-end "inv-5 simple entry")
(test-begin "inv-6") (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)) (let* ((options (default-testing-options inv-6))
(sxml (options->sxml options "inv-6 simple entry"))) (sxml (options->sxml options "inv-6 simple entry")))
(test-equal "inv-6 simple entry amounts are correct" (test-equal "inv-6 simple entry amounts are correct"
@ -406,16 +239,6 @@
(test-end "inv-6") (test-end "inv-6")
(test-begin "inv-7") (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)) (let* ((options (default-testing-options inv-7))
(sxml (options->sxml options "inv-7 simple entry"))) (sxml (options->sxml options "inv-7 simple entry")))
(test-equal "inv-7 simple entry amounts are correct" (test-equal "inv-7 simple entry amounts are correct"
@ -434,94 +257,6 @@
(test-end "inv-7") (test-end "inv-7")
(test-begin "combinations of gncEntry options") (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))
(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")
(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)
;; 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)))
(gncOrderAddEntry order each-entry)
(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)) (let* ((options (default-testing-options inv-8))
(sxml (options->sxml options "inv-8 combinatorics"))) (sxml (options->sxml options "inv-8 combinatorics")))
(test-assert "inv-8 billterm-desc is in invoice body" (test-assert "inv-8 billterm-desc is in invoice body"
@ -544,5 +279,5 @@
"-$17,479.18" "$0.00") "-$17,479.18" "$0.00")
(sxml-get-row-col "entries-table" sxml #f -1)) (sxml-get-row-col "entries-table" sxml #f -1))
(test-assert "inv-8 is fully paid up!" (test-assert "inv-8 is fully paid up!"
(gncInvoiceIsPaid inv-8)))) (gncInvoiceIsPaid inv-8)))
(test-end "combinations of gncEntry options"))) (test-end "combinations of gncEntry options")))