mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
273ae720cc
this can be used instead of delete-duplicates when the list must also be sorted. the main reason for this function will be for the upcoming aging.scm report which will use it heavily to slice APAR splits into owner list.
90 lines
3.0 KiB
Scheme
90 lines
3.0 KiB
Scheme
(use-modules (gnucash gnc-module))
|
|
(gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
|
|
(use-modules (gnucash utilities))
|
|
(use-modules (srfi srfi-64))
|
|
(use-modules (gnucash engine test srfi64-extras))
|
|
|
|
(define (run-test)
|
|
(test-runner-factory gnc:test-runner)
|
|
(test-begin "test-libgnucash-scm-utilities.scm")
|
|
(test-traverse-vec)
|
|
(test-substring-replace)
|
|
(test-sort-and-delete-duplicates)
|
|
(test-begin "test-libgnucash-scm-utilities.scm"))
|
|
|
|
(define (test-traverse-vec)
|
|
(test-begin "traverse-vec")
|
|
(test-equal "list->vec"
|
|
(vector 1 (vector 2 3))
|
|
(traverse-list->vec
|
|
(list 1 (list 2 3))))
|
|
(test-equal "vec->list"
|
|
(list 1 (list 2 3))
|
|
(traverse-vec->list
|
|
(vector 1 (vector 2 3))))
|
|
(test-end "traverse-vec"))
|
|
|
|
(define (test-substring-replace)
|
|
(test-begin "substring-replace")
|
|
|
|
;; generic gnc:substring-replace used in qif-guess-map.scm
|
|
(test-equal "gnc:substring-replace"
|
|
"fooxyzfooxyz"
|
|
(gnc:substring-replace "foobarfoobar" "bar" "xyz"))
|
|
|
|
;; note the following 2 tests illustrate code behaviour: start from
|
|
;; 2nd matched substring, and perform either 2 or 1 substitution.
|
|
(test-equal "gnc:substring-replace-from-to ... ... 2 2"
|
|
"foobarfooxyzfooxyz"
|
|
(gnc:substring-replace-from-to "foobarfoobarfoobar" "bar" "xyz" 2 2))
|
|
|
|
(test-equal "gnc:substring-replace-from-to ... ... 2 1"
|
|
"foobarfooxyzfoobar"
|
|
(gnc:substring-replace-from-to "foobarfoobarfoobar" "bar" "xyz" 2 1))
|
|
|
|
;; comprehensive test suite for gnc:substring-replace-from-to:
|
|
(test-equal "gnc:substring-replace-from-to ... ... 2 1"
|
|
"foo xxx foo foo foo foo foo foo"
|
|
(gnc:substring-replace-from-to
|
|
"foo foo foo foo foo foo foo foo"
|
|
"foo" "xxx" 2 1))
|
|
|
|
(test-equal "gnc:substring-replace-from-to ... ... 1 1"
|
|
"xxx foo foo foo foo foo foo foo"
|
|
(gnc:substring-replace-from-to
|
|
"foo foo foo foo foo foo foo foo"
|
|
"foo" "xxx" 1 1))
|
|
|
|
(test-equal "gnc:substring-replace-from-to ... ... 4 -1"
|
|
"foo foo foo xxx xxx xxx xxx xxx"
|
|
(gnc:substring-replace-from-to
|
|
"foo foo foo foo foo foo foo foo"
|
|
"foo" "xxx" 4 -1))
|
|
|
|
(test-end "substring-replace"))
|
|
|
|
(define (test-sort-and-delete-duplicates)
|
|
(test-begin "sort-and-delete-duplicates")
|
|
(test-equal "sort-and-delete-duplicates empty"
|
|
'()
|
|
(sort-and-delete-duplicates '() <))
|
|
(test-equal "sort-and-delete-duplicates 1-element"
|
|
'(1)
|
|
(sort-and-delete-duplicates '(1) <))
|
|
(test-equal "sort-and-delete-duplicates 2-element, equal"
|
|
'(1)
|
|
(sort-and-delete-duplicates '(1 1) <))
|
|
(test-equal "sort-and-delete-duplicates 2-element, unequal"
|
|
'(1 2)
|
|
(sort-and-delete-duplicates '(2 1) <))
|
|
(test-equal "sort-and-delete-duplicates 3-element, equal"
|
|
'(1)
|
|
(sort-and-delete-duplicates '(1 1 1) <))
|
|
(test-equal "sort-and-delete-duplicates 3-element, 2-equal"
|
|
'(1 2)
|
|
(sort-and-delete-duplicates '(1 2 1) <))
|
|
(test-equal "sort-and-delete-duplicates 3-element, unequal"
|
|
'(1 2 3)
|
|
(sort-and-delete-duplicates '(3 1 2) <))
|
|
(test-end "sort-and-delete-duplicates"))
|