Diff
Not logged in

Differences From Artifact [95354a9aa5]:

To Artifact [eecfc6c1e7]:


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
	[list $dll $loaded] {
    load -global [file join $testDir pkga$ext]
    list [pkga_eq abc def] [lsort [info commands pkga_*]]
} {0 {pkga_eq pkga_quote}}
interp create -safe child
test load-2.2 {loading into a safe interpreter, with package name conversion} \
	[list $dll $loaded] {
    load -lazy [file join $testDir pkgb$ext] pKgB child
    list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \
	    [catch {pkgb_sub 12 10} msg2] $msg2
} {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}}
test load-2.3 {loading with no _Init procedure} -constraints [list $dll $loaded] \
-body {
    list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg $errorCode
} -match glob \
    -result [list 1 {cannot find symbol "Foo_Init"*} \
		 {TCL LOOKUP LOAD_SYMBOL *Foo_Init}]
test load-2.4 {loading with no _SafeInit procedure} [list $dll $loaded] {
    list [catch {load [file join $testDir pkga$ext] {} child} msg] $msg
} {1 {can't use package in a safe interpreter: no Pkga_SafeInit procedure}}

test load-3.1 {error in _Init procedure, same interpreter} \
	[list $dll $loaded] {
    list [catch {load [file join $testDir pkge$ext] pkge} msg] \
	    $msg $::errorInfo $::errorCode
} {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
    while executing







|











|







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
	[list $dll $loaded] {
    load -global [file join $testDir pkga$ext]
    list [pkga_eq abc def] [lsort [info commands pkga_*]]
} {0 {pkga_eq pkga_quote}}
interp create -safe child
test load-2.2 {loading into a safe interpreter, with package name conversion} \
	[list $dll $loaded] {
    load -lazy [file join $testDir pkgb$ext] pkgb child
    list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \
	    [catch {pkgb_sub 12 10} msg2] $msg2
} {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}}
test load-2.3 {loading with no _Init procedure} -constraints [list $dll $loaded] \
-body {
    list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg $errorCode
} -match glob \
    -result [list 1 {cannot find symbol "Foo_Init"*} \
		 {TCL LOOKUP LOAD_SYMBOL *Foo_Init}]
test load-2.4 {loading with no _SafeInit procedure} [list $dll $loaded] {
    list [catch {load [file join $testDir pkga$ext] {} child} msg] $msg
} {1 {can't use package in a safe interpreter: no pkga_SafeInit procedure}}

test load-3.1 {error in _Init procedure, same interpreter} \
	[list $dll $loaded] {
    list [catch {load [file join $testDir pkge$ext] pkge} msg] \
	    $msg $::errorInfo $::errorCode
} {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
    while executing
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
test load-4.1 {reloading package into same interpreter} [list $dll $loaded] {
    list [catch {load [file join $testDir pkga$ext] pkga} msg] $msg
} {0 {}}
test load-4.2 {reloading package into same interpreter} -setup {
    catch {load [file join $testDir pkga$ext] pkga}
} -constraints [list $dll $loaded] -returnCodes error -body {
    load [file join $testDir pkga$ext] pkgb
} -result "file \"[file join $testDir pkga$ext]\" is already loaded for package \"Pkga\""

test load-5.1 {file name not specified and no static package: pick default} -setup {
    catch {interp delete x}
    interp create x
} -constraints [list $dll $loaded] -body {
    load -global [file join $testDir pkga$ext] pkga
    load {} pkga x
    info loaded x
} -cleanup {
    interp delete x
} -result [list [list [file join $testDir pkga$ext] Pkga]]

# On some platforms, like SunOS 4.1.3, these tests can't be run because
# they cause the process to exit.
#
# As of 2005, such ancient broken systems no longer matter.

test load-6.1 {errors loading file} [list $dll $loaded] {







|










|







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
test load-4.1 {reloading package into same interpreter} [list $dll $loaded] {
    list [catch {load [file join $testDir pkga$ext] pkga} msg] $msg
} {0 {}}
test load-4.2 {reloading package into same interpreter} -setup {
    catch {load [file join $testDir pkga$ext] pkga}
} -constraints [list $dll $loaded] -returnCodes error -body {
    load [file join $testDir pkga$ext] pkgb
} -result "file \"[file join $testDir pkga$ext]\" is already loaded for package \"pkga\""

test load-5.1 {file name not specified and no static package: pick default} -setup {
    catch {interp delete x}
    interp create x
} -constraints [list $dll $loaded] -body {
    load -global [file join $testDir pkga$ext] pkga
    load {} pkga x
    info loaded x
} -cleanup {
    interp delete x
} -result [list [list [file join $testDir pkga$ext] pkga]]

# On some platforms, like SunOS 4.1.3, these tests can't be run because
# they cause the process to exit.
#
# As of 2005, such ancient broken systems no longer matter.

test load-6.1 {errors loading file} [list $dll $loaded] {
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
    teststaticpkg 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







|







170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
    teststaticpkg 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
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
    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 {
    info loaded gorp
} -returnCodes error -result {could not find interpreter "gorp"}
test load-8.3a {TclGetLoadedPackages procedure} [list teststaticpkg_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] {
    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] {
    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 {
    interp create child1
    interp create child2
    load {} tcl::test child1
    load {} tcl::test child2







|


|



|







200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
    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 {
    info loaded gorp
} -returnCodes error -result {could not find interpreter "gorp"}
test load-8.3a {TclGetLoadedPackages procedure} [list teststaticpkg_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] {
    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] {
    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 {
    interp create child1
    interp create child2
    load {} tcl::test child1
    load {} tcl::test child2