106 lines
3.8 KiB
Scheme
106 lines
3.8 KiB
Scheme
#!r6rs
|
|
|
|
(library (tests r6rs enums)
|
|
(export run-enums-tests)
|
|
(import (rnrs)
|
|
(tests r6rs test))
|
|
|
|
;; ----------------------------------------
|
|
|
|
(define-enumeration color
|
|
(black white purple maroon)
|
|
color-set)
|
|
|
|
;; ----------------------------------------
|
|
|
|
(define (run-enums-tests)
|
|
|
|
(test (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))
|
|
|
|
(let* ((e (make-enumeration '(red green blue)))
|
|
(r ((enum-set-constructor e) '(red))))
|
|
(test (enum-set->list (enum-set-universe e))
|
|
'(red green blue))
|
|
(test (enum-set->list (enum-set-universe r))
|
|
'(red green blue))
|
|
(test ((enum-set-indexer
|
|
((enum-set-constructor e) '(red)))
|
|
'green)
|
|
1)
|
|
(test (enum-set-member? 'red e) #t)
|
|
(test (enum-set-member? 'black e) #f)
|
|
(test (enum-set-subset? e e) #t)
|
|
(test (enum-set-subset? r e) #t)
|
|
(test (enum-set-subset? e r) #f)
|
|
(test (enum-set-subset? e (make-enumeration '(blue green red))) #t)
|
|
(test (enum-set-subset? e (make-enumeration '(blue green red black))) #t)
|
|
(test (enum-set-subset? (make-enumeration '(blue green red black)) e) #f)
|
|
(test (enum-set-subset? ((enum-set-constructor
|
|
(make-enumeration '(blue green red black)))
|
|
'(red))
|
|
e) #f)
|
|
(test (enum-set-subset? ((enum-set-constructor
|
|
(make-enumeration '(green red)))
|
|
'(red))
|
|
e) #t)
|
|
(test (enum-set=? e e) #t)
|
|
(test (enum-set=? r e) #f)
|
|
(test (enum-set=? e r) #f)
|
|
(test (enum-set=? e (make-enumeration '(blue green red))) #t))
|
|
|
|
(test (let* ((e (make-enumeration '(red green blue)))
|
|
(c (enum-set-constructor e)))
|
|
(list
|
|
(enum-set-member? 'blue (c '(red blue)))
|
|
(enum-set-member? 'green (c '(red blue)))
|
|
(enum-set-subset? (c '(red blue)) e)
|
|
(enum-set-subset? (c '(red blue)) (c '(blue red)))
|
|
(enum-set-subset? (c '(red blue)) (c '(red)))
|
|
(enum-set=? (c '(red blue)) (c '(blue red)))))
|
|
(list #t #f #t #t #f #t))
|
|
|
|
(test (let* ((e (make-enumeration '(red green blue)))
|
|
(c (enum-set-constructor e)))
|
|
(enum-set->list (c '(blue red))))
|
|
'(red blue))
|
|
|
|
(test (let* ((e (make-enumeration '(red green blue)))
|
|
(c (enum-set-constructor e)))
|
|
(list (enum-set->list
|
|
(enum-set-union (c '(blue)) (c '(red))))
|
|
(enum-set->list
|
|
(enum-set-intersection (c '(red green))
|
|
(c '(red blue))))
|
|
(enum-set->list
|
|
(enum-set-difference (c '(red green))
|
|
(c '(red blue))))))
|
|
'((red blue) (red) (green)))
|
|
|
|
(test (let* ((e (make-enumeration '(red green blue)))
|
|
(c (enum-set-constructor e)))
|
|
(enum-set->list
|
|
(enum-set-complement (c '(red)))))
|
|
'(green blue))
|
|
|
|
(test (let ((e1 (make-enumeration
|
|
'(red green blue black)))
|
|
(e2 (make-enumeration
|
|
'(red black white))))
|
|
(enum-set->list
|
|
(enum-set-projection e1 e2)))
|
|
'(red black))
|
|
|
|
(test (color black) 'black)
|
|
; (test/exn (color purpel) &syntax) ; not a runtime exception
|
|
(test (enum-set->list (color-set)) '())
|
|
(test (enum-set->list
|
|
(color-set maroon white))
|
|
'(white maroon))
|
|
|
|
;;
|
|
))
|
|
|