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