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
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
|
# This file contains tests for the ::tcl::tm::* commands.
#
# Sourcing this file into Tcl runs the tests and generates output for
# errors. No output means no errors were found.
#
# Copyright © 2004 Donal K. Fellows.
# All rights reserved.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
test tm-1.1 {tm: path command exists} {
catch { ::tcl::tm::path }
info commands ::tcl::tm::path
} ::tcl::tm::path
test tm-1.2 {tm: path command syntax} -returnCodes error -body {
::tcl::tm::path foo
} -result {unknown or ambiguous subcommand "foo": must be add, list, or remove}
test tm-1.3 {tm: path command syntax} {
::tcl::tm::path add
} {}
test tm-1.4 {tm: path command syntax} {
::tcl::tm::path remove
} {}
test tm-1.5 {tm: path command syntax} -returnCodes error -body {
::tcl::tm::path list foobar
} -result "wrong # args: should be \"::tcl::tm::path list\""
test tm-2.1 {tm: roots command exists} {
catch { ::tcl::tm::roots }
info commands ::tcl::tm::roots
} ::tcl::tm::roots
test tm-2.2 {tm: roots command syntax} -returnCodes error -body {
::tcl::tm::roots
} -result "wrong # args: should be \"::tcl::tm::roots paths\""
test tm-2.3 {tm: roots command syntax} -returnCodes error -body {
::tcl::tm::roots foo bar
} -result "wrong # args: should be \"::tcl::tm::roots paths\""
test tm-3.1 {tm: module path management, input validation} -setup {
# Save and clear the list
set defaults [::tcl::tm::path list]
foreach p $defaults {::tcl::tm::path remove $p}
} -cleanup {
# Restore old contents of path list.
foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p}
foreach p $defaults {::tcl::tm::path add $p}
} -returnCodes error -body {
::tcl::tm::path add foo/bar
::tcl::tm::path add foo
} -result {foo is ancestor of existing module path foo/bar.}
test tm-3.2 {tm: module path management, input validation} -setup {
# Save and clear the list
set defaults [::tcl::tm::path list]
foreach p $defaults {::tcl::tm::path remove $p}
} -cleanup {
# Restore old contents of path list.
foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p}
foreach p $defaults {::tcl::tm::path add $p}
} -returnCodes error -body {
::tcl::tm::path add foo
::tcl::tm::path add foo/bar
} -result {foo/bar is subdirectory of existing module path foo.}
test tm-3.3 {tm: module path management, add/list interaction} -setup {
# Save and clear the list
set defaults [::tcl::tm::path list]
foreach p $defaults {::tcl::tm::path remove $p}
} -cleanup {
# Restore old contents of path list.
foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p}
foreach p $defaults {::tcl::tm::path add $p}
} -body {
::tcl::tm::path add foo
::tcl::tm::path add bar
::tcl::tm::path list
} -result {bar foo}
test tm-3.4 {tm: module path management, add/list interaction} -setup {
# Save and clear the list
set defaults [::tcl::tm::path list]
foreach p $defaults {::tcl::tm::path remove $p}
} -cleanup {
# Restore old contents of path list.
foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p}
foreach p $defaults {::tcl::tm::path add $p}
} -body {
::tcl::tm::path add foo bar baz
::tcl::tm::path list
} -result {baz bar foo}
test tm-3.5 {tm: module path management, input validation/list interaction} -setup {
# Save and clear the list
set defaults [::tcl::tm::path list]
foreach p $defaults {::tcl::tm::path remove $p}
} -cleanup {
# Restore old contents of path list.
foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p}
foreach p $defaults {::tcl::tm::path add $p}
} -body {
catch {::tcl::tm::path add snarf foo geode foo/bar}
# Nothing is added if a problem was found.
::tcl::tm::path list
} -result {}
test tm-3.6 {tm: module path management, input validation/list interaction} -setup {
# Save and clear the list
set defaults [::tcl::tm::path list]
foreach p $defaults {::tcl::tm::path remove $p}
} -cleanup {
# Restore old contents of path list.
foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p}
foreach p $defaults {::tcl::tm::path add $p}
} -body {
catch {::tcl::tm::path add snarf foo/bar geode foo}
# Nothing is added if a problem was found.
::tcl::tm::path list
} -result {}
test tm-3.7 {tm: module path management, input validation/list interaction} -setup {
# Save and clear the list
set defaults [::tcl::tm::path list]
foreach p $defaults {::tcl::tm::path remove $p}
} -cleanup {
# Restore old contents of path list.
foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p}
foreach p $defaults {::tcl::tm::path add $p}
} -body {
catch {
::tcl::tm::path add foo/bar
::tcl::tm::path add snarf geode foo
}
# Nothing is added if a problem was found.
::tcl::tm::path list
} -result {foo/bar}
test tm-3.8 {tm: module path management, input validation, ignore duplicates} -setup {
# Save and clear the list
set defaults [::tcl::tm::path list]
foreach p $defaults {::tcl::tm::path remove $p}
} -cleanup {
# Restore old contents of path list.
foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p}
foreach p $defaults {::tcl::tm::path add $p}
} -body {
# Ignore path if present
::tcl::tm::path add foo
::tcl::tm::path add snarf geode foo
::tcl::tm::path list
} -result {geode snarf foo}
test tm-3.9 {tm: module path management, input validation, ignore duplicates} -setup {
# Save and clear the list
set defaults [::tcl::tm::path list]
foreach p $defaults {::tcl::tm::path remove $p}
} -cleanup {
# Restore old contents of path list.
foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p}
foreach p $defaults {::tcl::tm::path add $p}
} -body {
# Ignore path if present
::tcl::tm::path add foo snarf geode foo
::tcl::tm::path list
} -result {geode snarf foo}
test tm-3.10 {tm: module path management, remove} -setup {
# Save and clear the list
set defaults [::tcl::tm::path list]
foreach p $defaults {::tcl::tm::path remove $p}
} -cleanup {
# Restore old contents of path list.
foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p}
foreach p $defaults {::tcl::tm::path add $p}
} -body {
::tcl::tm::path add snarf geode foo
::tcl::tm::path remove foo
::tcl::tm::path list
} -result {geode snarf}
test tm-3.11 {tm: module path management, remove ignores unknown path} -setup {
# Save and clear the list
set defaults [::tcl::tm::path list]
foreach p $defaults {::tcl::tm::path remove $p}
} -cleanup {
# Restore old contents of path list.
foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p}
foreach p $defaults {::tcl::tm::path add $p}
} -body {
::tcl::tm::path add foo snarf geode
::tcl::tm::path remove fox
::tcl::tm::path list
} -result {geode snarf foo}
proc genpaths {base} {
# Normalizing picks up drive letters on windows [Bug 1053568]
set base [file normalize $base]
regexp {^(\d+)\.(\d+)} [package provide tcl] - major minor
set results {}
set base [file join $base tcl$major]
lappend results [file join $base site-tcl]
for {set i 0} {$i <= $minor} {incr i} {
lappend results [file join $base ${major}.$i]
}
return $results
}
test tm-3.12 {tm: module path management, roots} -setup {
# Save and clear the list
set defaults [::tcl::tm::path list]
foreach p $defaults {::tcl::tm::path remove $p}
} -cleanup {
# Restore old contents of path list.
foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p}
foreach p $defaults {::tcl::tm::path add $p}
} -body {
::tcl::tm::roots /FOO
::tcl::tm::path list
} -result [genpaths /FOO]
test tm-3.13 {tm: module path management, roots} -setup {
# Save and clear the list
set defaults [::tcl::tm::path list]
foreach p $defaults {::tcl::tm::path remove $p}
} -cleanup {
# Restore old contents of path list.
foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p}
foreach p $defaults {::tcl::tm::path add $p}
} -body {
::tcl::tm::roots [list /FOO /BAR]
::tcl::tm::path list
} -result [concat [genpaths /BAR] [genpaths /FOO]]
rename genpaths {}
::tcltest::cleanupTests
return
# Local Variables:
# mode: tcl
# End:
|
