/usr/share/scheme48-1.9/r6rs/enum-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 62 63 64 65 66 67 | ; Part of Scheme 48 1.9. See file COPYING for notices and license.
; Authors: Mike Sperber
(define-test-suite r6rs-enums-tests)
;; These are all from the R6RS document
(define-test-case enum-set-indexer r6rs-enums-tests
(check
(let* ((e (make-enumeration '(red green blue)))
(i (enum-set-indexer e)))
(list (i 'red) (i 'green) (i 'blue) (i 'yellow)))
=> '(0 1 2 #f)))
(define-test-case enum-set->list r6rs-enums-tests
(check
(let* ((e (make-enumeration '(red green blue)))
(c (enum-set-constructor e)))
(enum-set->list (c '(blue red))))
=> '(red blue)))
(define-test-case enum-set-tests r6rs-enums-tests
(let* ((e (make-enumeration '(red green blue)))
(c (enum-set-constructor e)))
(check (enum-set-member? 'blue (c '(red blue))))
(check (not (enum-set-member? 'green (c '(red blue)))))
(check (enum-set-subset? (c '(red blue)) e))
(check (enum-set-subset? (c '(red blue)) (c '(blue red))))
(check (not (enum-set-subset? (c '(red blue)) (c '(red)))))
(check (enum-set=? (c '(red blue)) (c '(blue red))))))
(define-test-case enum-set-logical r6rs-enums-tests
(let* ((e (make-enumeration '(red green blue)))
(c (enum-set-constructor e)))
(check (enum-set->list
(enum-set-union (c '(blue)) (c '(red))))
=> '(red blue))
(check (enum-set->list
(enum-set-intersection (c '(red green))
(c '(red blue))))
=> '(red))
(check (enum-set->list
(enum-set-difference (c '(red green))
(c '(red blue))))
=> '(green))))
(define-test-case enum-set-projection r6rs-enums-tests
(check
(let ((e1 (make-enumeration
'(red green blue black)))
(e2 (make-enumeration
'(red black white))))
(enum-set->list
(enum-set-projection e1 e2)))
=> '(red black)))
(define-enumeration color
(black white purple maroon)
color-set)
(define-test-case define-enumeration r6rs-enums-tests
(check (color black) => 'black)
(check (enum-set->list (color-set)) => '())
(check (enum-set->list
(color-set maroon white))
=> '(white maroon)))
|