32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
|
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
|
-
+
-
+
|
# Tests also require that this DLL has not already been loaded.
set loaded "[file tail $x]Loaded"
set alreadyLoaded [info loaded]
testConstraint $loaded [expr {![string match *pkga* $alreadyLoaded]}]
set alreadyTotalLoaded [info loaded]
# Certain tests require the 'teststaticpkg' command from tcltest
# Certain tests require the 'teststaticlibrary' command from tcltest
testConstraint teststaticpkg [llength [info commands teststaticpkg]]
testConstraint teststaticlibrary [llength [info commands teststaticlibrary]]
# Test load-10.1 requires the 'testsimplefilesystem' command from tcltest
testConstraint testsimplefilesystem \
[llength [info commands testsimplefilesystem]]
test load-1.1 {basic errors} -returnCodes error -body {
|
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
|
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
|
-
+
-
+
-
+
-
+
-
+
-
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
+
+
-
-
-
-
-
+
+
+
+
+
-
+
-
+
-
+
-
+
-
+
-
+
-
-
-
+
+
+
|
#
# As of 2005, such ancient broken systems no longer matter.
test load-6.1 {errors loading file} [list $dll $loaded] {
catch {load foo foo}
} {1}
test load-7.1 {Tcl_StaticPackage procedure} [list teststaticpkg] {
test load-7.1 {Tcl_StaticLibrary procedure} [list teststaticlibrary] {
set x "not loaded"
teststaticpkg Test 1 0
teststaticlibrary Test 1 0
load {} test
load {} test child
list [set x] [child eval set x]
} {loaded loaded}
test load-7.2 {Tcl_StaticPackage procedure} [list teststaticpkg] {
test load-7.2 {Tcl_StaticLibrary procedure} [list teststaticlibrary] {
set x "not loaded"
teststaticpkg Another 0 0
teststaticlibrary Another 0 0
load {} Another
child eval {set x "not loaded"}
list [catch {load {} Another child} msg] $msg \
[child eval set x] [set x]
} {1 {can't use library in a safe interpreter: no Another_SafeInit procedure} {not loaded} loaded}
test load-7.3 {Tcl_StaticPackage procedure} [list teststaticpkg] {
test load-7.3 {Tcl_StaticLibrary procedure} [list teststaticlibrary] {
set x "not loaded"
teststaticpkg More 0 1
teststaticlibrary More 0 1
load {} more
set x
} {not loaded}
catch {load [file join $testDir pkga$ext] Pkga}
catch {load [file join $testDir pkgb$ext] Pkgb}
catch {load [file join $testDir pkge$ext] Pkge}
set currentRealPackages [list [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]]
test load-7.4 {Tcl_StaticPackage procedure, redundant calls} -setup {
teststaticpkg Test 1 0
teststaticpkg Another 0 0
teststaticpkg More 0 1
} -constraints [list teststaticpkg $dll $loaded] -body {
teststaticpkg Double 0 1
teststaticpkg Double 0 1
test load-7.4 {Tcl_StaticLibrary procedure, redundant calls} -setup {
teststaticlibrary Test 1 0
teststaticlibrary Another 0 0
teststaticlibrary More 0 1
} -constraints [list teststaticlibrary $dll $loaded] -body {
teststaticlibrary Double 0 1
teststaticlibrary Double 0 1
info loaded
} -result [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealPackages {*}$alreadyTotalLoaded]
testConstraint teststaticpkg_8.x 0
if {[testConstraint teststaticpkg]} {
testConstraint teststaticlibrary_8.x 0
if {[testConstraint teststaticlibrary]} {
catch {
teststaticpkg Test 1 1
teststaticpkg Another 0 1
teststaticpkg More 0 1
teststaticpkg Double 0 1
testConstraint teststaticpkg_8.x 1
teststaticlibrary Test 1 1
teststaticlibrary Another 0 1
teststaticlibrary More 0 1
teststaticlibrary Double 0 1
testConstraint teststaticlibrary_8.x 1
}
}
test load-8.1 {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] {
test load-8.1 {TclGetLoadedPackages procedure} [list teststaticlibrary_8.x $dll $loaded] {
lsort -index 1 [info loaded]
} [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealPackages {*}$alreadyTotalLoaded]]
test load-8.2 {TclGetLoadedPackages procedure} -constraints {teststaticpkg_8.x} -body {
test load-8.2 {TclGetLoadedPackages procedure} -constraints {teststaticlibrary_8.x} -body {
info loaded gorp
} -returnCodes error -result {could not find interpreter "gorp"}
test load-8.3a {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] {
test load-8.3a {TclGetLoadedPackages procedure} [list teststaticlibrary_8.x $dll $loaded] {
lsort -index 1 [info loaded {}]
} [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga] [list [file join $testDir pkgb$ext] Pkgb] {*}$alreadyLoaded]]
test load-8.3b {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] {
test load-8.3b {TclGetLoadedPackages procedure} [list teststaticlibrary_8.x $dll $loaded] {
lsort -index 1 [info loaded child]
} [lsort -index 1 [list {{} Test} [list [file join $testDir pkgb$ext] Pkgb]]]
test load-8.4 {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] {
test load-8.4 {TclGetLoadedPackages procedure} [list teststaticlibrary_8.x $dll $loaded] {
load [file join $testDir pkgb$ext] Pkgb
list [lsort -index 1 [info loaded {}]] [lsort [info commands pkgb_*]]
} [list [lsort -index 1 [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded]] {pkgb_demo pkgb_sub pkgb_unsafe}]
interp delete child
test load-9.1 {Tcl_StaticPackage, load already-loaded package into another interp} -setup {
test load-9.1 {Tcl_StaticLibrary, load already-loaded package into another interp} -setup {
interp create child1
interp create child2
load {} Tcltest child1
load {} Tcltest child2
} -constraints {teststaticpkg} -body {
child1 eval { teststaticpkg Loadninepointone 0 1 }
child2 eval { teststaticpkg Loadninepointone 0 1 }
} -constraints {teststaticlibrary} -body {
child1 eval { teststaticlibrary Loadninepointone 0 1 }
child2 eval { teststaticlibrary Loadninepointone 0 1 }
list [child1 eval { info loaded {} }] \
[child2 eval { info loaded {} }]
} -match glob -cleanup {
interp delete child1
interp delete child2
} -result {{{{} Loadninepointone} {* Tcltest}} {{{} Loadninepointone} {* Tcltest}}}
|