Diff
Not logged in

Differences From Artifact [d20d256a14]:

To Artifact [4ef99d5521]:


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}}}