os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/interp.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/interp.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,2948 @@
1.4 +# This file tests the multiple interpreter facility of Tcl
1.5 +#
1.6 +# This file contains a collection of tests for one or more of the Tcl
1.7 +# built-in commands. Sourcing this file into Tcl runs the tests and
1.8 +# generates output for errors. No output means no errors were found.
1.9 +#
1.10 +# Copyright (c) 1995-1996 Sun Microsystems, Inc.
1.11 +# Copyright (c) 1998-1999 by Scriptics Corporation.
1.12 +#
1.13 +# See the file "license.terms" for information on usage and redistribution
1.14 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.15 +#
1.16 +# RCS: @(#) $Id: interp.test,v 1.19.2.6 2004/10/28 00:01:07 dgp Exp $
1.17 +
1.18 +if {[lsearch [namespace children] ::tcltest] == -1} {
1.19 + package require tcltest 2.1
1.20 + namespace import -force ::tcltest::*
1.21 +}
1.22 +
1.23 +# The set of hidden commands is platform dependent:
1.24 +
1.25 +if {"$tcl_platform(platform)" == "macintosh"} {
1.26 + set hidden_cmds {beep cd echo encoding exit fconfigure file glob load ls open pwd socket source}
1.27 +} else {
1.28 + set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source}
1.29 +}
1.30 +
1.31 +foreach i [interp slaves] {
1.32 + interp delete $i
1.33 +}
1.34 +
1.35 +proc equiv {x} {return $x}
1.36 +
1.37 +# Part 0: Check out options for interp command
1.38 +test interp-1.1 {options for interp command} {
1.39 + list [catch {interp} msg] $msg
1.40 +} {1 {wrong # args: should be "interp cmd ?arg ...?"}}
1.41 +test interp-1.2 {options for interp command} {
1.42 + list [catch {interp frobox} msg] $msg
1.43 +} {1 {bad option "frobox": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, marktrusted, recursionlimit, slaves, share, target, or transfer}}
1.44 +test interp-1.3 {options for interp command} {
1.45 + interp delete
1.46 +} ""
1.47 +test interp-1.4 {options for interp command} {
1.48 + list [catch {interp delete foo bar} msg] $msg
1.49 +} {1 {could not find interpreter "foo"}}
1.50 +test interp-1.5 {options for interp command} {
1.51 + list [catch {interp exists foo bar} msg] $msg
1.52 +} {1 {wrong # args: should be "interp exists ?path?"}}
1.53 +#
1.54 +# test interp-0.6 was removed
1.55 +#
1.56 +test interp-1.6 {options for interp command} {
1.57 + list [catch {interp slaves foo bar zop} msg] $msg
1.58 +} {1 {wrong # args: should be "interp slaves ?path?"}}
1.59 +test interp-1.7 {options for interp command} {
1.60 + list [catch {interp hello} msg] $msg
1.61 +} {1 {bad option "hello": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, marktrusted, recursionlimit, slaves, share, target, or transfer}}
1.62 +test interp-1.8 {options for interp command} {
1.63 + list [catch {interp -froboz} msg] $msg
1.64 +} {1 {bad option "-froboz": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, marktrusted, recursionlimit, slaves, share, target, or transfer}}
1.65 +test interp-1.9 {options for interp command} {
1.66 + list [catch {interp -froboz -safe} msg] $msg
1.67 +} {1 {bad option "-froboz": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, marktrusted, recursionlimit, slaves, share, target, or transfer}}
1.68 +test interp-1.10 {options for interp command} {
1.69 + list [catch {interp target} msg] $msg
1.70 +} {1 {wrong # args: should be "interp target path alias"}}
1.71 +
1.72 +
1.73 +# Part 1: Basic interpreter creation tests:
1.74 +test interp-2.1 {basic interpreter creation} {
1.75 + interp create a
1.76 +} a
1.77 +test interp-2.2 {basic interpreter creation} {
1.78 + catch {interp create}
1.79 +} 0
1.80 +test interp-2.3 {basic interpreter creation} {
1.81 + catch {interp create -safe}
1.82 +} 0
1.83 +test interp-2.4 {basic interpreter creation} {
1.84 + list [catch {interp create a} msg] $msg
1.85 +} {1 {interpreter named "a" already exists, cannot create}}
1.86 +test interp-2.5 {basic interpreter creation} {
1.87 + interp create b -safe
1.88 +} b
1.89 +test interp-2.6 {basic interpreter creation} {
1.90 + interp create d -safe
1.91 +} d
1.92 +test interp-2.7 {basic interpreter creation} {
1.93 + list [catch {interp create -froboz} msg] $msg
1.94 +} {1 {bad option "-froboz": must be -safe or --}}
1.95 +test interp-2.8 {basic interpreter creation} {
1.96 + interp create -- -froboz
1.97 +} -froboz
1.98 +test interp-2.9 {basic interpreter creation} {
1.99 + interp create -safe -- -froboz1
1.100 +} -froboz1
1.101 +test interp-2.10 {basic interpreter creation} {
1.102 + interp create {a x1}
1.103 + interp create {a x2}
1.104 + interp create {a x3} -safe
1.105 +} {a x3}
1.106 +test interp-2.11 {anonymous interps vs existing procs} {
1.107 + set x [interp create]
1.108 + regexp "interp(\[0-9]+)" $x dummy thenum
1.109 + interp delete $x
1.110 + proc interp$thenum {} {}
1.111 + set x [interp create]
1.112 + regexp "interp(\[0-9]+)" $x dummy anothernum
1.113 + expr $anothernum > $thenum
1.114 +} 1
1.115 +test interp-2.12 {anonymous interps vs existing procs} {
1.116 + set x [interp create -safe]
1.117 + regexp "interp(\[0-9]+)" $x dummy thenum
1.118 + interp delete $x
1.119 + proc interp$thenum {} {}
1.120 + set x [interp create -safe]
1.121 + regexp "interp(\[0-9]+)" $x dummy anothernum
1.122 + expr $anothernum - $thenum
1.123 +} 1
1.124 +test interp-2.13 {correct default when no $path arg is given} -body {
1.125 + interp create --
1.126 +} -match regexp -result {interp[0-9]+}
1.127 +
1.128 +foreach i [interp slaves] {
1.129 + interp delete $i
1.130 +}
1.131 +
1.132 +# Part 2: Testing "interp slaves" and "interp exists"
1.133 +test interp-3.1 {testing interp exists and interp slaves} {
1.134 + interp slaves
1.135 +} ""
1.136 +test interp-3.2 {testing interp exists and interp slaves} {
1.137 + interp create a
1.138 + interp exists a
1.139 +} 1
1.140 +test interp-3.3 {testing interp exists and interp slaves} {
1.141 + interp exists nonexistent
1.142 +} 0
1.143 +test interp-3.4 {testing interp exists and interp slaves} {
1.144 + list [catch {interp slaves a b c} msg] $msg
1.145 +} {1 {wrong # args: should be "interp slaves ?path?"}}
1.146 +test interp-3.5 {testing interp exists and interp slaves} {
1.147 + list [catch {interp exists a b c} msg] $msg
1.148 +} {1 {wrong # args: should be "interp exists ?path?"}}
1.149 +test interp-3.6 {testing interp exists and interp slaves} {
1.150 + interp exists
1.151 +} 1
1.152 +test interp-3.7 {testing interp exists and interp slaves} {
1.153 + interp slaves
1.154 +} a
1.155 +test interp-3.8 {testing interp exists and interp slaves} {
1.156 + list [catch {interp slaves a b c} msg] $msg
1.157 +} {1 {wrong # args: should be "interp slaves ?path?"}}
1.158 +test interp-3.9 {testing interp exists and interp slaves} {
1.159 + interp create {a a2} -safe
1.160 + expr {[lsearch [interp slaves a] a2] >= 0}
1.161 +} 1
1.162 +test interp-3.10 {testing interp exists and interp slaves} {
1.163 + interp exists {a a2}
1.164 +} 1
1.165 +
1.166 +# Part 3: Testing "interp delete"
1.167 +test interp-3.11 {testing interp delete} {
1.168 + interp delete
1.169 +} ""
1.170 +test interp-4.1 {testing interp delete} {
1.171 + catch {interp create a}
1.172 + interp delete a
1.173 +} ""
1.174 +test interp-4.2 {testing interp delete} {
1.175 + list [catch {interp delete nonexistent} msg] $msg
1.176 +} {1 {could not find interpreter "nonexistent"}}
1.177 +test interp-4.3 {testing interp delete} {
1.178 + list [catch {interp delete x y z} msg] $msg
1.179 +} {1 {could not find interpreter "x"}}
1.180 +test interp-4.4 {testing interp delete} {
1.181 + interp delete
1.182 +} ""
1.183 +test interp-4.5 {testing interp delete} {
1.184 + interp create a
1.185 + interp create {a x1}
1.186 + interp delete {a x1}
1.187 + expr {[lsearch [interp slaves a] x1] >= 0}
1.188 +} 0
1.189 +test interp-4.6 {testing interp delete} {
1.190 + interp create c1
1.191 + interp create c2
1.192 + interp create c3
1.193 + interp delete c1 c2 c3
1.194 +} ""
1.195 +test interp-4.7 {testing interp delete} {
1.196 + interp create c1
1.197 + interp create c2
1.198 + list [catch {interp delete c1 c2 c3} msg] $msg
1.199 +} {1 {could not find interpreter "c3"}}
1.200 +test interp-4.8 {testing interp delete} {
1.201 + list [catch {interp delete {}} msg] $msg
1.202 +} {1 {cannot delete the current interpreter}}
1.203 +
1.204 +foreach i [interp slaves] {
1.205 + interp delete $i
1.206 +}
1.207 +
1.208 +# Part 4: Consistency checking - all nondeleted interpreters should be
1.209 +# there:
1.210 +test interp-5.1 {testing consistency} {
1.211 + interp slaves
1.212 +} ""
1.213 +test interp-5.2 {testing consistency} {
1.214 + interp exists a
1.215 +} 0
1.216 +test interp-5.3 {testing consistency} {
1.217 + interp exists nonexistent
1.218 +} 0
1.219 +
1.220 +# Recreate interpreter "a"
1.221 +interp create a
1.222 +
1.223 +# Part 5: Testing eval in interpreter object command and with interp command
1.224 +test interp-6.1 {testing eval} {
1.225 + a eval expr 3 + 5
1.226 +} 8
1.227 +test interp-6.2 {testing eval} {
1.228 + list [catch {a eval foo} msg] $msg
1.229 +} {1 {invalid command name "foo"}}
1.230 +test interp-6.3 {testing eval} {
1.231 + a eval {proc foo {} {expr 3 + 5}}
1.232 + a eval foo
1.233 +} 8
1.234 +test interp-6.4 {testing eval} {
1.235 + interp eval a foo
1.236 +} 8
1.237 +
1.238 +test interp-6.5 {testing eval} {
1.239 + interp create {a x2}
1.240 + interp eval {a x2} {proc frob {} {expr 4 * 9}}
1.241 + interp eval {a x2} frob
1.242 +} 36
1.243 +test interp-6.6 {testing eval} {
1.244 + list [catch {interp eval {a x2} foo} msg] $msg
1.245 +} {1 {invalid command name "foo"}}
1.246 +
1.247 +# UTILITY PROCEDURE RUNNING IN MASTER INTERPRETER:
1.248 +proc in_master {args} {
1.249 + return [list seen in master: $args]
1.250 +}
1.251 +
1.252 +# Part 6: Testing basic alias creation
1.253 +test interp-7.1 {testing basic alias creation} {
1.254 + a alias foo in_master
1.255 +} foo
1.256 +test interp-7.2 {testing basic alias creation} {
1.257 + a alias bar in_master a1 a2 a3
1.258 +} bar
1.259 +# Test 6.3 has been deleted.
1.260 +test interp-7.3 {testing basic alias creation} {
1.261 + a alias foo
1.262 +} in_master
1.263 +test interp-7.4 {testing basic alias creation} {
1.264 + a alias bar
1.265 +} {in_master a1 a2 a3}
1.266 +test interp-7.5 {testing basic alias creation} {
1.267 + lsort [a aliases]
1.268 +} {bar foo}
1.269 +test interp-7.6 {testing basic aliases arg checking} {
1.270 + list [catch {a aliases too many args} msg] $msg
1.271 +} {1 {wrong # args: should be "a aliases"}}
1.272 +
1.273 +# Part 7: testing basic alias invocation
1.274 +test interp-8.1 {testing basic alias invocation} {
1.275 + catch {interp create a}
1.276 + a alias foo in_master
1.277 + a eval foo s1 s2 s3
1.278 +} {seen in master: {s1 s2 s3}}
1.279 +test interp-8.2 {testing basic alias invocation} {
1.280 + catch {interp create a}
1.281 + a alias bar in_master a1 a2 a3
1.282 + a eval bar s1 s2 s3
1.283 +} {seen in master: {a1 a2 a3 s1 s2 s3}}
1.284 +test interp-8.3 {testing basic alias invocation} {
1.285 + catch {interp create a}
1.286 + list [catch {a alias} msg] $msg
1.287 +} {1 {wrong # args: should be "a alias aliasName ?targetName? ?args..?"}}
1.288 +
1.289 +# Part 8: Testing aliases for non-existent or hidden targets
1.290 +test interp-9.1 {testing aliases for non-existent targets} {
1.291 + catch {interp create a}
1.292 + a alias zop nonexistent-command-in-master
1.293 + list [catch {a eval zop} msg] $msg
1.294 +} {1 {invalid command name "nonexistent-command-in-master"}}
1.295 +test interp-9.2 {testing aliases for non-existent targets} {
1.296 + catch {interp create a}
1.297 + a alias zop nonexistent-command-in-master
1.298 + proc nonexistent-command-in-master {} {return i_exist!}
1.299 + a eval zop
1.300 +} i_exist!
1.301 +test interp-9.3 {testing aliases for hidden commands} {
1.302 + catch {interp create a}
1.303 + a eval {proc p {} {return ENTER_A}}
1.304 + interp alias {} p a p
1.305 + set res {}
1.306 + lappend res [list [catch p msg] $msg]
1.307 + interp hide a p
1.308 + lappend res [list [catch p msg] $msg]
1.309 + rename p {}
1.310 + interp delete a
1.311 + set res
1.312 + } {{0 ENTER_A} {1 {invalid command name "p"}}}
1.313 +test interp-9.4 {testing aliases and namespace commands} {
1.314 + proc p {} {return GLOBAL}
1.315 + namespace eval tst {
1.316 + proc p {} {return NAMESPACE}
1.317 + }
1.318 + interp alias {} a {} p
1.319 + set res [a]
1.320 + lappend res [namespace eval tst a]
1.321 + rename p {}
1.322 + rename a {}
1.323 + namespace delete tst
1.324 + set res
1.325 + } {GLOBAL GLOBAL}
1.326 +
1.327 +if {[info command nonexistent-command-in-master] != ""} {
1.328 + rename nonexistent-command-in-master {}
1.329 +}
1.330 +
1.331 +# Part 9: Aliasing between interpreters
1.332 +test interp-10.1 {testing aliasing between interpreters} {
1.333 + catch {interp delete a}
1.334 + catch {interp delete b}
1.335 + interp create a
1.336 + interp create b
1.337 + interp alias a a_alias b b_alias 1 2 3
1.338 +} a_alias
1.339 +test interp-10.2 {testing aliasing between interpreters} {
1.340 + catch {interp delete a}
1.341 + catch {interp delete b}
1.342 + interp create a
1.343 + interp create b
1.344 + b eval {proc b_alias {args} {return [list got $args]}}
1.345 + interp alias a a_alias b b_alias 1 2 3
1.346 + a eval a_alias a b c
1.347 +} {got {1 2 3 a b c}}
1.348 +test interp-10.3 {testing aliasing between interpreters} {
1.349 + catch {interp delete a}
1.350 + catch {interp delete b}
1.351 + interp create a
1.352 + interp create b
1.353 + interp alias a a_alias b b_alias 1 2 3
1.354 + list [catch {a eval a_alias a b c} msg] $msg
1.355 +} {1 {invalid command name "b_alias"}}
1.356 +test interp-10.4 {testing aliasing between interpreters} {
1.357 + catch {interp delete a}
1.358 + interp create a
1.359 + a alias a_alias puts
1.360 + a aliases
1.361 +} a_alias
1.362 +test interp-10.5 {testing aliasing between interpreters} {
1.363 + catch {interp delete a}
1.364 + catch {interp delete b}
1.365 + interp create a
1.366 + interp create b
1.367 + a alias a_alias puts
1.368 + interp alias a a_del b b_del
1.369 + interp delete b
1.370 + a aliases
1.371 +} a_alias
1.372 +test interp-10.6 {testing aliasing between interpreters} {
1.373 + catch {interp delete a}
1.374 + catch {interp delete b}
1.375 + interp create a
1.376 + interp create b
1.377 + interp alias a a_command b b_command a1 a2 a3
1.378 + b alias b_command in_master b1 b2 b3
1.379 + a eval a_command m1 m2 m3
1.380 +} {seen in master: {b1 b2 b3 a1 a2 a3 m1 m2 m3}}
1.381 +test interp-10.7 {testing aliases between interpreters} {
1.382 + catch {interp delete a}
1.383 + interp create a
1.384 + interp alias "" foo a zoppo
1.385 + a eval {proc zoppo {x} {list $x $x $x}}
1.386 + set x [foo 33]
1.387 + a eval {rename zoppo {}}
1.388 + interp alias "" foo a {}
1.389 + equiv $x
1.390 +} {33 33 33}
1.391 +
1.392 +# Part 10: Testing "interp target"
1.393 +test interp-11.1 {testing interp target} {
1.394 + list [catch {interp target} msg] $msg
1.395 +} {1 {wrong # args: should be "interp target path alias"}}
1.396 +test interp-11.2 {testing interp target} {
1.397 + list [catch {interp target nosuchinterpreter foo} msg] $msg
1.398 +} {1 {could not find interpreter "nosuchinterpreter"}}
1.399 +test interp-11.3 {testing interp target} {
1.400 + catch {interp delete a}
1.401 + interp create a
1.402 + a alias boo no_command
1.403 + interp target a boo
1.404 +} ""
1.405 +test interp-11.4 {testing interp target} {
1.406 + catch {interp delete x1}
1.407 + interp create x1
1.408 + x1 eval interp create x2
1.409 + x1 eval x2 eval interp create x3
1.410 + catch {interp delete y1}
1.411 + interp create y1
1.412 + y1 eval interp create y2
1.413 + y1 eval y2 eval interp create y3
1.414 + interp alias {x1 x2 x3} xcommand {y1 y2 y3} ycommand
1.415 + interp target {x1 x2 x3} xcommand
1.416 +} {y1 y2 y3}
1.417 +test interp-11.5 {testing interp target} {
1.418 + catch {interp delete x1}
1.419 + interp create x1
1.420 + interp create {x1 x2}
1.421 + interp create {x1 x2 x3}
1.422 + catch {interp delete y1}
1.423 + interp create y1
1.424 + interp create {y1 y2}
1.425 + interp create {y1 y2 y3}
1.426 + interp alias {x1 x2 x3} xcommand {y1 y2 y3} ycommand
1.427 + list [catch {x1 eval {interp target {x2 x3} xcommand}} msg] $msg
1.428 +} {1 {target interpreter for alias "xcommand" in path "x2 x3" is not my descendant}}
1.429 +test interp-11.6 {testing interp target} {
1.430 + foreach a [interp aliases] {
1.431 + rename $a {}
1.432 + }
1.433 + list [catch {interp target {} foo} msg] $msg
1.434 +} {1 {alias "foo" in path "" not found}}
1.435 +test interp-11.7 {testing interp target} {
1.436 + catch {interp delete a}
1.437 + interp create a
1.438 + list [catch {interp target a foo} msg] $msg
1.439 +} {1 {alias "foo" in path "a" not found}}
1.440 +
1.441 +# Part 11: testing "interp issafe"
1.442 +test interp-12.1 {testing interp issafe} {
1.443 + interp issafe
1.444 +} 0
1.445 +test interp-12.2 {testing interp issafe} {
1.446 + catch {interp delete a}
1.447 + interp create a
1.448 + interp issafe a
1.449 +} 0
1.450 +test interp-12.3 {testing interp issafe} {
1.451 + catch {interp delete a}
1.452 + interp create a
1.453 + interp create {a x3} -safe
1.454 + interp issafe {a x3}
1.455 +} 1
1.456 +test interp-12.4 {testing interp issafe} {
1.457 + catch {interp delete a}
1.458 + interp create a
1.459 + interp create {a x3} -safe
1.460 + interp create {a x3 foo}
1.461 + interp issafe {a x3 foo}
1.462 +} 1
1.463 +
1.464 +# Part 12: testing interpreter object command "issafe" sub-command
1.465 +test interp-13.1 {testing foo issafe} {
1.466 + catch {interp delete a}
1.467 + interp create a
1.468 + a issafe
1.469 +} 0
1.470 +test interp-13.2 {testing foo issafe} {
1.471 + catch {interp delete a}
1.472 + interp create a
1.473 + interp create {a x3} -safe
1.474 + a eval x3 issafe
1.475 +} 1
1.476 +test interp-13.3 {testing foo issafe} {
1.477 + catch {interp delete a}
1.478 + interp create a
1.479 + interp create {a x3} -safe
1.480 + interp create {a x3 foo}
1.481 + a eval x3 eval foo issafe
1.482 +} 1
1.483 +test interp-13.4 {testing issafe arg checking} {
1.484 + catch {interp create a}
1.485 + list [catch {a issafe too many args} msg] $msg
1.486 +} {1 {wrong # args: should be "a issafe"}}
1.487 +
1.488 +# part 14: testing interp aliases
1.489 +test interp-14.1 {testing interp aliases} {
1.490 + interp aliases
1.491 +} ""
1.492 +test interp-14.2 {testing interp aliases} {
1.493 + catch {interp delete a}
1.494 + interp create a
1.495 + a alias a1 puts
1.496 + a alias a2 puts
1.497 + a alias a3 puts
1.498 + lsort [interp aliases a]
1.499 +} {a1 a2 a3}
1.500 +test interp-14.3 {testing interp aliases} {
1.501 + catch {interp delete a}
1.502 + interp create a
1.503 + interp create {a x3}
1.504 + interp alias {a x3} froboz "" puts
1.505 + interp aliases {a x3}
1.506 +} froboz
1.507 +test interp-14.4 {testing interp alias - alias over master} {
1.508 + # SF Bug 641195
1.509 + catch {interp delete a}
1.510 + interp create a
1.511 + list [catch {interp alias "" a a eval} msg] $msg [info commands a]
1.512 +} {1 {cannot define or rename alias "a": interpreter deleted} {}}
1.513 +
1.514 +# part 15: testing file sharing
1.515 +test interp-15.1 {testing file sharing} {
1.516 + catch {interp delete z}
1.517 + interp create z
1.518 + z eval close stdout
1.519 + list [catch {z eval puts hello} msg] $msg
1.520 +} {1 {can not find channel named "stdout"}}
1.521 +test interp-15.2 {testing file sharing} -body {
1.522 + catch {interp delete z}
1.523 + interp create z
1.524 + set f [open [makeFile {} file-15.2] w]
1.525 + interp share "" $f z
1.526 + z eval puts $f hello
1.527 + z eval close $f
1.528 + close $f
1.529 +} -cleanup {
1.530 + removeFile file-15.2
1.531 +} -result ""
1.532 +test interp-15.3 {testing file sharing} {
1.533 + catch {interp delete xsafe}
1.534 + interp create xsafe -safe
1.535 + list [catch {xsafe eval puts hello} msg] $msg
1.536 +} {1 {can not find channel named "stdout"}}
1.537 +test interp-15.4 {testing file sharing} -body {
1.538 + catch {interp delete xsafe}
1.539 + interp create xsafe -safe
1.540 + set f [open [makeFile {} file-15.4] w]
1.541 + interp share "" $f xsafe
1.542 + xsafe eval puts $f hello
1.543 + xsafe eval close $f
1.544 + close $f
1.545 +} -cleanup {
1.546 + removeFile file-15.4
1.547 +} -result ""
1.548 +test interp-15.5 {testing file sharing} {
1.549 + catch {interp delete xsafe}
1.550 + interp create xsafe -safe
1.551 + interp share "" stdout xsafe
1.552 + list [catch {xsafe eval gets stdout} msg] $msg
1.553 +} {1 {channel "stdout" wasn't opened for reading}}
1.554 +test interp-15.6 {testing file sharing} -body {
1.555 + catch {interp delete xsafe}
1.556 + interp create xsafe -safe
1.557 + set f [open [makeFile {} file-15.6] w]
1.558 + interp share "" $f xsafe
1.559 + set x [list [catch [list xsafe eval gets $f] msg] $msg]
1.560 + xsafe eval close $f
1.561 + close $f
1.562 + string compare [string tolower $x] \
1.563 + [list 1 [format "channel \"%s\" wasn't opened for reading" $f]]
1.564 +} -cleanup {
1.565 + removeFile file-15.6
1.566 +} -result 0
1.567 +test interp-15.7 {testing file transferring} -body {
1.568 + catch {interp delete xsafe}
1.569 + interp create xsafe -safe
1.570 + set f [open [makeFile {} file-15.7] w]
1.571 + interp transfer "" $f xsafe
1.572 + xsafe eval puts $f hello
1.573 + xsafe eval close $f
1.574 +} -cleanup {
1.575 + removeFile file-15.7
1.576 +} -result ""
1.577 +test interp-15.8 {testing file transferring} -body {
1.578 + catch {interp delete xsafe}
1.579 + interp create xsafe -safe
1.580 + set f [open [makeFile {} file-15.8] w]
1.581 + interp transfer "" $f xsafe
1.582 + xsafe eval close $f
1.583 + set x [list [catch {close $f} msg] $msg]
1.584 + string compare [string tolower $x] \
1.585 + [list 1 [format "can not find channel named \"%s\"" $f]]
1.586 +} -cleanup {
1.587 + removeFile file-15.8
1.588 +} -result 0
1.589 +
1.590 +#
1.591 +# Torture tests for interpreter deletion order
1.592 +#
1.593 +proc kill {} {interp delete xxx}
1.594 +
1.595 +test interp-15.9 {testing deletion order} {
1.596 + catch {interp delete xxx}
1.597 + interp create xxx
1.598 + xxx alias kill kill
1.599 + list [catch {xxx eval kill} msg] $msg
1.600 +} {0 {}}
1.601 +test interp-16.1 {testing deletion order} {
1.602 + catch {interp delete xxx}
1.603 + interp create xxx
1.604 + interp create {xxx yyy}
1.605 + interp alias {xxx yyy} kill "" kill
1.606 + list [catch {interp eval {xxx yyy} kill} msg] $msg
1.607 +} {0 {}}
1.608 +test interp-16.2 {testing deletion order} {
1.609 + catch {interp delete xxx}
1.610 + interp create xxx
1.611 + interp create {xxx yyy}
1.612 + interp alias {xxx yyy} kill "" kill
1.613 + list [catch {xxx eval yyy eval kill} msg] $msg
1.614 +} {0 {}}
1.615 +test interp-16.3 {testing deletion order} {
1.616 + catch {interp delete xxx}
1.617 + interp create xxx
1.618 + interp create ddd
1.619 + xxx alias kill kill
1.620 + interp alias ddd kill xxx kill
1.621 + set x [ddd eval kill]
1.622 + interp delete ddd
1.623 + set x
1.624 +} ""
1.625 +test interp-16.4 {testing deletion order} {
1.626 + catch {interp delete xxx}
1.627 + interp create xxx
1.628 + interp create {xxx yyy}
1.629 + interp alias {xxx yyy} kill "" kill
1.630 + interp create ddd
1.631 + interp alias ddd kill {xxx yyy} kill
1.632 + set x [ddd eval kill]
1.633 + interp delete ddd
1.634 + set x
1.635 +} ""
1.636 +test interp-16.5 {testing deletion order, bgerror} {
1.637 + catch {interp delete xxx}
1.638 + interp create xxx
1.639 + xxx eval {proc bgerror {args} {exit}}
1.640 + xxx alias exit kill xxx
1.641 + proc kill {i} {interp delete $i}
1.642 + xxx eval after 100 expr a + b
1.643 + after 200
1.644 + update
1.645 + interp exists xxx
1.646 +} 0
1.647 +
1.648 +#
1.649 +# Alias loop prevention testing.
1.650 +#
1.651 +
1.652 +test interp-17.1 {alias loop prevention} {
1.653 + list [catch {interp alias {} a {} a} msg] $msg
1.654 +} {1 {cannot define or rename alias "a": would create a loop}}
1.655 +test interp-17.2 {alias loop prevention} {
1.656 + catch {interp delete x}
1.657 + interp create x
1.658 + x alias a loop
1.659 + list [catch {interp alias {} loop x a} msg] $msg
1.660 +} {1 {cannot define or rename alias "loop": would create a loop}}
1.661 +test interp-17.3 {alias loop prevention} {
1.662 + catch {interp delete x}
1.663 + interp create x
1.664 + interp alias x a x b
1.665 + list [catch {interp alias x b x a} msg] $msg
1.666 +} {1 {cannot define or rename alias "b": would create a loop}}
1.667 +test interp-17.4 {alias loop prevention} {
1.668 + catch {interp delete x}
1.669 + interp create x
1.670 + interp alias x b x a
1.671 + list [catch {x eval rename b a} msg] $msg
1.672 +} {1 {cannot define or rename alias "b": would create a loop}}
1.673 +test interp-17.5 {alias loop prevention} {
1.674 + catch {interp delete x}
1.675 + interp create x
1.676 + x alias z l1
1.677 + interp alias {} l2 x z
1.678 + list [catch {rename l2 l1} msg] $msg
1.679 +} {1 {cannot define or rename alias "l2": would create a loop}}
1.680 +
1.681 +#
1.682 +# Test robustness of Tcl_DeleteInterp when applied to a slave interpreter.
1.683 +# If there are bugs in the implementation these tests are likely to expose
1.684 +# the bugs as a core dump.
1.685 +#
1.686 +
1.687 +if {[info commands testinterpdelete] == ""} {
1.688 + puts "This application hasn't been compiled with the \"testinterpdelete\""
1.689 + puts "command, so I can't test slave delete calls"
1.690 +} else {
1.691 + test interp-18.1 {testing Tcl_DeleteInterp vs slaves} {
1.692 + list [catch {testinterpdelete} msg] $msg
1.693 + } {1 {wrong # args: should be "testinterpdelete path"}}
1.694 + test interp-18.2 {testing Tcl_DeleteInterp vs slaves} {
1.695 + catch {interp delete a}
1.696 + interp create a
1.697 + testinterpdelete a
1.698 + } ""
1.699 + test interp-18.3 {testing Tcl_DeleteInterp vs slaves} {
1.700 + catch {interp delete a}
1.701 + interp create a
1.702 + interp create {a b}
1.703 + testinterpdelete {a b}
1.704 + } ""
1.705 + test interp-18.4 {testing Tcl_DeleteInterp vs slaves} {
1.706 + catch {interp delete a}
1.707 + interp create a
1.708 + interp create {a b}
1.709 + testinterpdelete a
1.710 + } ""
1.711 + test interp-18.5 {testing Tcl_DeleteInterp vs slaves} {
1.712 + catch {interp delete a}
1.713 + interp create a
1.714 + interp create {a b}
1.715 + interp alias {a b} dodel {} dodel
1.716 + proc dodel {x} {testinterpdelete $x}
1.717 + list [catch {interp eval {a b} {dodel {a b}}} msg] $msg
1.718 + } {0 {}}
1.719 + test interp-18.6 {testing Tcl_DeleteInterp vs slaves} {
1.720 + catch {interp delete a}
1.721 + interp create a
1.722 + interp create {a b}
1.723 + interp alias {a b} dodel {} dodel
1.724 + proc dodel {x} {testinterpdelete $x}
1.725 + list [catch {interp eval {a b} {dodel a}} msg] $msg
1.726 + } {0 {}}
1.727 + test interp-18.7 {eval in deleted interp} {
1.728 + catch {interp delete a}
1.729 + interp create a
1.730 + a eval {
1.731 + proc dodel {} {
1.732 + delme
1.733 + dosomething else
1.734 + }
1.735 + proc dosomething args {
1.736 + puts "I should not have been called!!"
1.737 + }
1.738 + }
1.739 + a alias delme dela
1.740 + proc dela {} {interp delete a}
1.741 + list [catch {a eval dodel} msg] $msg
1.742 + } {1 {attempt to call eval in deleted interpreter}}
1.743 + test interp-18.8 {eval in deleted interp} {
1.744 + catch {interp delete a}
1.745 + interp create a
1.746 + a eval {
1.747 + interp create b
1.748 + b eval {
1.749 + proc dodel {} {
1.750 + dela
1.751 + }
1.752 + }
1.753 + proc foo {} {
1.754 + b eval dela
1.755 + dosomething else
1.756 + }
1.757 + proc dosomething args {
1.758 + puts "I should not have been called!!"
1.759 + }
1.760 + }
1.761 + interp alias {a b} dela {} dela
1.762 + proc dela {} {interp delete a}
1.763 + list [catch {a eval foo} msg] $msg
1.764 + } {1 {attempt to call eval in deleted interpreter}}
1.765 +}
1.766 +test interp-18.9 {eval in deleted interp, bug 495830} {knownBug} {
1.767 + interp create tst
1.768 + interp alias tst suicide {} interp delete tst
1.769 + list [catch {tst eval {suicide; set a 5}} msg] $msg
1.770 +} {1 {attempt to call eval in deleted interpreter}}
1.771 +test interp-18.10 {eval in deleted interp, bug 495830} {
1.772 + interp create tst
1.773 + interp alias tst suicide {} interp delete tst
1.774 + list [catch {tst eval {set set set; suicide; $set a 5}} msg] $msg
1.775 +} {1 {attempt to call eval in deleted interpreter}}
1.776 +
1.777 +# Test alias deletion
1.778 +
1.779 +test interp-19.1 {alias deletion} {
1.780 + catch {interp delete a}
1.781 + interp create a
1.782 + interp alias a foo a bar
1.783 + set s [interp alias a foo {}]
1.784 + interp delete a
1.785 + set s
1.786 +} {}
1.787 +test interp-19.2 {alias deletion} {
1.788 + catch {interp delete a}
1.789 + interp create a
1.790 + catch {interp alias a foo {}} msg
1.791 + interp delete a
1.792 + set msg
1.793 +} {alias "foo" not found}
1.794 +test interp-19.3 {alias deletion} {
1.795 + catch {interp delete a}
1.796 + interp create a
1.797 + interp alias a foo a bar
1.798 + interp eval a {rename foo zop}
1.799 + interp alias a foo a zop
1.800 + catch {interp eval a foo} msg
1.801 + interp delete a
1.802 + set msg
1.803 +} {invalid command name "zop"}
1.804 +test interp-19.4 {alias deletion} {
1.805 + catch {interp delete a}
1.806 + interp create a
1.807 + interp alias a foo a bar
1.808 + interp eval a {rename foo zop}
1.809 + catch {interp eval a foo} msg
1.810 + interp delete a
1.811 + set msg
1.812 +} {invalid command name "foo"}
1.813 +test interp-19.5 {alias deletion} {
1.814 + catch {interp delete a}
1.815 + interp create a
1.816 + interp eval a {proc bar {} {return 1}}
1.817 + interp alias a foo a bar
1.818 + interp eval a {rename foo zop}
1.819 + catch {interp eval a zop} msg
1.820 + interp delete a
1.821 + set msg
1.822 +} 1
1.823 +test interp-19.6 {alias deletion} {
1.824 + catch {interp delete a}
1.825 + interp create a
1.826 + interp alias a foo a bar
1.827 + interp eval a {rename foo zop}
1.828 + interp alias a foo a zop
1.829 + set s [interp aliases a]
1.830 + interp delete a
1.831 + set s
1.832 +} foo
1.833 +test interp-19.7 {alias deletion, renaming} {
1.834 + catch {interp delete a}
1.835 + interp create a
1.836 + interp alias a foo a bar
1.837 + interp eval a rename foo blotz
1.838 + interp alias a foo {}
1.839 + set s [interp aliases a]
1.840 + interp delete a
1.841 + set s
1.842 +} {}
1.843 +test interp-19.8 {alias deletion, renaming} {
1.844 + catch {interp delete a}
1.845 + interp create a
1.846 + interp alias a foo a bar
1.847 + interp eval a rename foo blotz
1.848 + set l ""
1.849 + lappend l [interp aliases a]
1.850 + interp alias a foo {}
1.851 + lappend l [interp aliases a]
1.852 + interp delete a
1.853 + set l
1.854 +} {foo {}}
1.855 +test interp-19.9 {alias deletion, renaming} {
1.856 + catch {interp delete a}
1.857 + interp create a
1.858 + interp alias a foo a bar
1.859 + interp eval a rename foo blotz
1.860 + interp eval a {proc foo {} {expr 34 * 34}}
1.861 + interp alias a foo {}
1.862 + set l [interp eval a foo]
1.863 + interp delete a
1.864 + set l
1.865 +} 1156
1.866 +
1.867 +test interp-20.1 {interp hide, interp expose and interp invokehidden} {
1.868 + catch {interp delete a}
1.869 + interp create a
1.870 + a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
1.871 + a eval {proc foo {} {}}
1.872 + a hide foo
1.873 + catch {a eval foo something} msg
1.874 + interp delete a
1.875 + set msg
1.876 +} {invalid command name "foo"}
1.877 +test interp-20.2 {interp hide, interp expose and interp invokehidden} {
1.878 + catch {interp delete a}
1.879 + interp create a
1.880 + a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
1.881 + a hide list
1.882 + set l ""
1.883 + lappend l [catch {a eval {list 1 2 3}} msg]
1.884 + lappend l $msg
1.885 + a expose list
1.886 + lappend l [catch {a eval {list 1 2 3}} msg]
1.887 + lappend l $msg
1.888 + interp delete a
1.889 + set l
1.890 +} {1 {invalid command name "list"} 0 {1 2 3}}
1.891 +test interp-20.3 {interp hide, interp expose and interp invokehidden} {
1.892 + catch {interp delete a}
1.893 + interp create a
1.894 + a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
1.895 + a hide list
1.896 + set l ""
1.897 + lappend l [catch {a eval {list 1 2 3}} msg]
1.898 + lappend l $msg
1.899 + lappend l [catch {a invokehidden list 1 2 3} msg]
1.900 + lappend l $msg
1.901 + a expose list
1.902 + lappend l [catch {a eval {list 1 2 3}} msg]
1.903 + lappend l $msg
1.904 + interp delete a
1.905 + set l
1.906 +} {1 {invalid command name "list"} 0 {1 2 3} 0 {1 2 3}}
1.907 +test interp-20.4 {interp hide, interp expose and interp invokehidden -- passing {}} {
1.908 + catch {interp delete a}
1.909 + interp create a
1.910 + a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
1.911 + a hide list
1.912 + set l ""
1.913 + lappend l [catch {a eval {list 1 2 3}} msg]
1.914 + lappend l $msg
1.915 + lappend l [catch {a invokehidden list {"" 1 2 3}} msg]
1.916 + lappend l $msg
1.917 + a expose list
1.918 + lappend l [catch {a eval {list 1 2 3}} msg]
1.919 + lappend l $msg
1.920 + interp delete a
1.921 + set l
1.922 +} {1 {invalid command name "list"} 0 {{"" 1 2 3}} 0 {1 2 3}}
1.923 +test interp-20.5 {interp hide, interp expose and interp invokehidden -- passing {}} {
1.924 + catch {interp delete a}
1.925 + interp create a
1.926 + a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
1.927 + a hide list
1.928 + set l ""
1.929 + lappend l [catch {a eval {list 1 2 3}} msg]
1.930 + lappend l $msg
1.931 + lappend l [catch {a invokehidden list {{} 1 2 3}} msg]
1.932 + lappend l $msg
1.933 + a expose list
1.934 + lappend l [catch {a eval {list 1 2 3}} msg]
1.935 + lappend l $msg
1.936 + interp delete a
1.937 + set l
1.938 +} {1 {invalid command name "list"} 0 {{{} 1 2 3}} 0 {1 2 3}}
1.939 +test interp-20.6 {interp invokehidden -- eval args} {
1.940 + catch {interp delete a}
1.941 + interp create a
1.942 + a hide list
1.943 + set l ""
1.944 + set z 45
1.945 + lappend l [catch {a invokehidden list $z 1 2 3} msg]
1.946 + lappend l $msg
1.947 + a expose list
1.948 + lappend l [catch {a eval list $z 1 2 3} msg]
1.949 + lappend l $msg
1.950 + interp delete a
1.951 + set l
1.952 +} {0 {45 1 2 3} 0 {45 1 2 3}}
1.953 +test interp-20.7 {interp invokehidden vs variable eval} {
1.954 + catch {interp delete a}
1.955 + interp create a
1.956 + a hide list
1.957 + set z 45
1.958 + set l ""
1.959 + lappend l [catch {a invokehidden list {$z a b c}} msg]
1.960 + lappend l $msg
1.961 + interp delete a
1.962 + set l
1.963 +} {0 {{$z a b c}}}
1.964 +test interp-20.8 {interp invokehidden vs variable eval} {
1.965 + catch {interp delete a}
1.966 + interp create a
1.967 + a hide list
1.968 + a eval set z 89
1.969 + set z 45
1.970 + set l ""
1.971 + lappend l [catch {a invokehidden list {$z a b c}} msg]
1.972 + lappend l $msg
1.973 + interp delete a
1.974 + set l
1.975 +} {0 {{$z a b c}}}
1.976 +test interp-20.9 {interp invokehidden vs variable eval} {
1.977 + catch {interp delete a}
1.978 + interp create a
1.979 + a hide list
1.980 + a eval set z 89
1.981 + set z 45
1.982 + set l ""
1.983 + lappend l [catch {a invokehidden list $z {$z a b c}} msg]
1.984 + lappend l $msg
1.985 + interp delete a
1.986 + set l
1.987 +} {0 {45 {$z a b c}}}
1.988 +test interp-20.10 {interp hide, interp expose and interp invokehidden} {
1.989 + catch {interp delete a}
1.990 + interp create a
1.991 + a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
1.992 + a eval {proc foo {} {}}
1.993 + interp hide a foo
1.994 + catch {interp eval a foo something} msg
1.995 + interp delete a
1.996 + set msg
1.997 +} {invalid command name "foo"}
1.998 +test interp-20.11 {interp hide, interp expose and interp invokehidden} {
1.999 + catch {interp delete a}
1.1000 + interp create a
1.1001 + a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
1.1002 + interp hide a list
1.1003 + set l ""
1.1004 + lappend l [catch {interp eval a {list 1 2 3}} msg]
1.1005 + lappend l $msg
1.1006 + interp expose a list
1.1007 + lappend l [catch {interp eval a {list 1 2 3}} msg]
1.1008 + lappend l $msg
1.1009 + interp delete a
1.1010 + set l
1.1011 +} {1 {invalid command name "list"} 0 {1 2 3}}
1.1012 +test interp-20.12 {interp hide, interp expose and interp invokehidden} {
1.1013 + catch {interp delete a}
1.1014 + interp create a
1.1015 + a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
1.1016 + interp hide a list
1.1017 + set l ""
1.1018 + lappend l [catch {interp eval a {list 1 2 3}} msg]
1.1019 + lappend l $msg
1.1020 + lappend l [catch {interp invokehidden a list 1 2 3} msg]
1.1021 + lappend l $msg
1.1022 + interp expose a list
1.1023 + lappend l [catch {interp eval a {list 1 2 3}} msg]
1.1024 + lappend l $msg
1.1025 + interp delete a
1.1026 + set l
1.1027 +} {1 {invalid command name "list"} 0 {1 2 3} 0 {1 2 3}}
1.1028 +test interp-20.13 {interp hide, interp expose, interp invokehidden -- passing {}} {
1.1029 + catch {interp delete a}
1.1030 + interp create a
1.1031 + a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
1.1032 + interp hide a list
1.1033 + set l ""
1.1034 + lappend l [catch {interp eval a {list 1 2 3}} msg]
1.1035 + lappend l $msg
1.1036 + lappend l [catch {interp invokehidden a list {"" 1 2 3}} msg]
1.1037 + lappend l $msg
1.1038 + interp expose a list
1.1039 + lappend l [catch {interp eval a {list 1 2 3}} msg]
1.1040 + lappend l $msg
1.1041 + interp delete a
1.1042 + set l
1.1043 +} {1 {invalid command name "list"} 0 {{"" 1 2 3}} 0 {1 2 3}}
1.1044 +test interp-20.14 {interp hide, interp expose, interp invokehidden -- passing {}} {
1.1045 + catch {interp delete a}
1.1046 + interp create a
1.1047 + a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
1.1048 + interp hide a list
1.1049 + set l ""
1.1050 + lappend l [catch {interp eval a {list 1 2 3}} msg]
1.1051 + lappend l $msg
1.1052 + lappend l [catch {interp invokehidden a list {{} 1 2 3}} msg]
1.1053 + lappend l $msg
1.1054 + interp expose a list
1.1055 + lappend l [catch {a eval {list 1 2 3}} msg]
1.1056 + lappend l $msg
1.1057 + interp delete a
1.1058 + set l
1.1059 +} {1 {invalid command name "list"} 0 {{{} 1 2 3}} 0 {1 2 3}}
1.1060 +test interp-20.15 {interp invokehidden -- eval args} {
1.1061 + catch {interp delete a}
1.1062 + interp create a
1.1063 + interp hide a list
1.1064 + set l ""
1.1065 + set z 45
1.1066 + lappend l [catch {interp invokehidden a list $z 1 2 3} msg]
1.1067 + lappend l $msg
1.1068 + a expose list
1.1069 + lappend l [catch {interp eval a list $z 1 2 3} msg]
1.1070 + lappend l $msg
1.1071 + interp delete a
1.1072 + set l
1.1073 +} {0 {45 1 2 3} 0 {45 1 2 3}}
1.1074 +test interp-20.16 {interp invokehidden vs variable eval} {
1.1075 + catch {interp delete a}
1.1076 + interp create a
1.1077 + interp hide a list
1.1078 + set z 45
1.1079 + set l ""
1.1080 + lappend l [catch {interp invokehidden a list {$z a b c}} msg]
1.1081 + lappend l $msg
1.1082 + interp delete a
1.1083 + set l
1.1084 +} {0 {{$z a b c}}}
1.1085 +test interp-20.17 {interp invokehidden vs variable eval} {
1.1086 + catch {interp delete a}
1.1087 + interp create a
1.1088 + interp hide a list
1.1089 + a eval set z 89
1.1090 + set z 45
1.1091 + set l ""
1.1092 + lappend l [catch {interp invokehidden a list {$z a b c}} msg]
1.1093 + lappend l $msg
1.1094 + interp delete a
1.1095 + set l
1.1096 +} {0 {{$z a b c}}}
1.1097 +test interp-20.18 {interp invokehidden vs variable eval} {
1.1098 + catch {interp delete a}
1.1099 + interp create a
1.1100 + interp hide a list
1.1101 + a eval set z 89
1.1102 + set z 45
1.1103 + set l ""
1.1104 + lappend l [catch {interp invokehidden a list $z {$z a b c}} msg]
1.1105 + lappend l $msg
1.1106 + interp delete a
1.1107 + set l
1.1108 +} {0 {45 {$z a b c}}}
1.1109 +test interp-20.19 {interp invokehidden vs nested commands} {
1.1110 + catch {interp delete a}
1.1111 + interp create a
1.1112 + a hide list
1.1113 + set l [a invokehidden list {[list x y z] f g h} z]
1.1114 + interp delete a
1.1115 + set l
1.1116 +} {{[list x y z] f g h} z}
1.1117 +test interp-20.20 {interp invokehidden vs nested commands} {
1.1118 + catch {interp delete a}
1.1119 + interp create a
1.1120 + a hide list
1.1121 + set l [interp invokehidden a list {[list x y z] f g h} z]
1.1122 + interp delete a
1.1123 + set l
1.1124 +} {{[list x y z] f g h} z}
1.1125 +test interp-20.21 {interp hide vs safety} {
1.1126 + catch {interp delete a}
1.1127 + interp create a -safe
1.1128 + set l ""
1.1129 + lappend l [catch {a hide list} msg]
1.1130 + lappend l $msg
1.1131 + interp delete a
1.1132 + set l
1.1133 +} {0 {}}
1.1134 +test interp-20.22 {interp hide vs safety} {
1.1135 + catch {interp delete a}
1.1136 + interp create a -safe
1.1137 + set l ""
1.1138 + lappend l [catch {interp hide a list} msg]
1.1139 + lappend l $msg
1.1140 + interp delete a
1.1141 + set l
1.1142 +} {0 {}}
1.1143 +test interp-20.23 {interp hide vs safety} {
1.1144 + catch {interp delete a}
1.1145 + interp create a -safe
1.1146 + set l ""
1.1147 + lappend l [catch {a eval {interp hide {} list}} msg]
1.1148 + lappend l $msg
1.1149 + interp delete a
1.1150 + set l
1.1151 +} {1 {permission denied: safe interpreter cannot hide commands}}
1.1152 +test interp-20.24 {interp hide vs safety} {
1.1153 + catch {interp delete a}
1.1154 + interp create a -safe
1.1155 + interp create {a b}
1.1156 + set l ""
1.1157 + lappend l [catch {a eval {interp hide b list}} msg]
1.1158 + lappend l $msg
1.1159 + interp delete a
1.1160 + set l
1.1161 +} {1 {permission denied: safe interpreter cannot hide commands}}
1.1162 +test interp-20.25 {interp hide vs safety} {
1.1163 + catch {interp delete a}
1.1164 + interp create a -safe
1.1165 + interp create {a b}
1.1166 + set l ""
1.1167 + lappend l [catch {interp hide {a b} list} msg]
1.1168 + lappend l $msg
1.1169 + interp delete a
1.1170 + set l
1.1171 +} {0 {}}
1.1172 +test interp-20.26 {interp expoose vs safety} {
1.1173 + catch {interp delete a}
1.1174 + interp create a -safe
1.1175 + set l ""
1.1176 + lappend l [catch {a hide list} msg]
1.1177 + lappend l $msg
1.1178 + lappend l [catch {a expose list} msg]
1.1179 + lappend l $msg
1.1180 + interp delete a
1.1181 + set l
1.1182 +} {0 {} 0 {}}
1.1183 +test interp-20.27 {interp expose vs safety} {
1.1184 + catch {interp delete a}
1.1185 + interp create a -safe
1.1186 + set l ""
1.1187 + lappend l [catch {interp hide a list} msg]
1.1188 + lappend l $msg
1.1189 + lappend l [catch {interp expose a list} msg]
1.1190 + lappend l $msg
1.1191 + interp delete a
1.1192 + set l
1.1193 +} {0 {} 0 {}}
1.1194 +test interp-20.28 {interp expose vs safety} {
1.1195 + catch {interp delete a}
1.1196 + interp create a -safe
1.1197 + set l ""
1.1198 + lappend l [catch {a hide list} msg]
1.1199 + lappend l $msg
1.1200 + lappend l [catch {a eval {interp expose {} list}} msg]
1.1201 + lappend l $msg
1.1202 + interp delete a
1.1203 + set l
1.1204 +} {0 {} 1 {permission denied: safe interpreter cannot expose commands}}
1.1205 +test interp-20.29 {interp expose vs safety} {
1.1206 + catch {interp delete a}
1.1207 + interp create a -safe
1.1208 + set l ""
1.1209 + lappend l [catch {interp hide a list} msg]
1.1210 + lappend l $msg
1.1211 + lappend l [catch {a eval {interp expose {} list}} msg]
1.1212 + lappend l $msg
1.1213 + interp delete a
1.1214 + set l
1.1215 +} {0 {} 1 {permission denied: safe interpreter cannot expose commands}}
1.1216 +test interp-20.30 {interp expose vs safety} {
1.1217 + catch {interp delete a}
1.1218 + interp create a -safe
1.1219 + interp create {a b}
1.1220 + set l ""
1.1221 + lappend l [catch {interp hide {a b} list} msg]
1.1222 + lappend l $msg
1.1223 + lappend l [catch {a eval {interp expose b list}} msg]
1.1224 + lappend l $msg
1.1225 + interp delete a
1.1226 + set l
1.1227 +} {0 {} 1 {permission denied: safe interpreter cannot expose commands}}
1.1228 +test interp-20.31 {interp expose vs safety} {
1.1229 + catch {interp delete a}
1.1230 + interp create a -safe
1.1231 + interp create {a b}
1.1232 + set l ""
1.1233 + lappend l [catch {interp hide {a b} list} msg]
1.1234 + lappend l $msg
1.1235 + lappend l [catch {interp expose {a b} list} msg]
1.1236 + lappend l $msg
1.1237 + interp delete a
1.1238 + set l
1.1239 +} {0 {} 0 {}}
1.1240 +test interp-20.32 {interp invokehidden vs safety} {
1.1241 + catch {interp delete a}
1.1242 + interp create a -safe
1.1243 + interp hide a list
1.1244 + set l ""
1.1245 + lappend l [catch {a eval {interp invokehidden {} list a b c}} msg]
1.1246 + lappend l $msg
1.1247 + interp delete a
1.1248 + set l
1.1249 +} {1 {not allowed to invoke hidden commands from safe interpreter}}
1.1250 +test interp-20.33 {interp invokehidden vs safety} {
1.1251 + catch {interp delete a}
1.1252 + interp create a -safe
1.1253 + interp hide a list
1.1254 + set l ""
1.1255 + lappend l [catch {a eval {interp invokehidden {} list a b c}} msg]
1.1256 + lappend l $msg
1.1257 + lappend l [catch {a invokehidden list a b c} msg]
1.1258 + lappend l $msg
1.1259 + interp delete a
1.1260 + set l
1.1261 +} {1 {not allowed to invoke hidden commands from safe interpreter}\
1.1262 +0 {a b c}}
1.1263 +test interp-20.34 {interp invokehidden vs safety} {
1.1264 + catch {interp delete a}
1.1265 + interp create a -safe
1.1266 + interp create {a b}
1.1267 + interp hide {a b} list
1.1268 + set l ""
1.1269 + lappend l [catch {a eval {interp invokehidden b list a b c}} msg]
1.1270 + lappend l $msg
1.1271 + lappend l [catch {interp invokehidden {a b} list a b c} msg]
1.1272 + lappend l $msg
1.1273 + interp delete a
1.1274 + set l
1.1275 +} {1 {not allowed to invoke hidden commands from safe interpreter}\
1.1276 +0 {a b c}}
1.1277 +test interp-20.35 {invokehidden at local level} {
1.1278 + catch {interp delete a}
1.1279 + interp create a
1.1280 + a eval {
1.1281 + proc p1 {} {
1.1282 + set z 90
1.1283 + a1
1.1284 + set z
1.1285 + }
1.1286 + proc h1 {} {
1.1287 + upvar z z
1.1288 + set z 91
1.1289 + }
1.1290 + }
1.1291 + a hide h1
1.1292 + a alias a1 a1
1.1293 + proc a1 {} {
1.1294 + interp invokehidden a h1
1.1295 + }
1.1296 + set r [interp eval a p1]
1.1297 + interp delete a
1.1298 + set r
1.1299 +} 91
1.1300 +test interp-20.36 {invokehidden at local level} {
1.1301 + catch {interp delete a}
1.1302 + interp create a
1.1303 + a eval {
1.1304 + set z 90
1.1305 + proc p1 {} {
1.1306 + global z
1.1307 + a1
1.1308 + set z
1.1309 + }
1.1310 + proc h1 {} {
1.1311 + upvar z z
1.1312 + set z 91
1.1313 + }
1.1314 + }
1.1315 + a hide h1
1.1316 + a alias a1 a1
1.1317 + proc a1 {} {
1.1318 + interp invokehidden a h1
1.1319 + }
1.1320 + set r [interp eval a p1]
1.1321 + interp delete a
1.1322 + set r
1.1323 +} 91
1.1324 +test interp-20.37 {invokehidden at local level} {
1.1325 + catch {interp delete a}
1.1326 + interp create a
1.1327 + a eval {
1.1328 + proc p1 {} {
1.1329 + a1
1.1330 + set z
1.1331 + }
1.1332 + proc h1 {} {
1.1333 + upvar z z
1.1334 + set z 91
1.1335 + }
1.1336 + }
1.1337 + a hide h1
1.1338 + a alias a1 a1
1.1339 + proc a1 {} {
1.1340 + interp invokehidden a h1
1.1341 + }
1.1342 + set r [interp eval a p1]
1.1343 + interp delete a
1.1344 + set r
1.1345 +} 91
1.1346 +test interp-20.38 {invokehidden at global level} {
1.1347 + catch {interp delete a}
1.1348 + interp create a
1.1349 + a eval {
1.1350 + proc p1 {} {
1.1351 + a1
1.1352 + set z
1.1353 + }
1.1354 + proc h1 {} {
1.1355 + upvar z z
1.1356 + set z 91
1.1357 + }
1.1358 + }
1.1359 + a hide h1
1.1360 + a alias a1 a1
1.1361 + proc a1 {} {
1.1362 + interp invokehidden a -global h1
1.1363 + }
1.1364 + set r [catch {interp eval a p1} msg]
1.1365 + interp delete a
1.1366 + list $r $msg
1.1367 +} {1 {can't read "z": no such variable}}
1.1368 +test interp-20.39 {invokehidden at global level} {
1.1369 + catch {interp delete a}
1.1370 + interp create a
1.1371 + a eval {
1.1372 + proc p1 {} {
1.1373 + global z
1.1374 + a1
1.1375 + set z
1.1376 + }
1.1377 + proc h1 {} {
1.1378 + upvar z z
1.1379 + set z 91
1.1380 + }
1.1381 + }
1.1382 + a hide h1
1.1383 + a alias a1 a1
1.1384 + proc a1 {} {
1.1385 + interp invokehidden a -global h1
1.1386 + }
1.1387 + set r [catch {interp eval a p1} msg]
1.1388 + interp delete a
1.1389 + list $r $msg
1.1390 +} {0 91}
1.1391 +test interp-20.40 {safe, invokehidden at local level} {
1.1392 + catch {interp delete a}
1.1393 + interp create a -safe
1.1394 + a eval {
1.1395 + proc p1 {} {
1.1396 + set z 90
1.1397 + a1
1.1398 + set z
1.1399 + }
1.1400 + proc h1 {} {
1.1401 + upvar z z
1.1402 + set z 91
1.1403 + }
1.1404 + }
1.1405 + a hide h1
1.1406 + a alias a1 a1
1.1407 + proc a1 {} {
1.1408 + interp invokehidden a h1
1.1409 + }
1.1410 + set r [interp eval a p1]
1.1411 + interp delete a
1.1412 + set r
1.1413 +} 91
1.1414 +test interp-20.41 {safe, invokehidden at local level} {
1.1415 + catch {interp delete a}
1.1416 + interp create a -safe
1.1417 + a eval {
1.1418 + set z 90
1.1419 + proc p1 {} {
1.1420 + global z
1.1421 + a1
1.1422 + set z
1.1423 + }
1.1424 + proc h1 {} {
1.1425 + upvar z z
1.1426 + set z 91
1.1427 + }
1.1428 + }
1.1429 + a hide h1
1.1430 + a alias a1 a1
1.1431 + proc a1 {} {
1.1432 + interp invokehidden a h1
1.1433 + }
1.1434 + set r [interp eval a p1]
1.1435 + interp delete a
1.1436 + set r
1.1437 +} 91
1.1438 +test interp-20.42 {safe, invokehidden at local level} {
1.1439 + catch {interp delete a}
1.1440 + interp create a -safe
1.1441 + a eval {
1.1442 + proc p1 {} {
1.1443 + a1
1.1444 + set z
1.1445 + }
1.1446 + proc h1 {} {
1.1447 + upvar z z
1.1448 + set z 91
1.1449 + }
1.1450 + }
1.1451 + a hide h1
1.1452 + a alias a1 a1
1.1453 + proc a1 {} {
1.1454 + interp invokehidden a h1
1.1455 + }
1.1456 + set r [interp eval a p1]
1.1457 + interp delete a
1.1458 + set r
1.1459 +} 91
1.1460 +test interp-20.43 {invokehidden at global level} {
1.1461 + catch {interp delete a}
1.1462 + interp create a
1.1463 + a eval {
1.1464 + proc p1 {} {
1.1465 + a1
1.1466 + set z
1.1467 + }
1.1468 + proc h1 {} {
1.1469 + upvar z z
1.1470 + set z 91
1.1471 + }
1.1472 + }
1.1473 + a hide h1
1.1474 + a alias a1 a1
1.1475 + proc a1 {} {
1.1476 + interp invokehidden a -global h1
1.1477 + }
1.1478 + set r [catch {interp eval a p1} msg]
1.1479 + interp delete a
1.1480 + list $r $msg
1.1481 +} {1 {can't read "z": no such variable}}
1.1482 +test interp-20.44 {invokehidden at global level} {
1.1483 + catch {interp delete a}
1.1484 + interp create a
1.1485 + a eval {
1.1486 + proc p1 {} {
1.1487 + global z
1.1488 + a1
1.1489 + set z
1.1490 + }
1.1491 + proc h1 {} {
1.1492 + upvar z z
1.1493 + set z 91
1.1494 + }
1.1495 + }
1.1496 + a hide h1
1.1497 + a alias a1 a1
1.1498 + proc a1 {} {
1.1499 + interp invokehidden a -global h1
1.1500 + }
1.1501 + set r [catch {interp eval a p1} msg]
1.1502 + interp delete a
1.1503 + list $r $msg
1.1504 +} {0 91}
1.1505 +test interp-20.45 {interp hide vs namespaces} {
1.1506 + catch {interp delete a}
1.1507 + interp create a
1.1508 + a eval {
1.1509 + namespace eval foo {}
1.1510 + proc foo::x {} {}
1.1511 + }
1.1512 + set l [list [catch {interp hide a foo::x} msg] $msg]
1.1513 + interp delete a
1.1514 + set l
1.1515 +} {1 {cannot use namespace qualifiers in hidden command token (rename)}}
1.1516 +test interp-20.46 {interp hide vs namespaces} {
1.1517 + catch {interp delete a}
1.1518 + interp create a
1.1519 + a eval {
1.1520 + namespace eval foo {}
1.1521 + proc foo::x {} {}
1.1522 + }
1.1523 + set l [list [catch {interp hide a foo::x x} msg] $msg]
1.1524 + interp delete a
1.1525 + set l
1.1526 +} {1 {can only hide global namespace commands (use rename then hide)}}
1.1527 +test interp-20.47 {interp hide vs namespaces} {
1.1528 + catch {interp delete a}
1.1529 + interp create a
1.1530 + a eval {
1.1531 + proc x {} {}
1.1532 + }
1.1533 + set l [list [catch {interp hide a x foo::x} msg] $msg]
1.1534 + interp delete a
1.1535 + set l
1.1536 +} {1 {cannot use namespace qualifiers in hidden command token (rename)}}
1.1537 +test interp-20.48 {interp hide vs namespaces} {
1.1538 + catch {interp delete a}
1.1539 + interp create a
1.1540 + a eval {
1.1541 + namespace eval foo {}
1.1542 + proc foo::x {} {}
1.1543 + }
1.1544 + set l [list [catch {interp hide a foo::x bar::x} msg] $msg]
1.1545 + interp delete a
1.1546 + set l
1.1547 +} {1 {cannot use namespace qualifiers in hidden command token (rename)}}
1.1548 +
1.1549 +test interp-21.1 {interp hidden} {
1.1550 + interp hidden {}
1.1551 +} ""
1.1552 +test interp-21.2 {interp hidden} {
1.1553 + interp hidden
1.1554 +} ""
1.1555 +test interp-21.3 {interp hidden vs interp hide, interp expose} {
1.1556 + set l ""
1.1557 + lappend l [interp hidden]
1.1558 + interp hide {} pwd
1.1559 + lappend l [interp hidden]
1.1560 + interp expose {} pwd
1.1561 + lappend l [interp hidden]
1.1562 + set l
1.1563 +} {{} pwd {}}
1.1564 +test interp-21.4 {interp hidden} {
1.1565 + catch {interp delete a}
1.1566 + interp create a
1.1567 + set l [interp hidden a]
1.1568 + interp delete a
1.1569 + set l
1.1570 +} ""
1.1571 +test interp-21.5 {interp hidden} {
1.1572 + catch {interp delete a}
1.1573 + interp create -safe a
1.1574 + set l [lsort [interp hidden a]]
1.1575 + interp delete a
1.1576 + set l
1.1577 +} $hidden_cmds
1.1578 +test interp-21.6 {interp hidden vs interp hide, interp expose} {
1.1579 + catch {interp delete a}
1.1580 + interp create a
1.1581 + set l ""
1.1582 + lappend l [interp hidden a]
1.1583 + interp hide a pwd
1.1584 + lappend l [interp hidden a]
1.1585 + interp expose a pwd
1.1586 + lappend l [interp hidden a]
1.1587 + interp delete a
1.1588 + set l
1.1589 +} {{} pwd {}}
1.1590 +test interp-21.7 {interp hidden} {
1.1591 + catch {interp delete a}
1.1592 + interp create a
1.1593 + set l [a hidden]
1.1594 + interp delete a
1.1595 + set l
1.1596 +} ""
1.1597 +test interp-21.8 {interp hidden} {
1.1598 + catch {interp delete a}
1.1599 + interp create a -safe
1.1600 + set l [lsort [a hidden]]
1.1601 + interp delete a
1.1602 + set l
1.1603 +} $hidden_cmds
1.1604 +test interp-21.9 {interp hidden vs interp hide, interp expose} {
1.1605 + catch {interp delete a}
1.1606 + interp create a
1.1607 + set l ""
1.1608 + lappend l [a hidden]
1.1609 + a hide pwd
1.1610 + lappend l [a hidden]
1.1611 + a expose pwd
1.1612 + lappend l [a hidden]
1.1613 + interp delete a
1.1614 + set l
1.1615 +} {{} pwd {}}
1.1616 +
1.1617 +test interp-22.1 {testing interp marktrusted} {
1.1618 + catch {interp delete a}
1.1619 + interp create a
1.1620 + set l ""
1.1621 + lappend l [a issafe]
1.1622 + lappend l [a marktrusted]
1.1623 + lappend l [a issafe]
1.1624 + interp delete a
1.1625 + set l
1.1626 +} {0 {} 0}
1.1627 +test interp-22.2 {testing interp marktrusted} {
1.1628 + catch {interp delete a}
1.1629 + interp create a
1.1630 + set l ""
1.1631 + lappend l [interp issafe a]
1.1632 + lappend l [interp marktrusted a]
1.1633 + lappend l [interp issafe a]
1.1634 + interp delete a
1.1635 + set l
1.1636 +} {0 {} 0}
1.1637 +test interp-22.3 {testing interp marktrusted} {
1.1638 + catch {interp delete a}
1.1639 + interp create a -safe
1.1640 + set l ""
1.1641 + lappend l [a issafe]
1.1642 + lappend l [a marktrusted]
1.1643 + lappend l [a issafe]
1.1644 + interp delete a
1.1645 + set l
1.1646 +} {1 {} 0}
1.1647 +test interp-22.4 {testing interp marktrusted} {
1.1648 + catch {interp delete a}
1.1649 + interp create a -safe
1.1650 + set l ""
1.1651 + lappend l [interp issafe a]
1.1652 + lappend l [interp marktrusted a]
1.1653 + lappend l [interp issafe a]
1.1654 + interp delete a
1.1655 + set l
1.1656 +} {1 {} 0}
1.1657 +test interp-22.5 {testing interp marktrusted} {
1.1658 + catch {interp delete a}
1.1659 + interp create a -safe
1.1660 + interp create {a b}
1.1661 + catch {a eval {interp marktrusted b}} msg
1.1662 + interp delete a
1.1663 + set msg
1.1664 +} {permission denied: safe interpreter cannot mark trusted}
1.1665 +test interp-22.6 {testing interp marktrusted} {
1.1666 + catch {interp delete a}
1.1667 + interp create a -safe
1.1668 + interp create {a b}
1.1669 + catch {a eval {b marktrusted}} msg
1.1670 + interp delete a
1.1671 + set msg
1.1672 +} {permission denied: safe interpreter cannot mark trusted}
1.1673 +test interp-22.7 {testing interp marktrusted} {
1.1674 + catch {interp delete a}
1.1675 + interp create a -safe
1.1676 + set l ""
1.1677 + lappend l [interp issafe a]
1.1678 + interp marktrusted a
1.1679 + interp create {a b}
1.1680 + lappend l [interp issafe a]
1.1681 + lappend l [interp issafe {a b}]
1.1682 + interp delete a
1.1683 + set l
1.1684 +} {1 0 0}
1.1685 +test interp-22.8 {testing interp marktrusted} {
1.1686 + catch {interp delete a}
1.1687 + interp create a -safe
1.1688 + set l ""
1.1689 + lappend l [interp issafe a]
1.1690 + interp create {a b}
1.1691 + lappend l [interp issafe {a b}]
1.1692 + interp marktrusted a
1.1693 + interp create {a c}
1.1694 + lappend l [interp issafe a]
1.1695 + lappend l [interp issafe {a c}]
1.1696 + interp delete a
1.1697 + set l
1.1698 +} {1 1 0 0}
1.1699 +test interp-22.9 {testing interp marktrusted} {
1.1700 + catch {interp delete a}
1.1701 + interp create a -safe
1.1702 + set l ""
1.1703 + lappend l [interp issafe a]
1.1704 + interp create {a b}
1.1705 + lappend l [interp issafe {a b}]
1.1706 + interp marktrusted {a b}
1.1707 + lappend l [interp issafe a]
1.1708 + lappend l [interp issafe {a b}]
1.1709 + interp create {a b c}
1.1710 + lappend l [interp issafe {a b c}]
1.1711 + interp delete a
1.1712 + set l
1.1713 +} {1 1 1 0 0}
1.1714 +
1.1715 +test interp-23.1 {testing hiding vs aliases} {
1.1716 + catch {interp delete a}
1.1717 + interp create a
1.1718 + set l ""
1.1719 + lappend l [interp hidden a]
1.1720 + a alias bar bar
1.1721 + lappend l [interp aliases a]
1.1722 + lappend l [interp hidden a]
1.1723 + a hide bar
1.1724 + lappend l [interp aliases a]
1.1725 + lappend l [interp hidden a]
1.1726 + a alias bar {}
1.1727 + lappend l [interp aliases a]
1.1728 + lappend l [interp hidden a]
1.1729 + interp delete a
1.1730 + set l
1.1731 +} {{} bar {} bar bar {} {}}
1.1732 +test interp-23.2 {testing hiding vs aliases} {unixOrPc} {
1.1733 + catch {interp delete a}
1.1734 + interp create a -safe
1.1735 + set l ""
1.1736 + lappend l [lsort [interp hidden a]]
1.1737 + a alias bar bar
1.1738 + lappend l [interp aliases a]
1.1739 + lappend l [lsort [interp hidden a]]
1.1740 + a hide bar
1.1741 + lappend l [interp aliases a]
1.1742 + lappend l [lsort [interp hidden a]]
1.1743 + a alias bar {}
1.1744 + lappend l [interp aliases a]
1.1745 + lappend l [lsort [interp hidden a]]
1.1746 + interp delete a
1.1747 + set l
1.1748 +} {{cd encoding exec exit fconfigure file glob load open pwd socket source} bar {cd encoding exec exit fconfigure file glob load open pwd socket source} bar {bar cd encoding exec exit fconfigure file glob load open pwd socket source} {} {cd encoding exec exit fconfigure file glob load open pwd socket source}}
1.1749 +
1.1750 +test interp-23.3 {testing hiding vs aliases} {macOnly} {
1.1751 + catch {interp delete a}
1.1752 + interp create a -safe
1.1753 + set l ""
1.1754 + lappend l [lsort [interp hidden a]]
1.1755 + a alias bar bar
1.1756 + lappend l [interp aliases a]
1.1757 + lappend l [lsort [interp hidden a]]
1.1758 + a hide bar
1.1759 + lappend l [interp aliases a]
1.1760 + lappend l [lsort [interp hidden a]]
1.1761 + a alias bar {}
1.1762 + lappend l [interp aliases a]
1.1763 + lappend l [lsort [interp hidden a]]
1.1764 + interp delete a
1.1765 + set l
1.1766 +} {{beep cd echo encoding exit fconfigure file glob load ls open pwd socket source} bar {beep cd echo encoding exit fconfigure file glob load ls open pwd socket source} bar {bar beep cd echo encoding exit fconfigure file glob load ls open pwd socket source} {} {beep cd echo encoding exit fconfigure file glob load ls open pwd socket source}}
1.1767 +
1.1768 +test interp-24.1 {result resetting on error} {
1.1769 + catch {interp delete a}
1.1770 + interp create a
1.1771 + proc foo args {error $args}
1.1772 + interp alias a foo {} foo
1.1773 + set l [interp eval a {
1.1774 + set l {}
1.1775 + lappend l [catch {foo 1 2 3} msg]
1.1776 + lappend l $msg
1.1777 + lappend l [catch {foo 3 4 5} msg]
1.1778 + lappend l $msg
1.1779 + set l
1.1780 + }]
1.1781 + interp delete a
1.1782 + set l
1.1783 +} {1 {1 2 3} 1 {3 4 5}}
1.1784 +test interp-24.2 {result resetting on error} {
1.1785 + catch {interp delete a}
1.1786 + interp create a -safe
1.1787 + proc foo args {error $args}
1.1788 + interp alias a foo {} foo
1.1789 + set l [interp eval a {
1.1790 + set l {}
1.1791 + lappend l [catch {foo 1 2 3} msg]
1.1792 + lappend l $msg
1.1793 + lappend l [catch {foo 3 4 5} msg]
1.1794 + lappend l $msg
1.1795 + set l
1.1796 + }]
1.1797 + interp delete a
1.1798 + set l
1.1799 +} {1 {1 2 3} 1 {3 4 5}}
1.1800 +test interp-24.3 {result resetting on error} {
1.1801 + catch {interp delete a}
1.1802 + interp create a
1.1803 + interp create {a b}
1.1804 + interp eval a {
1.1805 + proc foo args {error $args}
1.1806 + }
1.1807 + interp alias {a b} foo a foo
1.1808 + set l [interp eval {a b} {
1.1809 + set l {}
1.1810 + lappend l [catch {foo 1 2 3} msg]
1.1811 + lappend l $msg
1.1812 + lappend l [catch {foo 3 4 5} msg]
1.1813 + lappend l $msg
1.1814 + set l
1.1815 + }]
1.1816 + interp delete a
1.1817 + set l
1.1818 +} {1 {1 2 3} 1 {3 4 5}}
1.1819 +test interp-24.4 {result resetting on error} {
1.1820 + catch {interp delete a}
1.1821 + interp create a -safe
1.1822 + interp create {a b}
1.1823 + interp eval a {
1.1824 + proc foo args {error $args}
1.1825 + }
1.1826 + interp alias {a b} foo a foo
1.1827 + set l [interp eval {a b} {
1.1828 + set l {}
1.1829 + lappend l [catch {foo 1 2 3} msg]
1.1830 + lappend l $msg
1.1831 + lappend l [catch {foo 3 4 5} msg]
1.1832 + lappend l $msg
1.1833 + set l
1.1834 + }]
1.1835 + interp delete a
1.1836 + set l
1.1837 +} {1 {1 2 3} 1 {3 4 5}}
1.1838 +test interp-24.5 {result resetting on error} {
1.1839 + catch {interp delete a}
1.1840 + catch {interp delete b}
1.1841 + interp create a
1.1842 + interp create b
1.1843 + interp eval a {
1.1844 + proc foo args {error $args}
1.1845 + }
1.1846 + interp alias b foo a foo
1.1847 + set l [interp eval b {
1.1848 + set l {}
1.1849 + lappend l [catch {foo 1 2 3} msg]
1.1850 + lappend l $msg
1.1851 + lappend l [catch {foo 3 4 5} msg]
1.1852 + lappend l $msg
1.1853 + set l
1.1854 + }]
1.1855 + interp delete a
1.1856 + set l
1.1857 +} {1 {1 2 3} 1 {3 4 5}}
1.1858 +test interp-24.6 {result resetting on error} {
1.1859 + catch {interp delete a}
1.1860 + catch {interp delete b}
1.1861 + interp create a -safe
1.1862 + interp create b -safe
1.1863 + interp eval a {
1.1864 + proc foo args {error $args}
1.1865 + }
1.1866 + interp alias b foo a foo
1.1867 + set l [interp eval b {
1.1868 + set l {}
1.1869 + lappend l [catch {foo 1 2 3} msg]
1.1870 + lappend l $msg
1.1871 + lappend l [catch {foo 3 4 5} msg]
1.1872 + lappend l $msg
1.1873 + set l
1.1874 + }]
1.1875 + interp delete a
1.1876 + set l
1.1877 +} {1 {1 2 3} 1 {3 4 5}}
1.1878 +test interp-24.7 {result resetting on error} {
1.1879 + catch {interp delete a}
1.1880 + interp create a
1.1881 + interp eval a {
1.1882 + proc foo args {error $args}
1.1883 + }
1.1884 + set l {}
1.1885 + lappend l [catch {interp eval a foo 1 2 3} msg]
1.1886 + lappend l $msg
1.1887 + lappend l [catch {interp eval a foo 3 4 5} msg]
1.1888 + lappend l $msg
1.1889 + interp delete a
1.1890 + set l
1.1891 +} {1 {1 2 3} 1 {3 4 5}}
1.1892 +test interp-24.8 {result resetting on error} {
1.1893 + catch {interp delete a}
1.1894 + interp create a -safe
1.1895 + interp eval a {
1.1896 + proc foo args {error $args}
1.1897 + }
1.1898 + set l {}
1.1899 + lappend l [catch {interp eval a foo 1 2 3} msg]
1.1900 + lappend l $msg
1.1901 + lappend l [catch {interp eval a foo 3 4 5} msg]
1.1902 + lappend l $msg
1.1903 + interp delete a
1.1904 + set l
1.1905 +} {1 {1 2 3} 1 {3 4 5}}
1.1906 +test interp-24.9 {result resetting on error} {
1.1907 + catch {interp delete a}
1.1908 + interp create a
1.1909 + interp create {a b}
1.1910 + interp eval {a b} {
1.1911 + proc foo args {error $args}
1.1912 + }
1.1913 + interp eval a {
1.1914 + proc foo args {
1.1915 + eval interp eval b foo $args
1.1916 + }
1.1917 + }
1.1918 + set l {}
1.1919 + lappend l [catch {interp eval a foo 1 2 3} msg]
1.1920 + lappend l $msg
1.1921 + lappend l [catch {interp eval a foo 3 4 5} msg]
1.1922 + lappend l $msg
1.1923 + interp delete a
1.1924 + set l
1.1925 +} {1 {1 2 3} 1 {3 4 5}}
1.1926 +test interp-24.10 {result resetting on error} {
1.1927 + catch {interp delete a}
1.1928 + interp create a -safe
1.1929 + interp create {a b}
1.1930 + interp eval {a b} {
1.1931 + proc foo args {error $args}
1.1932 + }
1.1933 + interp eval a {
1.1934 + proc foo args {
1.1935 + eval interp eval b foo $args
1.1936 + }
1.1937 + }
1.1938 + set l {}
1.1939 + lappend l [catch {interp eval a foo 1 2 3} msg]
1.1940 + lappend l $msg
1.1941 + lappend l [catch {interp eval a foo 3 4 5} msg]
1.1942 + lappend l $msg
1.1943 + interp delete a
1.1944 + set l
1.1945 +} {1 {1 2 3} 1 {3 4 5}}
1.1946 +test interp-24.11 {result resetting on error} {
1.1947 + catch {interp delete a}
1.1948 + interp create a
1.1949 + interp create {a b}
1.1950 + interp eval {a b} {
1.1951 + proc foo args {error $args}
1.1952 + }
1.1953 + interp eval a {
1.1954 + proc foo args {
1.1955 + set l {}
1.1956 + lappend l [catch {eval interp eval b foo $args} msg]
1.1957 + lappend l $msg
1.1958 + lappend l [catch {eval interp eval b foo $args} msg]
1.1959 + lappend l $msg
1.1960 + set l
1.1961 + }
1.1962 + }
1.1963 + set l [interp eval a foo 1 2 3]
1.1964 + interp delete a
1.1965 + set l
1.1966 +} {1 {1 2 3} 1 {1 2 3}}
1.1967 +test interp-24.12 {result resetting on error} {
1.1968 + catch {interp delete a}
1.1969 + interp create a -safe
1.1970 + interp create {a b}
1.1971 + interp eval {a b} {
1.1972 + proc foo args {error $args}
1.1973 + }
1.1974 + interp eval a {
1.1975 + proc foo args {
1.1976 + set l {}
1.1977 + lappend l [catch {eval interp eval b foo $args} msg]
1.1978 + lappend l $msg
1.1979 + lappend l [catch {eval interp eval b foo $args} msg]
1.1980 + lappend l $msg
1.1981 + set l
1.1982 + }
1.1983 + }
1.1984 + set l [interp eval a foo 1 2 3]
1.1985 + interp delete a
1.1986 + set l
1.1987 +} {1 {1 2 3} 1 {1 2 3}}
1.1988 +
1.1989 +unset hidden_cmds
1.1990 +
1.1991 +test interp-25.1 {testing aliasing of string commands} {
1.1992 + catch {interp delete a}
1.1993 + interp create a
1.1994 + a alias exec foo ;# Relies on exec being a string command!
1.1995 + interp delete a
1.1996 +} ""
1.1997 +
1.1998 +
1.1999 +#
1.2000 +# Interps result transmission
1.2001 +#
1.2002 +
1.2003 +test interp-26.1 {result code transmission : interp eval direct} {
1.2004 + # Test that all the possibles error codes from Tcl get passed up
1.2005 + # from the slave interp's context to the master, even though the
1.2006 + # slave nominally thinks the command is running at the root level.
1.2007 +
1.2008 + catch {interp delete a}
1.2009 + interp create a
1.2010 + set res {}
1.2011 + # use a for so if a return -code break 'escapes' we would notice
1.2012 + for {set code -1} {$code<=5} {incr code} {
1.2013 + lappend res [catch {interp eval a return -code $code} msg]
1.2014 + }
1.2015 + interp delete a
1.2016 + set res
1.2017 +} {-1 0 1 2 3 4 5}
1.2018 +
1.2019 +
1.2020 +test interp-26.2 {result code transmission : interp eval indirect} {
1.2021 + # retcode == 2 == return is special
1.2022 + catch {interp delete a}
1.2023 + interp create a
1.2024 + interp eval a {proc retcode {code} {return -code $code ret$code}}
1.2025 + set res {}
1.2026 + # use a for so if a return -code break 'escapes' we would notice
1.2027 + for {set code -1} {$code<=5} {incr code} {
1.2028 + lappend res [catch {interp eval a retcode $code} msg] $msg
1.2029 + }
1.2030 + interp delete a
1.2031 + set res
1.2032 +} {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5}
1.2033 +
1.2034 +test interp-26.3 {result code transmission : aliases} {
1.2035 + # Test that all the possibles error codes from Tcl get passed up
1.2036 + # from the slave interp's context to the master, even though the
1.2037 + # slave nominally thinks the command is running at the root level.
1.2038 +
1.2039 + catch {interp delete a}
1.2040 + interp create a
1.2041 + set res {}
1.2042 + proc MyTestAlias {code} {
1.2043 + return -code $code ret$code
1.2044 + }
1.2045 + interp alias a Test {} MyTestAlias
1.2046 + for {set code -1} {$code<=5} {incr code} {
1.2047 + lappend res [interp eval a [list catch [list Test $code] msg]]
1.2048 + }
1.2049 + interp delete a
1.2050 + set res
1.2051 +} {-1 0 1 2 3 4 5}
1.2052 +
1.2053 +test interp-26.4 {result code transmission: invoke hidden direct--bug 1637} \
1.2054 + {knownBug} {
1.2055 + # The known bug is that code 2 is returned, not the -code argument
1.2056 + catch {interp delete a}
1.2057 + interp create a
1.2058 + set res {}
1.2059 + interp hide a return
1.2060 + for {set code -1} {$code<=5} {incr code} {
1.2061 + lappend res [catch {interp invokehidden a return -code $code ret$code}]
1.2062 + }
1.2063 + interp delete a
1.2064 + set res
1.2065 +} {-1 0 1 2 3 4 5}
1.2066 +
1.2067 +test interp-26.5 {result code transmission: invoke hidden indirect--bug 1637} \
1.2068 + {knownBug} {
1.2069 + # The known bug is that the break and continue should raise errors
1.2070 + # that they are used outside a loop.
1.2071 + catch {interp delete a}
1.2072 + interp create a
1.2073 + set res {}
1.2074 + interp eval a {proc retcode {code} {return -code $code ret$code}}
1.2075 + interp hide a retcode
1.2076 + for {set code -1} {$code<=5} {incr code} {
1.2077 + lappend res [catch {interp invokehidden a retcode $code} msg] $msg
1.2078 + }
1.2079 + interp delete a
1.2080 + set res
1.2081 +} {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5}
1.2082 +
1.2083 +test interp-26.6 {result code transmission: all combined--bug 1637} \
1.2084 + {knownBug} {
1.2085 + # Test that all the possibles error codes from Tcl get passed
1.2086 + # In both directions. This doesn't work.
1.2087 + set interp [interp create];
1.2088 + proc MyTestAlias {interp args} {
1.2089 + global aliasTrace;
1.2090 + lappend aliasTrace $args;
1.2091 + eval interp invokehidden [list $interp] $args
1.2092 + }
1.2093 + foreach c {return} {
1.2094 + interp hide $interp $c;
1.2095 + interp alias $interp $c {} MyTestAlias $interp $c;
1.2096 + }
1.2097 + interp eval $interp {proc ret {code} {return -code $code ret$code}}
1.2098 + set res {}
1.2099 + set aliasTrace {}
1.2100 + for {set code -1} {$code<=5} {incr code} {
1.2101 + lappend res [catch {interp eval $interp ret $code} msg] $msg
1.2102 + }
1.2103 + interp delete $interp;
1.2104 + set res
1.2105 +} {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5}
1.2106 +
1.2107 +# Some tests might need to be added to check for difference between
1.2108 +# toplevel and non toplevel evals.
1.2109 +
1.2110 +# End of return code transmission section
1.2111 +
1.2112 +test interp-26.7 {errorInfo transmission: regular interps} {
1.2113 + set interp [interp create];
1.2114 + proc MyError {secret} {
1.2115 + return -code error "msg"
1.2116 + }
1.2117 + proc MyTestAlias {interp args} {
1.2118 + MyError "some secret"
1.2119 + }
1.2120 + interp alias $interp test {} MyTestAlias $interp;
1.2121 + set res [interp eval $interp {catch test;set errorInfo}]
1.2122 + interp delete $interp;
1.2123 + set res
1.2124 +} {msg
1.2125 + while executing
1.2126 +"MyError "some secret""
1.2127 + (procedure "MyTestAlias" line 2)
1.2128 + invoked from within
1.2129 +"test"}
1.2130 +
1.2131 +test interp-26.8 {errorInfo transmission: safe interps--bug 1637} {knownBug} {
1.2132 + # this test fails because the errorInfo is fully transmitted
1.2133 + # whether the interp is safe or not. The errorInfo should never
1.2134 + # report data from the master interpreter because it could
1.2135 + # contain sensitive information.
1.2136 + set interp [interp create -safe];
1.2137 + proc MyError {secret} {
1.2138 + return -code error "msg"
1.2139 + }
1.2140 + proc MyTestAlias {interp args} {
1.2141 + MyError "some secret"
1.2142 + }
1.2143 + interp alias $interp test {} MyTestAlias $interp;
1.2144 + set res [interp eval $interp {catch test;set errorInfo}]
1.2145 + interp delete $interp;
1.2146 + set res
1.2147 +} {msg
1.2148 + while executing
1.2149 +"test"}
1.2150 +
1.2151 +# Interps & Namespaces
1.2152 +test interp-27.1 {interp aliases & namespaces} {
1.2153 + set i [interp create];
1.2154 + set aliasTrace {};
1.2155 + proc tstAlias {args} {
1.2156 + global aliasTrace;
1.2157 + lappend aliasTrace [list [namespace current] $args];
1.2158 + }
1.2159 + $i alias foo::bar tstAlias foo::bar;
1.2160 + $i eval foo::bar test
1.2161 + interp delete $i
1.2162 + set aliasTrace;
1.2163 +} {{:: {foo::bar test}}}
1.2164 +
1.2165 +test interp-27.2 {interp aliases & namespaces} {
1.2166 + set i [interp create];
1.2167 + set aliasTrace {};
1.2168 + proc tstAlias {args} {
1.2169 + global aliasTrace;
1.2170 + lappend aliasTrace [list [namespace current] $args];
1.2171 + }
1.2172 + $i alias foo::bar tstAlias foo::bar;
1.2173 + $i eval namespace eval foo {bar test}
1.2174 + interp delete $i
1.2175 + set aliasTrace;
1.2176 +} {{:: {foo::bar test}}}
1.2177 +
1.2178 +test interp-27.3 {interp aliases & namespaces} {
1.2179 + set i [interp create];
1.2180 + set aliasTrace {};
1.2181 + proc tstAlias {args} {
1.2182 + global aliasTrace;
1.2183 + lappend aliasTrace [list [namespace current] $args];
1.2184 + }
1.2185 + interp eval $i {namespace eval foo {proc bar {} {error "bar called"}}}
1.2186 + interp alias $i foo::bar {} tstAlias foo::bar;
1.2187 + interp eval $i {namespace eval foo {bar test}}
1.2188 + interp delete $i
1.2189 + set aliasTrace;
1.2190 +} {{:: {foo::bar test}}}
1.2191 +
1.2192 +test interp-27.4 {interp aliases & namespaces} {
1.2193 + set i [interp create];
1.2194 + namespace eval foo2 {
1.2195 + variable aliasTrace {};
1.2196 + proc bar {args} {
1.2197 + variable aliasTrace;
1.2198 + lappend aliasTrace [list [namespace current] $args];
1.2199 + }
1.2200 + }
1.2201 + $i alias foo::bar foo2::bar foo::bar;
1.2202 + $i eval namespace eval foo {bar test}
1.2203 + set r $foo2::aliasTrace;
1.2204 + namespace delete foo2;
1.2205 + set r
1.2206 +} {{::foo2 {foo::bar test}}}
1.2207 +
1.2208 +# the following tests are commented out while we don't support
1.2209 +# hiding in namespaces
1.2210 +
1.2211 +# test interp-27.5 {interp hidden & namespaces} {
1.2212 +# set i [interp create];
1.2213 +# interp eval $i {
1.2214 +# namespace eval foo {
1.2215 +# proc bar {args} {
1.2216 +# return "bar called ([namespace current]) ($args)"
1.2217 +# }
1.2218 +# }
1.2219 +# }
1.2220 +# set res [list [interp eval $i {namespace eval foo {bar test1}}]]
1.2221 +# interp hide $i foo::bar;
1.2222 +# lappend res [list [catch {interp eval $i {namespace eval foo {bar test2}}} msg] $msg]
1.2223 +# interp delete $i;
1.2224 +# set res;
1.2225 +#} {{bar called (::foo) (test1)} {1 {invalid command name "bar"}}}
1.2226 +
1.2227 +# test interp-27.6 {interp hidden & aliases & namespaces} {
1.2228 +# set i [interp create];
1.2229 +# set v root-master;
1.2230 +# namespace eval foo {
1.2231 +# variable v foo-master;
1.2232 +# proc bar {interp args} {
1.2233 +# variable v;
1.2234 +# list "master bar called ($v) ([namespace current]) ($args)"\
1.2235 +# [interp invokehidden $interp foo::bar $args];
1.2236 +# }
1.2237 +# }
1.2238 +# interp eval $i {
1.2239 +# namespace eval foo {
1.2240 +# namespace export *
1.2241 +# variable v foo-slave;
1.2242 +# proc bar {args} {
1.2243 +# variable v;
1.2244 +# return "slave bar called ($v) ([namespace current]) ($args)"
1.2245 +# }
1.2246 +# }
1.2247 +# }
1.2248 +# set res [list [interp eval $i {namespace eval foo {bar test1}}]]
1.2249 +# $i hide foo::bar;
1.2250 +# $i alias foo::bar foo::bar $i;
1.2251 +# set res [concat $res [interp eval $i {
1.2252 +# set v root-slave;
1.2253 +# namespace eval test {
1.2254 +# variable v foo-test;
1.2255 +# namespace import ::foo::*;
1.2256 +# bar test2
1.2257 +# }
1.2258 +# }]]
1.2259 +# namespace delete foo;
1.2260 +# interp delete $i;
1.2261 +# set res
1.2262 +# } {{slave bar called (foo-slave) (::foo) (test1)} {master bar called (foo-master) (::foo) (test2)} {slave bar called (foo-slave) (::foo) (test2)}}
1.2263 +
1.2264 +
1.2265 +# test interp-27.7 {interp hidden & aliases & imports & namespaces} {
1.2266 +# set i [interp create];
1.2267 +# set v root-master;
1.2268 +# namespace eval mfoo {
1.2269 +# variable v foo-master;
1.2270 +# proc bar {interp args} {
1.2271 +# variable v;
1.2272 +# list "master bar called ($v) ([namespace current]) ($args)"\
1.2273 +# [interp invokehidden $interp test::bar $args];
1.2274 +# }
1.2275 +# }
1.2276 +# interp eval $i {
1.2277 +# namespace eval foo {
1.2278 +# namespace export *
1.2279 +# variable v foo-slave;
1.2280 +# proc bar {args} {
1.2281 +# variable v;
1.2282 +# return "slave bar called ($v) ([info level 0]) ([uplevel namespace current]) ([namespace current]) ($args)"
1.2283 +# }
1.2284 +# }
1.2285 +# set v root-slave;
1.2286 +# namespace eval test {
1.2287 +# variable v foo-test;
1.2288 +# namespace import ::foo::*;
1.2289 +# }
1.2290 +# }
1.2291 +# set res [list [interp eval $i {namespace eval test {bar test1}}]]
1.2292 +# $i hide test::bar;
1.2293 +# $i alias test::bar mfoo::bar $i;
1.2294 +# set res [concat $res [interp eval $i {test::bar test2}]];
1.2295 +# namespace delete mfoo;
1.2296 +# interp delete $i;
1.2297 +# set res
1.2298 +# } {{slave bar called (foo-slave) (bar test1) (::tcltest) (::foo) (test1)} {master bar called (foo-master) (::mfoo) (test2)} {slave bar called (foo-slave) (test::bar test2) (::) (::foo) (test2)}}
1.2299 +
1.2300 +#test interp-27.8 {hiding, namespaces and integrity} {
1.2301 +# namespace eval foo {
1.2302 +# variable v 3;
1.2303 +# proc bar {} {variable v; set v}
1.2304 +# # next command would currently generate an unknown command "bar" error.
1.2305 +# interp hide {} bar;
1.2306 +# }
1.2307 +# namespace delete foo;
1.2308 +# list [catch {interp invokehidden {} foo} msg] $msg;
1.2309 +#} {1 {invalid hidden command name "foo"}}
1.2310 +
1.2311 +
1.2312 +test interp-28.1 {getting fooled by slave's namespace ?} {
1.2313 + set i [interp create -safe];
1.2314 + proc master {interp args} {interp hide $interp list}
1.2315 + $i alias master master $i;
1.2316 + set r [interp eval $i {
1.2317 + namespace eval foo {
1.2318 + proc list {args} {
1.2319 + return "dummy foo::list";
1.2320 + }
1.2321 + master;
1.2322 + }
1.2323 + info commands list
1.2324 + }]
1.2325 + interp delete $i;
1.2326 + set r
1.2327 +} {}
1.2328 +
1.2329 +# Part 29: recursion limit
1.2330 +# 29.1.* Argument checking
1.2331 +# 29.2.* Reading and setting the recursion limit
1.2332 +# 29.3.* Does the recursion limit work?
1.2333 +# 29.4.* Recursion limit inheritance by sub-interpreters
1.2334 +# 29.5.* Confirming the recursionlimit command does not affect the parent
1.2335 +# 29.6.* Safe interpreter restriction
1.2336 +
1.2337 +test interp-29.1.1 {interp recursionlimit argument checking} {
1.2338 + list [catch {interp recursionlimit} msg] $msg
1.2339 +} {1 {wrong # args: should be "interp recursionlimit path ?newlimit?"}}
1.2340 +
1.2341 +test interp-29.1.2 {interp recursionlimit argument checking} {
1.2342 + list [catch {interp recursionlimit foo bar} msg] $msg
1.2343 +} {1 {could not find interpreter "foo"}}
1.2344 +
1.2345 +test interp-29.1.3 {interp recursionlimit argument checking} {
1.2346 + list [catch {interp recursionlimit foo bar baz} msg] $msg
1.2347 +} {1 {wrong # args: should be "interp recursionlimit path ?newlimit?"}}
1.2348 +
1.2349 +test interp-29.1.4 {interp recursionlimit argument checking} {
1.2350 + interp create moo
1.2351 + set result [catch {interp recursionlimit moo bar} msg]
1.2352 + interp delete moo
1.2353 + list $result $msg
1.2354 +} {1 {expected integer but got "bar"}}
1.2355 +
1.2356 +test interp-29.1.5 {interp recursionlimit argument checking} {
1.2357 + interp create moo
1.2358 + set result [catch {interp recursionlimit moo 0} msg]
1.2359 + interp delete moo
1.2360 + list $result $msg
1.2361 +} {1 {recursion limit must be > 0}}
1.2362 +
1.2363 +test interp-29.1.6 {interp recursionlimit argument checking} {
1.2364 + interp create moo
1.2365 + set result [catch {interp recursionlimit moo -1} msg]
1.2366 + interp delete moo
1.2367 + list $result $msg
1.2368 +} {1 {recursion limit must be > 0}}
1.2369 +
1.2370 +test interp-29.1.7 {interp recursionlimit argument checking} {
1.2371 + interp create moo
1.2372 + set result [catch {interp recursionlimit moo [expr {wide(1)<<32}]} msg]
1.2373 + interp delete moo
1.2374 + list $result [string range $msg 0 35]
1.2375 +} {1 {integer value too large to represent}}
1.2376 +
1.2377 +test interp-29.1.8 {slave recursionlimit argument checking} {
1.2378 + interp create moo
1.2379 + set result [catch {moo recursionlimit foo bar} msg]
1.2380 + interp delete moo
1.2381 + list $result $msg
1.2382 +} {1 {wrong # args: should be "moo recursionlimit ?newlimit?"}}
1.2383 +
1.2384 +test interp-29.1.9 {slave recursionlimit argument checking} {
1.2385 + interp create moo
1.2386 + set result [catch {moo recursionlimit foo} msg]
1.2387 + interp delete moo
1.2388 + list $result $msg
1.2389 +} {1 {expected integer but got "foo"}}
1.2390 +
1.2391 +test interp-29.1.10 {slave recursionlimit argument checking} {
1.2392 + interp create moo
1.2393 + set result [catch {moo recursionlimit 0} msg]
1.2394 + interp delete moo
1.2395 + list $result $msg
1.2396 +} {1 {recursion limit must be > 0}}
1.2397 +
1.2398 +test interp-29.1.11 {slave recursionlimit argument checking} {
1.2399 + interp create moo
1.2400 + set result [catch {moo recursionlimit -1} msg]
1.2401 + interp delete moo
1.2402 + list $result $msg
1.2403 +} {1 {recursion limit must be > 0}}
1.2404 +
1.2405 +test interp-29.1.12 {slave recursionlimit argument checking} {
1.2406 + interp create moo
1.2407 + set result [catch {moo recursionlimit [expr {wide(1)<<32}]} msg]
1.2408 + interp delete moo
1.2409 + list $result [string range $msg 0 35]
1.2410 +} {1 {integer value too large to represent}}
1.2411 +
1.2412 +test interp-29.2.1 {query recursion limit} {
1.2413 + interp recursionlimit {}
1.2414 +} 1000
1.2415 +
1.2416 +test interp-29.2.2 {query recursion limit} {
1.2417 + set i [interp create]
1.2418 + set n [interp recursionlimit $i]
1.2419 + interp delete $i
1.2420 + set n
1.2421 +} 1000
1.2422 +
1.2423 +test interp-29.2.3 {query recursion limit} {
1.2424 + set i [interp create]
1.2425 + set n [$i recursionlimit]
1.2426 + interp delete $i
1.2427 + set n
1.2428 +} 1000
1.2429 +
1.2430 +test interp-29.2.4 {query recursion limit} {
1.2431 + set i [interp create]
1.2432 + set r [$i eval {
1.2433 + set n1 [interp recursionlimit {} 42]
1.2434 + set n2 [interp recursionlimit {}]
1.2435 + list $n1 $n2
1.2436 + }]
1.2437 + interp delete $i
1.2438 + set r
1.2439 +} {42 42}
1.2440 +
1.2441 +test interp-29.2.5 {query recursion limit} {
1.2442 + set i [interp create]
1.2443 + set n1 [interp recursionlimit $i 42]
1.2444 + set n2 [interp recursionlimit $i]
1.2445 + interp delete $i
1.2446 + list $n1 $n2
1.2447 +} {42 42}
1.2448 +
1.2449 +test interp-29.2.6 {query recursion limit} {
1.2450 + set i [interp create]
1.2451 + set n1 [interp recursionlimit $i 42]
1.2452 + set n2 [$i recursionlimit]
1.2453 + interp delete $i
1.2454 + list $n1 $n2
1.2455 +} {42 42}
1.2456 +
1.2457 +test interp-29.2.7 {query recursion limit} {
1.2458 + set i [interp create]
1.2459 + set n1 [$i recursionlimit 42]
1.2460 + set n2 [interp recursionlimit $i]
1.2461 + interp delete $i
1.2462 + list $n1 $n2
1.2463 +} {42 42}
1.2464 +
1.2465 +test interp-29.2.8 {query recursion limit} {
1.2466 + set i [interp create]
1.2467 + set n1 [$i recursionlimit 42]
1.2468 + set n2 [$i recursionlimit]
1.2469 + interp delete $i
1.2470 + list $n1 $n2
1.2471 +} {42 42}
1.2472 +
1.2473 +test interp-29.3.1 {recursion limit} {
1.2474 + set i [interp create]
1.2475 + set r [interp eval $i {
1.2476 + interp recursionlimit {} 50
1.2477 + proc p {} {incr ::i; p}
1.2478 + set i 0
1.2479 + list [catch p msg] $msg $i
1.2480 + }]
1.2481 + interp delete $i
1.2482 + set r
1.2483 +} {1 {too many nested evaluations (infinite loop?)} 48}
1.2484 +
1.2485 +test interp-29.3.2 {recursion limit} {
1.2486 + set i [interp create]
1.2487 + interp recursionlimit $i 50
1.2488 + set r [interp eval $i {
1.2489 + proc p {} {incr ::i; p}
1.2490 + set i 0
1.2491 + list [catch p msg] $msg $i
1.2492 + }]
1.2493 + interp delete $i
1.2494 + set r
1.2495 +} {1 {too many nested evaluations (infinite loop?)} 48}
1.2496 +
1.2497 +test interp-29.3.3 {recursion limit} {
1.2498 + set i [interp create]
1.2499 + $i recursionlimit 50
1.2500 + set r [interp eval $i {
1.2501 + proc p {} {incr ::i; p}
1.2502 + set i 0
1.2503 + list [catch p msg] $msg $i
1.2504 + }]
1.2505 + interp delete $i
1.2506 + set r
1.2507 +} {1 {too many nested evaluations (infinite loop?)} 48}
1.2508 +
1.2509 +test interp-29.3.4 {recursion limit error reporting} {
1.2510 + interp create slave
1.2511 + set r1 [slave eval {
1.2512 + catch { # nesting level 1
1.2513 + eval { # 2
1.2514 + eval { # 3
1.2515 + eval { # 4
1.2516 + eval { # 5
1.2517 + interp recursionlimit {} 5
1.2518 + set x ok
1.2519 + }
1.2520 + }
1.2521 + }
1.2522 + }
1.2523 + } msg
1.2524 + }]
1.2525 + set r2 [slave eval { set msg }]
1.2526 + interp delete slave
1.2527 + list $r1 $r2
1.2528 +} {1 {falling back due to new recursion limit}}
1.2529 +
1.2530 +test interp-29.3.5 {recursion limit error reporting} {
1.2531 + interp create slave
1.2532 + set r1 [slave eval {
1.2533 + catch { # nesting level 1
1.2534 + eval { # 2
1.2535 + eval { # 3
1.2536 + eval { # 4
1.2537 + eval { # 5
1.2538 + interp recursionlimit {} 4
1.2539 + set x ok
1.2540 + }
1.2541 + }
1.2542 + }
1.2543 + }
1.2544 + } msg
1.2545 + }]
1.2546 + set r2 [slave eval { set msg }]
1.2547 + interp delete slave
1.2548 + list $r1 $r2
1.2549 +} {1 {falling back due to new recursion limit}}
1.2550 +
1.2551 +test interp-29.3.6 {recursion limit error reporting} {
1.2552 + interp create slave
1.2553 + set r1 [slave eval {
1.2554 + catch { # nesting level 1
1.2555 + eval { # 2
1.2556 + eval { # 3
1.2557 + eval { # 4
1.2558 + eval { # 5
1.2559 + interp recursionlimit {} 6
1.2560 + set x ok
1.2561 + }
1.2562 + }
1.2563 + }
1.2564 + }
1.2565 + } msg
1.2566 + }]
1.2567 + set r2 [slave eval { set msg }]
1.2568 + interp delete slave
1.2569 + list $r1 $r2
1.2570 +} {0 ok}
1.2571 +
1.2572 +test interp-29.3.7 {recursion limit error reporting} {
1.2573 + interp create slave
1.2574 + after 0 {interp recursionlimit slave 5}
1.2575 + set r1 [slave eval {
1.2576 + catch { # nesting level 1
1.2577 + eval { # 2
1.2578 + eval { # 3
1.2579 + eval { # 4
1.2580 + eval { # 5
1.2581 + update
1.2582 + set x ok
1.2583 + }
1.2584 + }
1.2585 + }
1.2586 + }
1.2587 + } msg
1.2588 + }]
1.2589 + set r2 [slave eval { set msg }]
1.2590 + interp delete slave
1.2591 + list $r1 $r2
1.2592 +} {1 {too many nested evaluations (infinite loop?)}}
1.2593 +
1.2594 +test interp-29.3.8 {recursion limit error reporting} {
1.2595 + interp create slave
1.2596 + after 0 {interp recursionlimit slave 4}
1.2597 + set r1 [slave eval {
1.2598 + catch { # nesting level 1
1.2599 + eval { # 2
1.2600 + eval { # 3
1.2601 + eval { # 4
1.2602 + eval { # 5
1.2603 + update
1.2604 + set x ok
1.2605 + }
1.2606 + }
1.2607 + }
1.2608 + }
1.2609 + } msg
1.2610 + }]
1.2611 + set r2 [slave eval { set msg }]
1.2612 + interp delete slave
1.2613 + list $r1 $r2
1.2614 +} {1 {too many nested evaluations (infinite loop?)}}
1.2615 +
1.2616 +test interp-29.3.9 {recursion limit error reporting} {
1.2617 + interp create slave
1.2618 + after 0 {interp recursionlimit slave 6}
1.2619 + set r1 [slave eval {
1.2620 + catch { # nesting level 1
1.2621 + eval { # 2
1.2622 + eval { # 3
1.2623 + eval { # 4
1.2624 + eval { # 5
1.2625 + update
1.2626 + set x ok
1.2627 + }
1.2628 + }
1.2629 + }
1.2630 + }
1.2631 + } msg
1.2632 + }]
1.2633 + set r2 [slave eval { set msg }]
1.2634 + interp delete slave
1.2635 + list $r1 $r2
1.2636 +} {0 ok}
1.2637 +
1.2638 +test interp-29.3.10 {recursion limit error reporting} {
1.2639 + interp create slave
1.2640 + after 0 {slave recursionlimit 4}
1.2641 + set r1 [slave eval {
1.2642 + catch { # nesting level 1
1.2643 + eval { # 2
1.2644 + eval { # 3
1.2645 + eval { # 4
1.2646 + eval { # 5
1.2647 + update
1.2648 + set x ok
1.2649 + }
1.2650 + }
1.2651 + }
1.2652 + }
1.2653 + } msg
1.2654 + }]
1.2655 + set r2 [slave eval { set msg }]
1.2656 + interp delete slave
1.2657 + list $r1 $r2
1.2658 +} {1 {too many nested evaluations (infinite loop?)}}
1.2659 +
1.2660 +test interp-29.3.11 {recursion limit error reporting} {
1.2661 + interp create slave
1.2662 + after 0 {slave recursionlimit 5}
1.2663 + set r1 [slave eval {
1.2664 + catch { # nesting level 1
1.2665 + eval { # 2
1.2666 + eval { # 3
1.2667 + eval { # 4
1.2668 + eval { # 5
1.2669 + update
1.2670 + set x ok
1.2671 + }
1.2672 + }
1.2673 + }
1.2674 + }
1.2675 + } msg
1.2676 + }]
1.2677 + set r2 [slave eval { set msg }]
1.2678 + interp delete slave
1.2679 + list $r1 $r2
1.2680 +} {1 {too many nested evaluations (infinite loop?)}}
1.2681 +
1.2682 +test interp-29.3.12 {recursion limit error reporting} {
1.2683 + interp create slave
1.2684 + after 0 {slave recursionlimit 6}
1.2685 + set r1 [slave eval {
1.2686 + catch { # nesting level 1
1.2687 + eval { # 2
1.2688 + eval { # 3
1.2689 + eval { # 4
1.2690 + eval { # 5
1.2691 + update
1.2692 + set x ok
1.2693 + }
1.2694 + }
1.2695 + }
1.2696 + }
1.2697 + } msg
1.2698 + }]
1.2699 + set r2 [slave eval { set msg }]
1.2700 + interp delete slave
1.2701 + list $r1 $r2
1.2702 +} {0 ok}
1.2703 +
1.2704 +test interp-29.4.1 {recursion limit inheritance} {
1.2705 + set i [interp create]
1.2706 + set ii [interp eval $i {
1.2707 + interp recursionlimit {} 50
1.2708 + interp create
1.2709 + }]
1.2710 + set r [interp eval [list $i $ii] {
1.2711 + proc p {} {incr ::i; p}
1.2712 + set i 0
1.2713 + catch p
1.2714 + set i
1.2715 + }]
1.2716 + interp delete $i
1.2717 + set r
1.2718 +} 49
1.2719 +
1.2720 +test interp-29.4.2 {recursion limit inheritance} {
1.2721 + set i [interp create]
1.2722 + $i recursionlimit 50
1.2723 + set ii [interp eval $i {interp create}]
1.2724 + set r [interp eval [list $i $ii] {
1.2725 + proc p {} {incr ::i; p}
1.2726 + set i 0
1.2727 + catch p
1.2728 + set i
1.2729 + }]
1.2730 + interp delete $i
1.2731 + set r
1.2732 +} 49
1.2733 +
1.2734 +test interp-29.5.1 {does slave recursion limit affect master?} {
1.2735 + set before [interp recursionlimit {}]
1.2736 + set i [interp create]
1.2737 + interp recursionlimit $i 20000
1.2738 + set after [interp recursionlimit {}]
1.2739 + set slavelimit [interp recursionlimit $i]
1.2740 + interp delete $i
1.2741 + list [expr {$before == $after}] $slavelimit
1.2742 +} {1 20000}
1.2743 +
1.2744 +test interp-29.5.2 {does slave recursion limit affect master?} {
1.2745 + set before [interp recursionlimit {}]
1.2746 + set i [interp create]
1.2747 + interp recursionlimit $i 20000
1.2748 + set after [interp recursionlimit {}]
1.2749 + set slavelimit [$i recursionlimit]
1.2750 + interp delete $i
1.2751 + list [expr {$before == $after}] $slavelimit
1.2752 +} {1 20000}
1.2753 +
1.2754 +test interp-29.5.3 {does slave recursion limit affect master?} {
1.2755 + set before [interp recursionlimit {}]
1.2756 + set i [interp create]
1.2757 + $i recursionlimit 20000
1.2758 + set after [interp recursionlimit {}]
1.2759 + set slavelimit [interp recursionlimit $i]
1.2760 + interp delete $i
1.2761 + list [expr {$before == $after}] $slavelimit
1.2762 +} {1 20000}
1.2763 +
1.2764 +test interp-29.5.4 {does slave recursion limit affect master?} {
1.2765 + set before [interp recursionlimit {}]
1.2766 + set i [interp create]
1.2767 + $i recursionlimit 20000
1.2768 + set after [interp recursionlimit {}]
1.2769 + set slavelimit [$i recursionlimit]
1.2770 + interp delete $i
1.2771 + list [expr {$before == $after}] $slavelimit
1.2772 +} {1 20000}
1.2773 +
1.2774 +test interp-29.6.1 {safe interpreter recursion limit} {
1.2775 + interp create slave -safe
1.2776 + set n [interp recursionlimit slave]
1.2777 + interp delete slave
1.2778 + set n
1.2779 +} 1000
1.2780 +
1.2781 +test interp-29.6.2 {safe interpreter recursion limit} {
1.2782 + interp create slave -safe
1.2783 + set n [slave recursionlimit]
1.2784 + interp delete slave
1.2785 + set n
1.2786 +} 1000
1.2787 +
1.2788 +test interp-29.6.3 {safe interpreter recursion limit} {
1.2789 + interp create slave -safe
1.2790 + set n1 [interp recursionlimit slave 42]
1.2791 + set n2 [interp recursionlimit slave]
1.2792 + interp delete slave
1.2793 + list $n1 $n2
1.2794 +} {42 42}
1.2795 +
1.2796 +test interp-29.6.4 {safe interpreter recursion limit} {
1.2797 + interp create slave -safe
1.2798 + set n1 [slave recursionlimit 42]
1.2799 + set n2 [interp recursionlimit slave]
1.2800 + interp delete slave
1.2801 + list $n1 $n2
1.2802 +} {42 42}
1.2803 +
1.2804 +test interp-29.6.5 {safe interpreter recursion limit} {
1.2805 + interp create slave -safe
1.2806 + set n1 [interp recursionlimit slave 42]
1.2807 + set n2 [slave recursionlimit]
1.2808 + interp delete slave
1.2809 + list $n1 $n2
1.2810 +} {42 42}
1.2811 +
1.2812 +test interp-29.6.6 {safe interpreter recursion limit} {
1.2813 + interp create slave -safe
1.2814 + set n1 [slave recursionlimit 42]
1.2815 + set n2 [slave recursionlimit]
1.2816 + interp delete slave
1.2817 + list $n1 $n2
1.2818 +} {42 42}
1.2819 +
1.2820 +test interp-29.6.7 {safe interpreter recursion limit} {
1.2821 + interp create slave -safe
1.2822 + set n1 [slave recursionlimit 42]
1.2823 + set n2 [slave recursionlimit]
1.2824 + interp delete slave
1.2825 + list $n1 $n2
1.2826 +} {42 42}
1.2827 +
1.2828 +test interp-29.6.8 {safe interpreter recursion limit} {
1.2829 + interp create slave -safe
1.2830 + set n [catch {slave eval {interp recursionlimit {} 42}} msg]
1.2831 + interp delete slave
1.2832 + list $n $msg
1.2833 +} {1 {permission denied: safe interpreters cannot change recursion limit}}
1.2834 +
1.2835 +test interp-29.6.9 {safe interpreter recursion limit} {
1.2836 + interp create slave -safe
1.2837 + set result [
1.2838 + slave eval {
1.2839 + interp create slave2 -safe
1.2840 + set n [catch {
1.2841 + interp recursionlimit slave2 42
1.2842 + } msg]
1.2843 + list $n $msg
1.2844 + }
1.2845 + ]
1.2846 + interp delete slave
1.2847 + set result
1.2848 +} {1 {permission denied: safe interpreters cannot change recursion limit}}
1.2849 +
1.2850 +test interp-29.6.10 {safe interpreter recursion limit} {
1.2851 + interp create slave -safe
1.2852 + set result [
1.2853 + slave eval {
1.2854 + interp create slave2 -safe
1.2855 + set n [catch {
1.2856 + slave2 recursionlimit 42
1.2857 + } msg]
1.2858 + list $n $msg
1.2859 + }
1.2860 + ]
1.2861 + interp delete slave
1.2862 + set result
1.2863 +} {1 {permission denied: safe interpreters cannot change recursion limit}}
1.2864 +
1.2865 +
1.2866 +# # Deep recursion (into interps when the regular one fails):
1.2867 +# # still crashes...
1.2868 +# proc p {} {
1.2869 +# if {[catch p ret]} {
1.2870 +# catch {
1.2871 +# set i [interp create]
1.2872 +# interp eval $i [list proc p {} [info body p]]
1.2873 +# interp eval $i p
1.2874 +# }
1.2875 +# interp delete $i
1.2876 +# return ok
1.2877 +# }
1.2878 +# return $ret
1.2879 +# }
1.2880 +# p
1.2881 +
1.2882 +# more tests needed...
1.2883 +
1.2884 +# Interp & stack
1.2885 +#test interp-29.1 {interp and stack (info level)} {
1.2886 +#} {}
1.2887 +
1.2888 +# End of stack-recursion tests
1.2889 +
1.2890 +# This test dumps core in Tcl 8.0.3!
1.2891 +test interp-30.1 {deletion of aliases inside namespaces} {
1.2892 + set i [interp create]
1.2893 + $i alias ns::cmd list
1.2894 + $i alias ns::cmd {}
1.2895 +} {}
1.2896 +
1.2897 +test interp-31.1 {alias invocation scope} {
1.2898 + proc mySet {varName value} {
1.2899 + upvar 1 $varName localVar
1.2900 + set localVar $value
1.2901 + }
1.2902 +
1.2903 + interp alias {} myNewSet {} mySet
1.2904 + proc testMyNewSet {value} {
1.2905 + myNewSet a $value
1.2906 + return $a
1.2907 + }
1.2908 + catch {unset a}
1.2909 + set result [testMyNewSet "ok"]
1.2910 + rename testMyNewSet {}
1.2911 + rename mySet {}
1.2912 + rename myNewSet {}
1.2913 + set result
1.2914 +} ok
1.2915 +
1.2916 +test interp-32.1 { parent's working directory should
1.2917 + be inherited by a child interp } {
1.2918 + cd [temporaryDirectory]
1.2919 + set parent [pwd]
1.2920 + set i [interp create]
1.2921 + set child [$i eval pwd]
1.2922 + interp delete $i
1.2923 + file mkdir cwd_test
1.2924 + cd cwd_test
1.2925 + lappend parent [pwd]
1.2926 + set i [interp create]
1.2927 + lappend child [$i eval pwd]
1.2928 + cd ..
1.2929 + file delete cwd_test
1.2930 + interp delete $i
1.2931 + cd [workingDirectory]
1.2932 + expr {[string equal $parent $child] ? 1 :
1.2933 + "\{$parent\} != \{$child\}"}
1.2934 +} 1
1.2935 +
1.2936 +test interp-33.1 {refCounting for target words of alias [Bug 730244]} {
1.2937 + # This test will panic if Bug 730244 is not fixed.
1.2938 + set i [interp create]
1.2939 + proc testHelper args {rename testHelper {}; return $args}
1.2940 + # Note: interp names are simple words by default
1.2941 + trace add execution testHelper enter "interp alias $i alias {} ;#"
1.2942 + interp alias $i alias {} testHelper this
1.2943 + $i eval alias
1.2944 +} this
1.2945 +
1.2946 +# cleanup
1.2947 +foreach i [interp slaves] {
1.2948 + interp delete $i
1.2949 +}
1.2950 +::tcltest::cleanupTests
1.2951 +return