-
Notifications
You must be signed in to change notification settings - Fork 4
/
enumeration-test.ss
160 lines (134 loc) · 6.55 KB
/
enumeration-test.ss
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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
#lang scheme/base
(require "enumeration.ss"
"test-base.ss")
; Helpers ----------------------------------------
(define-enum vehicle
(car boat plane))
(define-enum number
([one 1 "one"]
[two 2 "two"]
[three 3 "three"]))
(define-enum option
([a 1 "item 1"]
[b 2 "item 2"]
[c 3 "item 3"]))
(define-struct struct (val) #:transparent)
(define-enum structs
([one (make-struct 'a) "one"]
[two (make-struct 'b) "two"]
[three (make-struct 'c) "three"]))
(define-enum underscores
([a _ "one"]
[b _ "two"]
[c _ "three"]))
(define-enum titles
([mr "Mr"]
[mrs "Mrs"]
[miss "Miss"])
#:equality-test equal?)
; Tests ------------------------------------------
(define/provide-test-suite enumeration-tests
(test-case "vehicle"
(check-pred enum? vehicle)
(check-equal? (enum-values vehicle) '(car boat plane))
(check-equal? (enum-pretty-values vehicle) '("car" "boat" "plane"))
(check-equal? (enum->string vehicle) "car, boat, plane")
(check-equal? (enum->pretty-string vehicle) "car, boat, plane")
(check-equal? (vehicle car) 'car)
(check-equal? (vehicle boat) 'boat)
(check-equal? (vehicle plane) 'plane)
(check-equal? (enum-list vehicle boat plane) '(boat plane))
(check-equal? (enum-complement vehicle boat plane) '(car))
(check-true (enum-value? vehicle 'car))
(check-true (enum-value? vehicle 'boat))
(check-true (enum-value? vehicle 'plane))
(check-false (enum-value? vehicle 'lemon)))
(test-case "option"
(check-pred enum? option)
(check-equal? (enum-values option) '(1 2 3))
(check-equal? (enum-pretty-values option) '("item 1" "item 2" "item 3"))
(check-equal? (enum->string option) "1, 2, 3")
(check-equal? (enum->pretty-string option) "item 1, item 2, item 3")
(check-equal? (option a) 1)
(check-equal? (option b) 2)
(check-equal? (option c) 3)
(check-true (enum-value? option 1))
(check-true (enum-value? option 2))
(check-true (enum-value? option 3))
(check-false (enum-value? option 'a))
(check-false (enum-value? option 'b))
(check-false (enum-value? option 'c)))
(test-case "title"
(check-pred enum? titles)
(check-equal? (enum-values titles) '("Mr" "Mrs" "Miss"))
(check-equal? (enum-pretty-values titles) '("mr" "mrs" "miss"))
(check-equal? (enum->string titles) "Mr, Mrs, Miss")
(check-equal? (enum->pretty-string titles) "mr, mrs, miss")
(check-equal? (titles mr) "Mr")
(check-equal? (titles mrs) "Mrs")
(check-equal? (titles miss) "Miss")
(check-true (enum-value? titles "Mr"))
(check-true (enum-value? titles "Mrs"))
(check-true (enum-value? titles "Miss"))
(check-false (enum-value? titles 'Mr))
(check-false (enum-value? titles "mrs")))
(test-case "structs"
(check-true (enum-value? structs (structs one)))
(check-false (enum-value? structs (make-struct 'a))))
(test-case "underscores"
(check-equal? (enum-list underscores a b c) '(a b c))
(check-equal? (enum-complement underscores a b c) null)
(check-equal? (enum-prettify underscores (underscores a)) "one"))
(test-case "enum-value+false?"
(check-true (enum-value? vehicle (vehicle car)))
(check-false (enum-value? vehicle #f))
(check-true (enum-value+false? vehicle (vehicle car)))
(check-true (enum-value+false? vehicle #f))
(check-true (enum-value+false? titles "Mr"))
(check-false (enum-value+false? titles 'Mr)))
(test-case "enum->[pretty-]string with separator specified"
(check-equal? (enum->string vehicle ":") "car:boat:plane")
(check-equal? (enum->pretty-string vehicle ":") "car:boat:plane")
(check-equal? (enum->string titles ":") "Mr:Mrs:Miss")
(check-equal? (enum->pretty-string titles ":") "mr:mrs:miss"))
(test-case "enum-case"
(check-equal? (enum-case option 1 [(a) 10 100] [(b) 20 200] [(c) 30 300]) 100)
(check-equal? (enum-case option 2 [(a) 10 100] [(b) 20 200] [(c) 30 300]) 200)
(check-equal? (enum-case option 3 [(a) 10 100] [(b) 20 200] [(c) 30 300]) 300)
(check-exn exn:fail? (cut enum-case option 'a [(a) 100] [(b) 200] [(c) 300]))
(check-equal? (enum-case option 1 [(a) 10 100] [(b) 20 200] [else 30 300]) 100)
(check-equal? (enum-case option 2 [(a) 10 100] [(b) 20 200] [else 30 300]) 200)
(check-equal? (enum-case option 3 [(a) 10 100] [(b) 20 200] [else 30 300]) 300)
(check-equal? (enum-case option 'a [(a) 100] [(b) 200] [else 300]) 300)
(check-equal? (enum-case option 1 [(a) 10 100] [(b c) 20 200]) 100)
(check-equal? (enum-case option 2 [(a) 10 100] [(b c) 20 200]) 200)
(check-equal? (enum-case option 3 [(a) 10 100] [(b c) 20 200]) 200)
(check-exn exn:fail? (cut enum-case option 'a [(a) 100] [(b c) 200]))
(check-equal? (enum-case structs (structs one) [(one) 1] [(two) 2] [(three) 3] [else 4]) 1)
(check-equal? (enum-case structs (make-struct 'a) [(one) 1] [(two) 2] [(three) 3] [else 4]) 4)
(check-equal? (enum-case titles "Mr" [(mr) 1] [(mrs) 2] [(miss) 3]) 1)
(check-equal? (enum-case titles "Mrs" [(mr) 1] [(mrs) 2] [(miss) 3]) 2)
(check-equal? (enum-case titles "Miss" [(mr) 1] [(mrs) 2] [(miss) 3]) 3)
(check-exn exn:fail? (cut enum-case titles 'Mr [(mr) 1] [(mrs) 2] [(miss) 3]))
(check-exn exn:fail? (cut enum-case titles "mr" [(mr) 1] [(mrs) 2] [(miss) 3])))
(test-case "enum-lambda"
(let ([proc (enum-lambda option [(a) 10 100] [(b) 20 200] [(c) 30 300])])
(check-equal? (proc 1) 100)
(check-equal? (proc 2) 200)
(check-equal? (proc 3) 300)
(check-exn exn:fail? (cut proc 'a)))
(let ([proc (enum-lambda titles [(mr) 10 100] [(mrs) 20 200] [(miss) 30 300])])
(check-equal? (proc "Mr") 100)
(check-equal? (proc "Mrs") 200)
(check-equal? (proc "Miss") 300)
(check-exn exn:fail? (cut proc 'Mr))))
(test-case "in-enum"
(check-equal? (for/list ([val (in-enum option)]) val) (list 1 2 3))
(check-equal? (for/list ([val (in-enum option a c)]) val) (list 1 3))
(check-equal? (for/list ([val (in-enum titles)]) val) (list "Mr" "Mrs" "Miss"))
(check-equal? (for/list ([val (in-enum titles mr miss)]) val) (list "Mr" "Miss")))
(test-case "in-enum/pretty"
(check-equal? (for/list ([val (in-enum/pretty option)]) val) (list "item 1" "item 2" "item 3"))
(check-equal? (for/list ([val (in-enum/pretty option a c)]) val) (list "item 1" "item 3"))
(check-equal? (for/list ([val (in-enum/pretty titles)]) val) (list "mr" "mrs" "miss"))
(check-equal? (for/list ([val (in-enum/pretty titles mr miss)]) val) (list "mr" "miss"))))