mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
[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
parent
681e023cd5
commit
54c0765044
@ -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)))
|
||||||
@ -196,7 +101,7 @@
|
|||||||
(lambda (disp-col-name)
|
(lambda (disp-col-name)
|
||||||
(set-option! options "Display Columns" disp-col-name setting))
|
(set-option! options "Display Columns" disp-col-name setting))
|
||||||
'("Date" "Description" "Action" "Quantity" "Price" "Discount"
|
'("Date" "Description" "Action" "Quantity" "Price" "Discount"
|
||||||
"Taxable" "Tax Amount" "Total"))
|
"Taxable" "Tax Amount" "Total"))
|
||||||
(for-each
|
(for-each
|
||||||
(lambda (disp-col-name)
|
(lambda (disp-col-name)
|
||||||
(set-option! options "Display" disp-col-name setting))
|
(set-option! options "Display" disp-col-name setting))
|
||||||
@ -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,115 +257,27 @@
|
|||||||
(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)))
|
(let* ((options (default-testing-options inv-8))
|
||||||
(taxrate 109/10)
|
(sxml (options->sxml options "inv-8 combinatorics")))
|
||||||
(discount 7/2)
|
(test-assert "inv-8 billterm-desc is in invoice body"
|
||||||
(unitprice 777/4)
|
(member
|
||||||
(quantity 11)
|
"billterm-desc"
|
||||||
(combo-vat-sales-tt (let ((tt (gncTaxTableCreate (gnc-get-current-book))))
|
((sxpath '(// body // *text*)) sxml)))
|
||||||
(gncTaxTableIncRef tt)
|
(test-assert "inv-8 gncOrder reference is in invoice body"
|
||||||
(gncTaxTableSetName tt (format #f "~a% vat on sales" taxrate))
|
(member
|
||||||
(let ((entry (gncTaxTableEntryCreate)))
|
"REF order-ref"
|
||||||
(gncTaxTableEntrySetAccount entry vat-sales)
|
((sxpath '(// body // *text*)) sxml)))
|
||||||
(gncTaxTableEntrySetType entry GNC-AMT-TYPE-PERCENT)
|
(test-equal "inv-8 invoice date is in invoice body"
|
||||||
(gncTaxTableEntrySetAmount entry taxrate)
|
'("Date:")
|
||||||
(gncTaxTableAddEntry tt entry))
|
(sxml-get-row-col "invoice-details-table" sxml 1 1))
|
||||||
tt))
|
(test-equal "inv-8 due date is in invoice body"
|
||||||
(order (let ((order (gncOrderCreate (gnc-get-current-book))))
|
'("Due Date:")
|
||||||
(gncOrderSetID order "order-id")
|
(sxml-get-row-col "invoice-details-table" sxml 2 1))
|
||||||
(gncOrderSetOwner order owner-1)
|
(test-equal "inv-8 combo amounts are correct"
|
||||||
(gncOrderSetReference order "order-ref")
|
'("$2,133.25" "$2,061.96" "$2,133.25" "$2,061.96" "$2,133.25" "$2,133.25"
|
||||||
(gncOrderSetActive order #t)
|
"$1,851.95" "$1,859.30" "$16,368.17" "$1,111.01" "$17,479.18"
|
||||||
order))
|
"-$17,479.18" "$0.00")
|
||||||
(billterm (let ((term (gncBillTermCreate (gnc-get-current-book))))
|
(sxml-get-row-col "entries-table" sxml #f -1))
|
||||||
(gncBillTermSetName term "billterm-name")
|
(test-assert "inv-8 is fully paid up!"
|
||||||
(gncBillTermSetDescription term "billterm-desc")
|
(gncInvoiceIsPaid inv-8)))
|
||||||
(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))
|
|
||||||
(sxml (options->sxml options "inv-8 combinatorics")))
|
|
||||||
(test-assert "inv-8 billterm-desc is in invoice body"
|
|
||||||
(member
|
|
||||||
"billterm-desc"
|
|
||||||
((sxpath '(// body // *text*)) sxml)))
|
|
||||||
(test-assert "inv-8 gncOrder reference is in invoice body"
|
|
||||||
(member
|
|
||||||
"REF order-ref"
|
|
||||||
((sxpath '(// body // *text*)) sxml)))
|
|
||||||
(test-equal "inv-8 invoice date is in invoice body"
|
|
||||||
'("Date:")
|
|
||||||
(sxml-get-row-col "invoice-details-table" sxml 1 1))
|
|
||||||
(test-equal "inv-8 due date is in invoice body"
|
|
||||||
'("Due Date:")
|
|
||||||
(sxml-get-row-col "invoice-details-table" sxml 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-get-row-col "entries-table" sxml #f -1))
|
|
||||||
(test-assert "inv-8 is fully paid up!"
|
|
||||||
(gncInvoiceIsPaid inv-8))))
|
|
||||||
(test-end "combinations of gncEntry options")))
|
(test-end "combinations of gncEntry options")))
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user