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