1; Part of Scheme 48 1.9.  See file COPYING for notices and license.
2
3; Authors: Marcus Crestani
4
5;;; Test suite for SRFI-95
6
7(define-test-suite srfi-95-tests)
8
9(define list-unsorted (list 2 32 42 23 1 2 74 3 65))
10(define list-sorted (list 1 2 2 3 23 32 42 65 74))
11(define list-sorted-1 (list 32 42 65 74))
12(define list-sorted-2 (list 1 2 2 3 23))
13(define list-< <)
14
15(define vector-unsorted (list->vector list-unsorted))
16(define vector-sorted (list->vector list-sorted))
17(define vector-sorted-1 (list->vector list-sorted-1))
18(define vector-sorted-2 (list->vector list-sorted-2))
19(define vector-< <)
20
21(define array-unsorted (list->array 1 '#() list-unsorted))
22(define array-sorted (list->array 1 '#() list-sorted))
23(define array-< <)
24
25(define-test-case sorted? srfi-95-tests
26  (check (sorted? list-sorted list-<))
27  (check (not (sorted? list-unsorted list-<)))
28  (check (sorted? vector-sorted vector-<))
29  (check (not (sorted? vector-unsorted vector-<)))
30  (check (sorted? array-sorted array-<))
31  (check (not (sorted? array-unsorted array-<))))
32
33(define-test-case sort srfi-95-tests
34  (check (sort list-sorted list-<) => list-sorted)
35  (check (sort list-unsorted list-<) => list-sorted)
36  (check (sort vector-sorted vector-<) => vector-sorted)
37  (check (sort vector-unsorted vector-<) => vector-sorted)
38  (check (array->vector (sort array-sorted array-<))
39	 => (array->vector array-sorted))
40  (check (array->vector (sort array-unsorted array-<))
41	 => (array->vector array-sorted)))
42
43(define-test-case sort! srfi-95-tests
44  (check (sort! list-sorted list-<) => list-sorted)
45  (check (sort! list-unsorted list-<) => list-sorted)
46  (check (sort! vector-sorted vector-<) => vector-sorted)
47  (check (sort! vector-unsorted vector-<) => vector-sorted)
48  (check (array->vector (sort! array-sorted array-<))
49	 => (array->vector array-sorted))
50  (check (array->vector (sort! array-unsorted array-<))
51	 => (array->vector array-sorted)))
52
53(define-test-case merge srfi-95-tests
54  (check (merge list-sorted-1 list-sorted-2 list-<) => list-sorted)
55  (check (merge list-sorted-2 list-sorted-1 list-<) => list-sorted)
56  (check (merge vector-sorted-1 vector-sorted-2 vector-<) => vector-sorted)
57  (check (merge vector-sorted-2 vector-sorted-1 vector-<) => vector-sorted))
58
59(define-test-case merge! srfi-95-tests
60  (check (merge! list-sorted-1 list-sorted-2 list-<) => list-sorted)
61  (check (merge! vector-sorted-1 vector-sorted-2 vector-<) => vector-sorted))
62