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
|
# Tests for the "testutils" command, defined in testutils.tcl
#
# © 2025 Erik Leunissen
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
# Notes:
#
# - All tests have been constrained with test constraint "testutils". This
# constraint isn't set anywhere, and therefore false by default. Therefore,
# the tests in this file are skipped in a regular invocation of the Tk test
# suite. In order to run these test, you need to use the tcltest option
# "-constraints testutils" in the invocation, possibly combined with the
# option "-file testutils.test" to exclude other test files, or with
# "-limitconstraints true" to exclude other tests.
#
# - At this place in the test file, the file "testutils.tcl" has already been
# sourced (through tcltest::loadTestedCommands above), and the utility procs
# from domain "generic" are already available. Therefore we can make use of
# proc "assert" here.
#
assert {"testutils" in [info procs testutils]}
#
# Section 1: invalid invocations
#
test testutils-1.1 {invalid subcommand} -constraints testutils -body {
testutils foo
} -result {invalid subCmd "foo". Usage: testutils export|import|forget ?domain domain ...?} -returnCodes error
test testutils-1.2 {invalid #args for subCmd export} -constraints testutils -body {
testutils export foo
} -result {invalid #args. Usage: testutils export} -returnCodes error
test testutils-1.3 {invalid #args for subCmd import} -constraints testutils -body {
testutils import
} -result {invalid #args. Usage: testutils import|forget domain ?domain ...?} -returnCodes error
test testutils-1.4 {invalid #args for subCmd forget} -constraints testutils -body {
testutils forget
} -result {invalid #args. Usage: testutils import|forget domain ?domain ...?} -returnCodes error
test testutils-1.5 {invalid domain for subCmd import} -constraints testutils -body {
testutils import foo
} -result {testutils domain "foo" doesn't exist} -returnCodes error
test testutils-1.6 {invalid domain for subCmd forget} -constraints testutils -body {
testutils forget foo
} -result {testutils domain "foo" doesn't exist} -returnCodes error
#
# Create a domain namespace for testing export, import, forget
#
assert {"::tk::test::foo" ni [namespace children ::tk::test]}
assert {"::tk::test::zez" ni [namespace children ::tk::test]}
catch {rename init {}}
catch {rename kuk {}}
unset -nocomplain bar pip
namespace eval ::tk::test::foo {
proc init {} {
variable bar 123
variable pip
}
proc kuk {} {}
testutils export
}
set initVars [info vars]; lappend initVars initVars
#
# 2. Domain failures for forget and import
#
test testutils-2.1 {forget not-imported domain} -constraints testutils -body {
testutils forget foo
} -result {testutils domain "foo" was not imported} -returnCodes error
test testutils-2.2 {duplicate import} -constraints testutils -body {
testutils import foo
testutils import foo
} -result {testutils domain "foo" was already imported} -returnCodes error -cleanup {
testutils forget foo
}
#
# 3. Import procs
#
test testutils-3.1 {utility proc is imported and init proc is not} -constraints testutils -body {
testutils import foo
expr {([info procs kuk] eq "kuk") && ([info procs init] eq "")}
} -result 1 -cleanup {
testutils forget foo
}
test testutils-3.2 {forget removes utility proc} -constraints testutils -body {
testutils import foo
testutils forget foo
info procs kuk
} -result {}
test testutils-3.3 {import fails: proc already exists} -constraints testutils -setup {
namespace eval ::zez {
proc kuk {} {}
}
} -body {
namespace eval ::zez {
testutils import foo
}
} -result "import from testutils domain \"foo\" failed: can't import command \"kuk\": already exists" -returnCodes error -cleanup {
namespace delete ::zez
}
#
# 4. Import variables
#
test testutils-4.1 {associated variables are imported} -constraints testutils -body {
testutils import foo
set varNames [info vars]
foreach name $initVars {
set varNames [lremove $varNames [lsearch $varNames $name]]
}
list [lsort $varNames] [info exists bar] [info exists pip] $bar
} -result [list {bar pip} 1 0 123] -cleanup {
unset -nocomplain name varNames
testutils forget foo
}
test testutils-4.2 {
Repeated initialization keeps imported variable defined without value non-existent,
even if a test file inadvertently assigns it a value in the meantime.
} -constraints testutils -body {
catch {
testutils import foo
}
testutils forget foo
set pip 11111
testutils import foo
info exists pip
} -result 0 -cleanup {
testutils forget foo
}
test testutils-4.3 {import fails: variable already exists} -constraints testutils -setup {
#
# We need a pristine new namespace in which the variable bar was never imported
# and hence no upvar link for it exists.
#
namespace eval ::zez {
set bar 11
}
} -body {
namespace eval ::zez {
testutils import foo
}
} -result "import from testutils domain \"foo\" failed: variable \"bar\" already exists" -returnCodes error -cleanup {
namespace delete ::zez
}
test testutils-4.4 {repeated creation/deletion of requesting namespace doesn't fool testutils} -constraints testutils -setup {
} -body {
namespace eval ::zez {
testutils import foo
testutils forget foo
}
namespace delete ::zez
namespace eval ::zez {
set pip 22
testutils import foo
list [info exists bar] [info exists pip] $bar
}
} -result {1 0 123} -cleanup {
namespace delete ::zez
}
#
# CLEANUP
#
namespace delete ::tk::test::foo
unset -nocomplain bar initVars pip
cleanupTests
# EOF
|
