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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
|
# defer.test - Copyright (c) 2017 Roy Keene
# -*- tcl -*-
# -------------------------------------------------------------------------
source [file join \
[file dirname [file dirname [file join [pwd] [info script]]]] \
devtools testutilities.tcl]
testsNeedTcl 8.6
testsNeedTcltest 2
testing {
useLocal defer.tcl defer
}
# -------------------------------------------------------------------------
# Series 1: defer::defer
test defer-1.0 {defer::defer simple} -setup {
set deferTest FAIL
} -body {
apply {{} {
defer::defer apply {{} {
uplevel 2 {set deferTest PASS}
}}
}}
set deferTest
} -cleanup {
unset -nocomplain deferTest
} -result {PASS}
test defer-1.1 {defer::defer fd} -setup {
set fd [file tempfile]
} -body {
apply {{fd} {
defer::defer close $fd
}} $fd
lsearch -exact [chan names] $fd
} -cleanup {
catch {
close $fd
}
unset fd
} -result {-1}
# Series 2: defer::with
test defer-2.0 {defer::with simple} -setup {
set deferTest FAIL
} -body {
apply {{} {
set withCheck true
defer::with withCheck {
if {$withCheck} {
uplevel 1 {set deferTest PASS}
}
}
}}
set deferTest
} -cleanup {
unset -nocomplain deferTest
} -result {PASS}
test defer-2.1 {defer::with fd} -setup {
set fd [file tempfile]
} -body {
apply {{fd} {
defer::with fd {
close $fd
}
}} $fd
lsearch -exact [chan names] $fd
} -cleanup {
catch {
close $fd
}
unset fd
} -result {-1}
# Series 3: defer::autowith
test defer-3.0 {defer::autowith simple} -setup {
set deferTest FAIL
} -body {
apply {{} {
set autoWithCheck true
defer::autowith {
if {$autoWithCheck} {
uplevel 1 {set deferTest PASS}
}
}
}}
set deferTest
} -cleanup {
unset -nocomplain deferTest
} -result {PASS}
test defer-3.1 {defer::autowith fd} -setup {
set fd [file tempfile]
} -body {
apply {{fd} {
defer::autowith {
close $fd
}
}} $fd
lsearch -exact [chan names] $fd
} -cleanup {
catch {
close $fd
}
unset fd
} -result {-1}
# Series 4: defer::cancel
test defer-4.0 {defer::cancel simple} -setup {
set deferTest FAIL-1
} -body {
apply {{} {
set defId [defer::with "" {
uplevel 1 {set deferTest FAIL-2}
}]
defer::with "" {
uplevel 1 {set deferTest PASS}
}
defer::cancel $defId
}}
set deferTest
} -cleanup {
unset -nocomplain deferTest
} -result {PASS}
# Series 5: Order is LIFO
test defer-5.0 {defer is LIFO} -setup {
set deferTest "INVALID"
} -body {
apply {{} {
for {set i 0} {$i < 10} {incr i} {
defer::defer uplevel 1 [list set deferTest "RESULT:$i"]
}
}}
set deferTest
} -cleanup {
unset -nocomplain deferTest
} -result {RESULT:0}
# Series 6: Usage checks
test defer-6.0 {defer::defer global fails} -body {
defer::defer info patchlevel
} -returnCodes ERROR -result {defer may not be used from the global scope}
test defer-6.1 {defer::defer with no args works} -body {
apply {{} {
defer::defer
return "PASS"
}}
} -result {PASS}
test defer-6.2 {defer::with syntax too few args} -body {
apply {{} {
defer::with
}}
} -returnCodes ERROR -match glob -result {wrong # args: *}
test defer-6.3 {defer::with syntax too many args} -body {
apply {{} {
defer::with [list] error BADARG
}}
} -returnCodes ERROR -match glob -result {wrong # args: *}
test defer-6.4 {defer::autowith syntax too few args} -body {
apply {{} {
defer::autowith
}}
} -returnCodes ERROR -match glob -result {wrong # args: *}
test defer-6.5 {defer::autowith syntax too many args} -body {
apply {{} {
defer::autowith error BADARG
}}
} -returnCodes ERROR -match glob -result {wrong # args: *}
test defer-6.6 {defer::cancel syntax too few args} -body {
apply {{} {
defer::cancel
return "PASS"
}}
} -result {PASS}
test defer-6.7 {defer::cancel syntax too many args} -body {
apply {{} {
defer::cancel A B
return "PASS"
}}
} -result {PASS}
# -------------------------------------------------------------------------
testsuiteCleanup
|
