| [25] | 1 | # This file tests the multiple interpreter facility of Tcl | 
|---|
 | 2 | # | 
|---|
 | 3 | # This file contains a collection of tests for one or more of the Tcl | 
|---|
 | 4 | # built-in commands.  Sourcing this file into Tcl runs the tests and | 
|---|
 | 5 | # generates output for errors.  No output means no errors were found. | 
|---|
 | 6 | # | 
|---|
 | 7 | # Copyright (c) 1995-1996 Sun Microsystems, Inc. | 
|---|
 | 8 | # Copyright (c) 1998-1999 by Scriptics Corporation. | 
|---|
 | 9 | # | 
|---|
 | 10 | # See the file "license.terms" for information on usage and redistribution | 
|---|
 | 11 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. | 
|---|
 | 12 | # | 
|---|
 | 13 | # RCS: @(#) $Id: interp.test,v 1.54 2008/03/02 19:12:41 msofer Exp $ | 
|---|
 | 14 |  | 
|---|
 | 15 | if {[lsearch [namespace children] ::tcltest] == -1} { | 
|---|
 | 16 |     package require tcltest 2.1 | 
|---|
 | 17 |     namespace import -force ::tcltest::* | 
|---|
 | 18 | } | 
|---|
 | 19 |  | 
|---|
 | 20 | testConstraint testinterpdelete [llength [info commands testinterpdelete]] | 
|---|
 | 21 |  | 
|---|
 | 22 | set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source unload} | 
|---|
 | 23 |  | 
|---|
 | 24 | foreach i [interp slaves] { | 
|---|
 | 25 |   interp delete $i | 
|---|
 | 26 | } | 
|---|
 | 27 |  | 
|---|
 | 28 | # Part 0: Check out options for interp command | 
|---|
 | 29 | test interp-1.1 {options for interp command} { | 
|---|
 | 30 |     list [catch {interp} msg] $msg | 
|---|
 | 31 | } {1 {wrong # args: should be "interp cmd ?arg ...?"}} | 
|---|
 | 32 | test interp-1.2 {options for interp command} { | 
|---|
 | 33 |     list [catch {interp frobox} msg] $msg | 
|---|
 | 34 | } {1 {bad option "frobox": must be alias, aliases, bgerror, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}} | 
|---|
 | 35 | test interp-1.3 {options for interp command} { | 
|---|
 | 36 |     interp delete | 
|---|
 | 37 | } "" | 
|---|
 | 38 | test interp-1.4 {options for interp command} { | 
|---|
 | 39 |     list [catch {interp delete foo bar} msg] $msg | 
|---|
 | 40 | } {1 {could not find interpreter "foo"}} | 
|---|
 | 41 | test interp-1.5 {options for interp command} { | 
|---|
 | 42 |     list [catch {interp exists foo bar} msg] $msg | 
|---|
 | 43 | } {1 {wrong # args: should be "interp exists ?path?"}} | 
|---|
 | 44 | # | 
|---|
 | 45 | # test interp-0.6 was removed | 
|---|
 | 46 | # | 
|---|
 | 47 | test interp-1.6 {options for interp command} { | 
|---|
 | 48 |     list [catch {interp slaves foo bar zop} msg] $msg | 
|---|
 | 49 | } {1 {wrong # args: should be "interp slaves ?path?"}} | 
|---|
 | 50 | test interp-1.7 {options for interp command} { | 
|---|
 | 51 |     list [catch {interp hello} msg] $msg | 
|---|
 | 52 | } {1 {bad option "hello": must be alias, aliases, bgerror, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}} | 
|---|
 | 53 | test interp-1.8 {options for interp command} { | 
|---|
 | 54 |     list [catch {interp -froboz} msg] $msg | 
|---|
 | 55 | } {1 {bad option "-froboz": must be alias, aliases, bgerror, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}} | 
|---|
 | 56 | test interp-1.9 {options for interp command} { | 
|---|
 | 57 |     list [catch {interp -froboz -safe} msg] $msg | 
|---|
 | 58 | } {1 {bad option "-froboz": must be alias, aliases, bgerror, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}  | 
|---|
 | 59 | test interp-1.10 {options for interp command} { | 
|---|
 | 60 |     list [catch {interp target} msg] $msg | 
|---|
 | 61 | } {1 {wrong # args: should be "interp target path alias"}} | 
|---|
 | 62 |  | 
|---|
 | 63 |  | 
|---|
 | 64 | # Part 1: Basic interpreter creation tests: | 
|---|
 | 65 | test interp-2.1 {basic interpreter creation} { | 
|---|
 | 66 |     interp create a | 
|---|
 | 67 | } a | 
|---|
 | 68 | test interp-2.2 {basic interpreter creation} { | 
|---|
 | 69 |     catch {interp create} | 
|---|
 | 70 | } 0 | 
|---|
 | 71 | test interp-2.3 {basic interpreter creation} { | 
|---|
 | 72 |     catch {interp create -safe} | 
|---|
 | 73 | } 0  | 
|---|
 | 74 | test interp-2.4 {basic interpreter creation} { | 
|---|
 | 75 |     list [catch {interp create a} msg] $msg | 
|---|
 | 76 | } {1 {interpreter named "a" already exists, cannot create}} | 
|---|
 | 77 | test interp-2.5 {basic interpreter creation} { | 
|---|
 | 78 |     interp create b -safe | 
|---|
 | 79 | } b | 
|---|
 | 80 | test interp-2.6 {basic interpreter creation} { | 
|---|
 | 81 |     interp create d -safe | 
|---|
 | 82 | } d | 
|---|
 | 83 | test interp-2.7 {basic interpreter creation} { | 
|---|
 | 84 |     list [catch {interp create -froboz} msg] $msg | 
|---|
 | 85 | } {1 {bad option "-froboz": must be -safe or --}} | 
|---|
 | 86 | test interp-2.8 {basic interpreter creation} { | 
|---|
 | 87 |     interp create -- -froboz | 
|---|
 | 88 | } -froboz | 
|---|
 | 89 | test interp-2.9 {basic interpreter creation} { | 
|---|
 | 90 |     interp create -safe -- -froboz1 | 
|---|
 | 91 | } -froboz1 | 
|---|
 | 92 | test interp-2.10 {basic interpreter creation} { | 
|---|
 | 93 |     interp create {a x1} | 
|---|
 | 94 |     interp create {a x2} | 
|---|
 | 95 |     interp create {a x3} -safe | 
|---|
 | 96 | } {a x3} | 
|---|
 | 97 | test interp-2.11 {anonymous interps vs existing procs} { | 
|---|
 | 98 |     set x [interp create] | 
|---|
 | 99 |     regexp "interp(\[0-9]+)" $x dummy thenum | 
|---|
 | 100 |     interp delete $x | 
|---|
 | 101 |     proc interp$thenum {} {} | 
|---|
 | 102 |     set x [interp create] | 
|---|
 | 103 |     regexp "interp(\[0-9]+)" $x dummy anothernum | 
|---|
 | 104 |     expr $anothernum > $thenum | 
|---|
 | 105 | } 1     | 
|---|
 | 106 | test interp-2.12 {anonymous interps vs existing procs} { | 
|---|
 | 107 |     set x [interp create -safe] | 
|---|
 | 108 |     regexp "interp(\[0-9]+)" $x dummy thenum | 
|---|
 | 109 |     interp delete $x | 
|---|
 | 110 |     proc interp$thenum {} {} | 
|---|
 | 111 |     set x [interp create -safe] | 
|---|
 | 112 |     regexp "interp(\[0-9]+)" $x dummy anothernum | 
|---|
 | 113 |     expr $anothernum - $thenum | 
|---|
 | 114 | } 1     | 
|---|
 | 115 | test interp-2.13 {correct default when no $path arg is given} -body { | 
|---|
 | 116 |     interp create -- | 
|---|
 | 117 | } -match regexp -result {interp[0-9]+} | 
|---|
 | 118 |      | 
|---|
 | 119 | foreach i [interp slaves] { | 
|---|
 | 120 |     interp delete $i | 
|---|
 | 121 | } | 
|---|
 | 122 |  | 
|---|
 | 123 | # Part 2: Testing "interp slaves" and "interp exists" | 
|---|
 | 124 | test interp-3.1 {testing interp exists and interp slaves} { | 
|---|
 | 125 |     interp slaves | 
|---|
 | 126 | } "" | 
|---|
 | 127 | test interp-3.2 {testing interp exists and interp slaves} { | 
|---|
 | 128 |     interp create a | 
|---|
 | 129 |     interp exists a | 
|---|
 | 130 | } 1 | 
|---|
 | 131 | test interp-3.3 {testing interp exists and interp slaves} { | 
|---|
 | 132 |     interp exists nonexistent | 
|---|
 | 133 | } 0 | 
|---|
 | 134 | test interp-3.4 {testing interp exists and interp slaves} { | 
|---|
 | 135 |     list [catch {interp slaves a b c} msg] $msg | 
|---|
 | 136 | } {1 {wrong # args: should be "interp slaves ?path?"}} | 
|---|
 | 137 | test interp-3.5 {testing interp exists and interp slaves} { | 
|---|
 | 138 |     list [catch {interp exists a b c} msg] $msg | 
|---|
 | 139 | } {1 {wrong # args: should be "interp exists ?path?"}} | 
|---|
 | 140 | test interp-3.6 {testing interp exists and interp slaves} { | 
|---|
 | 141 |     interp exists | 
|---|
 | 142 | } 1 | 
|---|
 | 143 | test interp-3.7 {testing interp exists and interp slaves} { | 
|---|
 | 144 |     interp slaves | 
|---|
 | 145 | } a | 
|---|
 | 146 | test interp-3.8 {testing interp exists and interp slaves} { | 
|---|
 | 147 |     list [catch {interp slaves a b c} msg] $msg | 
|---|
 | 148 | } {1 {wrong # args: should be "interp slaves ?path?"}} | 
|---|
 | 149 | test interp-3.9 {testing interp exists and interp slaves} { | 
|---|
 | 150 |     interp create {a a2} -safe | 
|---|
 | 151 |     expr {[lsearch [interp slaves a] a2] >= 0} | 
|---|
 | 152 | } 1 | 
|---|
 | 153 | test interp-3.10 {testing interp exists and interp slaves} { | 
|---|
 | 154 |     interp exists {a a2} | 
|---|
 | 155 | } 1 | 
|---|
 | 156 |  | 
|---|
 | 157 | # Part 3: Testing "interp delete" | 
|---|
 | 158 | test interp-3.11 {testing interp delete} { | 
|---|
 | 159 |     interp delete | 
|---|
 | 160 | } "" | 
|---|
 | 161 | test interp-4.1 {testing interp delete} { | 
|---|
 | 162 |     catch {interp create a} | 
|---|
 | 163 |     interp delete a | 
|---|
 | 164 | } "" | 
|---|
 | 165 | test interp-4.2 {testing interp delete} { | 
|---|
 | 166 |     list [catch {interp delete nonexistent} msg] $msg | 
|---|
 | 167 | } {1 {could not find interpreter "nonexistent"}} | 
|---|
 | 168 | test interp-4.3 {testing interp delete} { | 
|---|
 | 169 |     list [catch {interp delete x y z} msg] $msg | 
|---|
 | 170 | } {1 {could not find interpreter "x"}} | 
|---|
 | 171 | test interp-4.4 {testing interp delete} { | 
|---|
 | 172 |     interp delete | 
|---|
 | 173 | } "" | 
|---|
 | 174 | test interp-4.5 {testing interp delete} { | 
|---|
 | 175 |     interp create a | 
|---|
 | 176 |     interp create {a x1} | 
|---|
 | 177 |     interp delete {a x1} | 
|---|
 | 178 |     expr {[lsearch [interp slaves a] x1] >= 0} | 
|---|
 | 179 | } 0 | 
|---|
 | 180 | test interp-4.6 {testing interp delete} { | 
|---|
 | 181 |     interp create c1 | 
|---|
 | 182 |     interp create c2 | 
|---|
 | 183 |     interp create c3 | 
|---|
 | 184 |     interp delete c1 c2 c3 | 
|---|
 | 185 | } "" | 
|---|
 | 186 | test interp-4.7 {testing interp delete} { | 
|---|
 | 187 |     interp create c1 | 
|---|
 | 188 |     interp create c2 | 
|---|
 | 189 |     list [catch {interp delete c1 c2 c3} msg] $msg | 
|---|
 | 190 | } {1 {could not find interpreter "c3"}} | 
|---|
 | 191 | test interp-4.8 {testing interp delete} { | 
|---|
 | 192 |     list [catch {interp delete {}} msg] $msg | 
|---|
 | 193 | } {1 {cannot delete the current interpreter}} | 
|---|
 | 194 |  | 
|---|
 | 195 | foreach i [interp slaves] { | 
|---|
 | 196 |     interp delete $i | 
|---|
 | 197 | } | 
|---|
 | 198 |  | 
|---|
 | 199 | # Part 4: Consistency checking - all nondeleted interpreters should be | 
|---|
 | 200 | # there: | 
|---|
 | 201 | test interp-5.1 {testing consistency} { | 
|---|
 | 202 |     interp slaves | 
|---|
 | 203 | } "" | 
|---|
 | 204 | test interp-5.2 {testing consistency} { | 
|---|
 | 205 |     interp exists a | 
|---|
 | 206 | } 0 | 
|---|
 | 207 | test interp-5.3 {testing consistency} { | 
|---|
 | 208 |     interp exists nonexistent | 
|---|
 | 209 | } 0 | 
|---|
 | 210 |  | 
|---|
 | 211 | # Recreate interpreter "a" | 
|---|
 | 212 | interp create a | 
|---|
 | 213 |  | 
|---|
 | 214 | # Part 5: Testing eval in interpreter object command and with interp command | 
|---|
 | 215 | test interp-6.1 {testing eval} { | 
|---|
 | 216 |     a eval expr 3 + 5 | 
|---|
 | 217 | } 8 | 
|---|
 | 218 | test interp-6.2 {testing eval} { | 
|---|
 | 219 |     list [catch {a eval foo} msg] $msg | 
|---|
 | 220 | } {1 {invalid command name "foo"}} | 
|---|
 | 221 | test interp-6.3 {testing eval} { | 
|---|
 | 222 |     a eval {proc foo {} {expr 3 + 5}} | 
|---|
 | 223 |     a eval foo | 
|---|
 | 224 | } 8 | 
|---|
 | 225 | test interp-6.4 {testing eval} { | 
|---|
 | 226 |     interp eval a foo | 
|---|
 | 227 | } 8 | 
|---|
 | 228 |  | 
|---|
 | 229 | test interp-6.5 {testing eval} { | 
|---|
 | 230 |     interp create {a x2} | 
|---|
 | 231 |     interp eval {a x2} {proc frob {} {expr 4 * 9}} | 
|---|
 | 232 |     interp eval {a x2} frob | 
|---|
 | 233 | } 36 | 
|---|
 | 234 | test interp-6.6 {testing eval} { | 
|---|
 | 235 |     list [catch {interp eval {a x2} foo} msg] $msg | 
|---|
 | 236 | } {1 {invalid command name "foo"}} | 
|---|
 | 237 |  | 
|---|
 | 238 | # UTILITY PROCEDURE RUNNING IN MASTER INTERPRETER: | 
|---|
 | 239 | proc in_master {args} { | 
|---|
 | 240 |      return [list seen in master: $args] | 
|---|
 | 241 | } | 
|---|
 | 242 |  | 
|---|
 | 243 | # Part 6: Testing basic alias creation | 
|---|
 | 244 | test interp-7.1 {testing basic alias creation} { | 
|---|
 | 245 |     a alias foo in_master | 
|---|
 | 246 | } foo | 
|---|
 | 247 | test interp-7.2 {testing basic alias creation} { | 
|---|
 | 248 |     a alias bar in_master a1 a2 a3 | 
|---|
 | 249 | } bar | 
|---|
 | 250 | # Test 6.3 has been deleted. | 
|---|
 | 251 | test interp-7.3 {testing basic alias creation} { | 
|---|
 | 252 |     a alias foo | 
|---|
 | 253 | } in_master | 
|---|
 | 254 | test interp-7.4 {testing basic alias creation} { | 
|---|
 | 255 |     a alias bar | 
|---|
 | 256 | } {in_master a1 a2 a3} | 
|---|
 | 257 | test interp-7.5 {testing basic alias creation} { | 
|---|
 | 258 |     lsort [a aliases] | 
|---|
 | 259 | } {bar foo} | 
|---|
 | 260 | test interp-7.6 {testing basic aliases arg checking} { | 
|---|
 | 261 |     list [catch {a aliases too many args} msg] $msg | 
|---|
 | 262 | } {1 {wrong # args: should be "a aliases"}} | 
|---|
 | 263 |  | 
|---|
 | 264 | # Part 7: testing basic alias invocation | 
|---|
 | 265 | test interp-8.1 {testing basic alias invocation} { | 
|---|
 | 266 |     catch {interp create a} | 
|---|
 | 267 |     a alias foo in_master | 
|---|
 | 268 |     a eval foo s1 s2 s3 | 
|---|
 | 269 | } {seen in master: {s1 s2 s3}} | 
|---|
 | 270 | test interp-8.2 {testing basic alias invocation} { | 
|---|
 | 271 |     catch {interp create a} | 
|---|
 | 272 |     a alias bar in_master a1 a2 a3 | 
|---|
 | 273 |     a eval bar s1 s2 s3 | 
|---|
 | 274 | } {seen in master: {a1 a2 a3 s1 s2 s3}} | 
|---|
 | 275 | test interp-8.3 {testing basic alias invocation} { | 
|---|
 | 276 |    catch {interp create a} | 
|---|
 | 277 |    list [catch {a alias} msg] $msg | 
|---|
 | 278 | } {1 {wrong # args: should be "a alias aliasName ?targetName? ?args..?"}} | 
|---|
 | 279 |  | 
|---|
 | 280 | # Part 8: Testing aliases for non-existent or hidden targets | 
|---|
 | 281 | test interp-9.1 {testing aliases for non-existent targets} { | 
|---|
 | 282 |     catch {interp create a} | 
|---|
 | 283 |     a alias zop nonexistent-command-in-master | 
|---|
 | 284 |     list [catch {a eval zop} msg] $msg | 
|---|
 | 285 | } {1 {invalid command name "nonexistent-command-in-master"}} | 
|---|
 | 286 | test interp-9.2 {testing aliases for non-existent targets} { | 
|---|
 | 287 |     catch {interp create a} | 
|---|
 | 288 |     a alias zop nonexistent-command-in-master | 
|---|
 | 289 |     proc nonexistent-command-in-master {} {return i_exist!} | 
|---|
 | 290 |     a eval zop | 
|---|
 | 291 | } i_exist! | 
|---|
 | 292 | test interp-9.3 {testing aliases for hidden commands} { | 
|---|
 | 293 |     catch {interp create a} | 
|---|
 | 294 |     a eval {proc p {} {return ENTER_A}} | 
|---|
 | 295 |     interp alias {} p a p | 
|---|
 | 296 |     set res {} | 
|---|
 | 297 |     lappend res [list [catch p msg] $msg] | 
|---|
 | 298 |     interp hide a p | 
|---|
 | 299 |     lappend res [list [catch p msg] $msg] | 
|---|
 | 300 |     rename p {} | 
|---|
 | 301 |     interp delete a | 
|---|
 | 302 |     set res | 
|---|
 | 303 |  } {{0 ENTER_A} {1 {invalid command name "p"}}} | 
|---|
 | 304 | test interp-9.4 {testing aliases and namespace commands} { | 
|---|
 | 305 |     proc p {} {return GLOBAL} | 
|---|
 | 306 |     namespace eval tst { | 
|---|
 | 307 |         proc p {} {return NAMESPACE} | 
|---|
 | 308 |     } | 
|---|
 | 309 |     interp alias {} a {} p | 
|---|
 | 310 |     set res [a] | 
|---|
 | 311 |     lappend res [namespace eval tst a] | 
|---|
 | 312 |     rename p {} | 
|---|
 | 313 |     rename a {} | 
|---|
 | 314 |     namespace delete tst | 
|---|
 | 315 |     set res | 
|---|
 | 316 |  } {GLOBAL GLOBAL} | 
|---|
 | 317 |  | 
|---|
 | 318 | if {[info command nonexistent-command-in-master] != ""} { | 
|---|
 | 319 |     rename nonexistent-command-in-master {} | 
|---|
 | 320 | } | 
|---|
 | 321 |  | 
|---|
 | 322 | # Part 9: Aliasing between interpreters | 
|---|
 | 323 | test interp-10.1 {testing aliasing between interpreters} { | 
|---|
 | 324 |     catch {interp delete a} | 
|---|
 | 325 |     catch {interp delete b} | 
|---|
 | 326 |     interp create a | 
|---|
 | 327 |     interp create b | 
|---|
 | 328 |     interp alias a a_alias b b_alias 1 2 3 | 
|---|
 | 329 | } a_alias | 
|---|
 | 330 | test interp-10.2 {testing aliasing between interpreters} { | 
|---|
 | 331 |     catch {interp delete a} | 
|---|
 | 332 |     catch {interp delete b} | 
|---|
 | 333 |     interp create a | 
|---|
 | 334 |     interp create b | 
|---|
 | 335 |     b eval {proc b_alias {args} {return [list got $args]}} | 
|---|
 | 336 |     interp alias a a_alias b b_alias 1 2 3 | 
|---|
 | 337 |     a eval a_alias a b c | 
|---|
 | 338 | } {got {1 2 3 a b c}} | 
|---|
 | 339 | test interp-10.3 {testing aliasing between interpreters} { | 
|---|
 | 340 |     catch {interp delete a} | 
|---|
 | 341 |     catch {interp delete b} | 
|---|
 | 342 |     interp create a | 
|---|
 | 343 |     interp create b | 
|---|
 | 344 |     interp alias a a_alias b b_alias 1 2 3 | 
|---|
 | 345 |     list [catch {a eval a_alias a b c} msg] $msg | 
|---|
 | 346 | } {1 {invalid command name "b_alias"}} | 
|---|
 | 347 | test interp-10.4 {testing aliasing between interpreters} { | 
|---|
 | 348 |     catch {interp delete a} | 
|---|
 | 349 |     interp create a | 
|---|
 | 350 |     a alias a_alias puts | 
|---|
 | 351 |     a aliases | 
|---|
 | 352 | } a_alias | 
|---|
 | 353 | test interp-10.5 {testing aliasing between interpreters} { | 
|---|
 | 354 |     catch {interp delete a} | 
|---|
 | 355 |     catch {interp delete b} | 
|---|
 | 356 |     interp create a | 
|---|
 | 357 |     interp create b | 
|---|
 | 358 |     a alias a_alias puts | 
|---|
 | 359 |     interp alias a a_del b b_del | 
|---|
 | 360 |     interp delete b | 
|---|
 | 361 |     a aliases | 
|---|
 | 362 | } a_alias | 
|---|
 | 363 | test interp-10.6 {testing aliasing between interpreters} { | 
|---|
 | 364 |     catch {interp delete a} | 
|---|
 | 365 |     catch {interp delete b} | 
|---|
 | 366 |     interp create a | 
|---|
 | 367 |     interp create b | 
|---|
 | 368 |     interp alias a a_command b b_command a1 a2 a3 | 
|---|
 | 369 |     b alias b_command in_master b1 b2 b3 | 
|---|
 | 370 |     a eval a_command m1 m2 m3 | 
|---|
 | 371 | } {seen in master: {b1 b2 b3 a1 a2 a3 m1 m2 m3}} | 
|---|
 | 372 | test interp-10.7 {testing aliases between interpreters} { | 
|---|
 | 373 |     catch {interp delete a} | 
|---|
 | 374 |     interp create a | 
|---|
 | 375 |     interp alias "" foo a zoppo | 
|---|
 | 376 |     a eval {proc zoppo {x} {list $x $x $x}} | 
|---|
 | 377 |     set x [foo 33] | 
|---|
 | 378 |     a eval {rename zoppo {}} | 
|---|
 | 379 |     interp alias "" foo a {} | 
|---|
 | 380 |     return $x | 
|---|
 | 381 | } {33 33 33} | 
|---|
 | 382 |  | 
|---|
 | 383 | # Part 10: Testing "interp target" | 
|---|
 | 384 | test interp-11.1 {testing interp target} { | 
|---|
 | 385 |     list [catch {interp target} msg] $msg | 
|---|
 | 386 | } {1 {wrong # args: should be "interp target path alias"}} | 
|---|
 | 387 | test interp-11.2 {testing interp target} { | 
|---|
 | 388 |     list [catch {interp target nosuchinterpreter foo} msg] $msg | 
|---|
 | 389 | } {1 {could not find interpreter "nosuchinterpreter"}} | 
|---|
 | 390 | test interp-11.3 {testing interp target} { | 
|---|
 | 391 |     catch {interp delete a} | 
|---|
 | 392 |     interp create a | 
|---|
 | 393 |     a alias boo no_command | 
|---|
 | 394 |     interp target a boo | 
|---|
 | 395 | } "" | 
|---|
 | 396 | test interp-11.4 {testing interp target} { | 
|---|
 | 397 |     catch {interp delete x1} | 
|---|
 | 398 |     interp create x1 | 
|---|
 | 399 |     x1 eval interp create x2 | 
|---|
 | 400 |     x1 eval x2 eval interp create x3 | 
|---|
 | 401 |     catch {interp delete y1} | 
|---|
 | 402 |     interp create y1 | 
|---|
 | 403 |     y1 eval interp create y2 | 
|---|
 | 404 |     y1 eval y2 eval interp create y3 | 
|---|
 | 405 |     interp alias {x1 x2 x3} xcommand {y1 y2 y3} ycommand | 
|---|
 | 406 |     interp target {x1 x2 x3} xcommand | 
|---|
 | 407 | } {y1 y2 y3} | 
|---|
 | 408 | test interp-11.5 {testing interp target} { | 
|---|
 | 409 |     catch {interp delete x1} | 
|---|
 | 410 |     interp create x1 | 
|---|
 | 411 |     interp create {x1 x2} | 
|---|
 | 412 |     interp create {x1 x2 x3} | 
|---|
 | 413 |     catch {interp delete y1} | 
|---|
 | 414 |     interp create y1 | 
|---|
 | 415 |     interp create {y1 y2} | 
|---|
 | 416 |     interp create {y1 y2 y3} | 
|---|
 | 417 |     interp alias {x1 x2 x3} xcommand {y1 y2 y3} ycommand | 
|---|
 | 418 |     list [catch {x1 eval {interp target {x2 x3} xcommand}} msg] $msg | 
|---|
 | 419 | } {1 {target interpreter for alias "xcommand" in path "x2 x3" is not my descendant}} | 
|---|
 | 420 | test interp-11.6 {testing interp target} { | 
|---|
 | 421 |     foreach a [interp aliases] { | 
|---|
 | 422 |         rename $a {} | 
|---|
 | 423 |     } | 
|---|
 | 424 |     list [catch {interp target {} foo} msg] $msg | 
|---|
 | 425 | } {1 {alias "foo" in path "" not found}} | 
|---|
 | 426 | test interp-11.7 {testing interp target} { | 
|---|
 | 427 |     catch {interp delete a} | 
|---|
 | 428 |     interp create a | 
|---|
 | 429 |     list [catch {interp target a foo} msg] $msg | 
|---|
 | 430 | } {1 {alias "foo" in path "a" not found}} | 
|---|
 | 431 |  | 
|---|
 | 432 | # Part 11: testing "interp issafe" | 
|---|
 | 433 | test interp-12.1 {testing interp issafe} { | 
|---|
 | 434 |     interp issafe | 
|---|
 | 435 | } 0 | 
|---|
 | 436 | test interp-12.2 {testing interp issafe} { | 
|---|
 | 437 |     catch {interp delete a} | 
|---|
 | 438 |     interp create a | 
|---|
 | 439 |     interp issafe a | 
|---|
 | 440 | } 0 | 
|---|
 | 441 | test interp-12.3 {testing interp issafe} { | 
|---|
 | 442 |     catch {interp delete a} | 
|---|
 | 443 |     interp create a | 
|---|
 | 444 |     interp create {a x3} -safe | 
|---|
 | 445 |     interp issafe {a x3} | 
|---|
 | 446 | } 1 | 
|---|
 | 447 | test interp-12.4 {testing interp issafe} { | 
|---|
 | 448 |     catch {interp delete a} | 
|---|
 | 449 |     interp create a | 
|---|
 | 450 |     interp create {a x3} -safe | 
|---|
 | 451 |     interp create {a x3 foo} | 
|---|
 | 452 |     interp issafe {a x3 foo} | 
|---|
 | 453 | } 1 | 
|---|
 | 454 |  | 
|---|
 | 455 | # Part 12: testing interpreter object command "issafe" sub-command | 
|---|
 | 456 | test interp-13.1 {testing foo issafe} { | 
|---|
 | 457 |     catch {interp delete a} | 
|---|
 | 458 |     interp create a | 
|---|
 | 459 |     a issafe | 
|---|
 | 460 | } 0 | 
|---|
 | 461 | test interp-13.2 {testing foo issafe} { | 
|---|
 | 462 |     catch {interp delete a} | 
|---|
 | 463 |     interp create a | 
|---|
 | 464 |     interp create {a x3} -safe | 
|---|
 | 465 |     a eval x3 issafe | 
|---|
 | 466 | } 1 | 
|---|
 | 467 | test interp-13.3 {testing foo issafe} { | 
|---|
 | 468 |     catch {interp delete a} | 
|---|
 | 469 |     interp create a | 
|---|
 | 470 |     interp create {a x3} -safe | 
|---|
 | 471 |     interp create {a x3 foo} | 
|---|
 | 472 |     a eval x3 eval foo issafe | 
|---|
 | 473 | } 1 | 
|---|
 | 474 | test interp-13.4 {testing issafe arg checking} { | 
|---|
 | 475 |     catch {interp create a} | 
|---|
 | 476 |     list [catch {a issafe too many args} msg] $msg | 
|---|
 | 477 | } {1 {wrong # args: should be "a issafe"}} | 
|---|
 | 478 |  | 
|---|
 | 479 | # part 14: testing interp aliases | 
|---|
 | 480 | test interp-14.1 {testing interp aliases} { | 
|---|
 | 481 |     interp aliases | 
|---|
 | 482 | } "" | 
|---|
 | 483 | test interp-14.2 {testing interp aliases} { | 
|---|
 | 484 |     catch {interp delete a} | 
|---|
 | 485 |     interp create a | 
|---|
 | 486 |     a alias a1 puts | 
|---|
 | 487 |     a alias a2 puts | 
|---|
 | 488 |     a alias a3 puts | 
|---|
 | 489 |     lsort [interp aliases a] | 
|---|
 | 490 | } {a1 a2 a3} | 
|---|
 | 491 | test interp-14.3 {testing interp aliases} { | 
|---|
 | 492 |     catch {interp delete a} | 
|---|
 | 493 |     interp create a | 
|---|
 | 494 |     interp create {a x3} | 
|---|
 | 495 |     interp alias {a x3} froboz "" puts | 
|---|
 | 496 |     interp aliases {a x3} | 
|---|
 | 497 | } froboz | 
|---|
 | 498 | test interp-14.4 {testing interp alias - alias over master} { | 
|---|
 | 499 |     # SF Bug 641195 | 
|---|
 | 500 |     catch {interp delete a} | 
|---|
 | 501 |     interp create a | 
|---|
 | 502 |     list [catch {interp alias "" a a eval} msg] $msg [info commands a] | 
|---|
 | 503 | } {1 {cannot define or rename alias "a": interpreter deleted} {}} | 
|---|
 | 504 | test interp-14.5 {testing interp-alias: wrong # args} -body { | 
|---|
 | 505 |     proc setx x {set x} | 
|---|
 | 506 |     interp alias {} a {} setx | 
|---|
 | 507 |     catch {a 1 2} | 
|---|
 | 508 |     set ::errorInfo | 
|---|
 | 509 | } -cleanup { | 
|---|
 | 510 |     rename setx {} | 
|---|
 | 511 |     rename a {} | 
|---|
 | 512 | } -result {wrong # args: should be "a x" | 
|---|
 | 513 |     while executing | 
|---|
 | 514 | "a 1 2"} | 
|---|
 | 515 | test interp-14.6 {testing interp-alias: wrong # args} -setup { | 
|---|
 | 516 |     proc setx x {set x} | 
|---|
 | 517 |     catch {interp delete a} | 
|---|
 | 518 |     interp create a | 
|---|
 | 519 | } -body { | 
|---|
 | 520 |     interp alias a a {} setx | 
|---|
 | 521 |     catch {a eval a 1 2} | 
|---|
 | 522 |     set ::errorInfo | 
|---|
 | 523 | } -cleanup { | 
|---|
 | 524 |     rename setx {} | 
|---|
 | 525 |     interp delete a | 
|---|
 | 526 | } -result {wrong # args: should be "a x" | 
|---|
 | 527 |     invoked from within | 
|---|
 | 528 | "a 1 2" | 
|---|
 | 529 |     invoked from within | 
|---|
 | 530 | "a eval a 1 2"} | 
|---|
 | 531 | test interp-14.7 {testing interp-alias: wrong # args} -setup { | 
|---|
 | 532 |     proc setx x {set x} | 
|---|
 | 533 |     catch {interp delete a} | 
|---|
 | 534 |     interp create a | 
|---|
 | 535 | } -body { | 
|---|
 | 536 |     interp alias a a {} setx | 
|---|
 | 537 |     a eval { | 
|---|
 | 538 |         catch {a 1 2} | 
|---|
 | 539 |         set ::errorInfo | 
|---|
 | 540 |     } | 
|---|
 | 541 | } -cleanup { | 
|---|
 | 542 |     rename setx {} | 
|---|
 | 543 |     interp delete a | 
|---|
 | 544 | } -result {wrong # args: should be "a x" | 
|---|
 | 545 |     invoked from within | 
|---|
 | 546 | "a 1 2"} | 
|---|
 | 547 | test interp-14.8 {testing interp-alias: error messages} -body { | 
|---|
 | 548 |     proc setx x {return -code error x} | 
|---|
 | 549 |     interp alias {} a {} setx | 
|---|
 | 550 |     catch {a 1} | 
|---|
 | 551 |     set ::errorInfo | 
|---|
 | 552 | } -cleanup { | 
|---|
 | 553 |     rename setx {} | 
|---|
 | 554 |     rename a {} | 
|---|
 | 555 | } -result {x | 
|---|
 | 556 |     while executing | 
|---|
 | 557 | "a 1"} | 
|---|
 | 558 | test interp-14.9 {testing interp-alias: error messages} -setup { | 
|---|
 | 559 |     proc setx x {return -code error x} | 
|---|
 | 560 |     catch {interp delete a} | 
|---|
 | 561 |     interp create a | 
|---|
 | 562 | } -body { | 
|---|
 | 563 |     interp alias a a {} setx | 
|---|
 | 564 |     catch {a eval a 1} | 
|---|
 | 565 |     set ::errorInfo | 
|---|
 | 566 | } -cleanup { | 
|---|
 | 567 |     rename setx {} | 
|---|
 | 568 |     interp delete a | 
|---|
 | 569 | } -result {x | 
|---|
 | 570 |     invoked from within | 
|---|
 | 571 | "a 1" | 
|---|
 | 572 |     invoked from within | 
|---|
 | 573 | "a eval a 1"} | 
|---|
 | 574 | test interp-14.10 {testing interp-alias: error messages} -setup { | 
|---|
 | 575 |     proc setx x {return -code error x} | 
|---|
 | 576 |     catch {interp delete a} | 
|---|
 | 577 |     interp create a | 
|---|
 | 578 | } -body { | 
|---|
 | 579 |     interp alias a a {} setx | 
|---|
 | 580 |     a eval { | 
|---|
 | 581 |         catch {a 1} | 
|---|
 | 582 |         set ::errorInfo | 
|---|
 | 583 |     } | 
|---|
 | 584 | } -cleanup { | 
|---|
 | 585 |     rename setx {} | 
|---|
 | 586 |     interp delete a | 
|---|
 | 587 | } -result {x | 
|---|
 | 588 |     invoked from within | 
|---|
 | 589 | "a 1"} | 
|---|
 | 590 |  | 
|---|
 | 591 |  | 
|---|
 | 592 | # part 15: testing file sharing | 
|---|
 | 593 | test interp-15.1 {testing file sharing} { | 
|---|
 | 594 |     catch {interp delete z} | 
|---|
 | 595 |     interp create z | 
|---|
 | 596 |     z eval close stdout | 
|---|
 | 597 |     list [catch {z eval puts hello} msg] $msg | 
|---|
 | 598 | } {1 {can not find channel named "stdout"}} | 
|---|
 | 599 | test interp-15.2 {testing file sharing} -body { | 
|---|
 | 600 |     catch {interp delete z} | 
|---|
 | 601 |     interp create z | 
|---|
 | 602 |     set f [open [makeFile {} file-15.2] w] | 
|---|
 | 603 |     interp share "" $f z | 
|---|
 | 604 |     z eval puts $f hello | 
|---|
 | 605 |     z eval close $f | 
|---|
 | 606 |     close $f | 
|---|
 | 607 | } -cleanup { | 
|---|
 | 608 |     removeFile file-15.2 | 
|---|
 | 609 | } -result "" | 
|---|
 | 610 | test interp-15.3 {testing file sharing} { | 
|---|
 | 611 |     catch {interp delete xsafe} | 
|---|
 | 612 |     interp create xsafe -safe | 
|---|
 | 613 |     list [catch {xsafe eval puts hello} msg] $msg | 
|---|
 | 614 | } {1 {can not find channel named "stdout"}} | 
|---|
 | 615 | test interp-15.4 {testing file sharing} -body { | 
|---|
 | 616 |     catch {interp delete xsafe} | 
|---|
 | 617 |     interp create xsafe -safe | 
|---|
 | 618 |     set f [open [makeFile {} file-15.4] w] | 
|---|
 | 619 |     interp share "" $f xsafe | 
|---|
 | 620 |     xsafe eval puts $f hello | 
|---|
 | 621 |     xsafe eval close $f | 
|---|
 | 622 |     close $f | 
|---|
 | 623 | } -cleanup { | 
|---|
 | 624 |     removeFile file-15.4 | 
|---|
 | 625 | } -result "" | 
|---|
 | 626 | test interp-15.5 {testing file sharing} { | 
|---|
 | 627 |     catch {interp delete xsafe} | 
|---|
 | 628 |     interp create xsafe -safe | 
|---|
 | 629 |     interp share "" stdout xsafe | 
|---|
 | 630 |     list [catch {xsafe eval gets stdout} msg] $msg | 
|---|
 | 631 | } {1 {channel "stdout" wasn't opened for reading}} | 
|---|
 | 632 | test interp-15.6 {testing file sharing} -body { | 
|---|
 | 633 |     catch {interp delete xsafe} | 
|---|
 | 634 |     interp create xsafe -safe | 
|---|
 | 635 |     set f [open [makeFile {} file-15.6] w] | 
|---|
 | 636 |     interp share "" $f xsafe | 
|---|
 | 637 |     set x [list [catch [list xsafe eval gets $f] msg] $msg] | 
|---|
 | 638 |     xsafe eval close $f | 
|---|
 | 639 |     close $f | 
|---|
 | 640 |     string compare [string tolower $x] \ | 
|---|
 | 641 |                 [list 1 [format "channel \"%s\" wasn't opened for reading" $f]] | 
|---|
 | 642 | } -cleanup { | 
|---|
 | 643 |     removeFile file-15.6 | 
|---|
 | 644 | } -result 0 | 
|---|
 | 645 | test interp-15.7 {testing file transferring} -body { | 
|---|
 | 646 |     catch {interp delete xsafe} | 
|---|
 | 647 |     interp create xsafe -safe | 
|---|
 | 648 |     set f [open [makeFile {} file-15.7] w] | 
|---|
 | 649 |     interp transfer "" $f xsafe | 
|---|
 | 650 |     xsafe eval puts $f hello | 
|---|
 | 651 |     xsafe eval close $f | 
|---|
 | 652 | } -cleanup { | 
|---|
 | 653 |     removeFile file-15.7 | 
|---|
 | 654 | } -result "" | 
|---|
 | 655 | test interp-15.8 {testing file transferring} -body { | 
|---|
 | 656 |     catch {interp delete xsafe} | 
|---|
 | 657 |     interp create xsafe -safe | 
|---|
 | 658 |     set f [open [makeFile {} file-15.8] w] | 
|---|
 | 659 |     interp transfer "" $f xsafe | 
|---|
 | 660 |     xsafe eval close $f | 
|---|
 | 661 |     set x [list [catch {close $f} msg] $msg] | 
|---|
 | 662 |     string compare [string tolower $x] \ | 
|---|
 | 663 |                 [list 1 [format "can not find channel named \"%s\"" $f]] | 
|---|
 | 664 | } -cleanup { | 
|---|
 | 665 |     removeFile file-15.8 | 
|---|
 | 666 | } -result 0 | 
|---|
 | 667 |  | 
|---|
 | 668 | # | 
|---|
 | 669 | # Torture tests for interpreter deletion order | 
|---|
 | 670 | # | 
|---|
 | 671 | proc kill {} {interp delete xxx} | 
|---|
 | 672 |  | 
|---|
 | 673 | test interp-15.9 {testing deletion order} { | 
|---|
 | 674 |     catch {interp delete xxx} | 
|---|
 | 675 |     interp create xxx | 
|---|
 | 676 |     xxx alias kill kill | 
|---|
 | 677 |     list [catch {xxx eval kill} msg] $msg | 
|---|
 | 678 | } {0 {}} | 
|---|
 | 679 | test interp-16.1 {testing deletion order} { | 
|---|
 | 680 |     catch {interp delete xxx} | 
|---|
 | 681 |     interp create xxx | 
|---|
 | 682 |     interp create {xxx yyy} | 
|---|
 | 683 |     interp alias {xxx yyy} kill "" kill | 
|---|
 | 684 |     list [catch {interp eval {xxx yyy} kill} msg] $msg | 
|---|
 | 685 | } {0 {}} | 
|---|
 | 686 | test interp-16.2 {testing deletion order} { | 
|---|
 | 687 |     catch {interp delete xxx} | 
|---|
 | 688 |     interp create xxx | 
|---|
 | 689 |     interp create {xxx yyy} | 
|---|
 | 690 |     interp alias {xxx yyy} kill "" kill | 
|---|
 | 691 |     list [catch {xxx eval yyy eval kill} msg] $msg | 
|---|
 | 692 | } {0 {}} | 
|---|
 | 693 | test interp-16.3 {testing deletion order} { | 
|---|
 | 694 |     catch {interp delete xxx} | 
|---|
 | 695 |     interp create xxx | 
|---|
 | 696 |     interp create ddd | 
|---|
 | 697 |     xxx alias kill kill | 
|---|
 | 698 |     interp alias ddd kill xxx kill | 
|---|
 | 699 |     set x [ddd eval kill] | 
|---|
 | 700 |     interp delete ddd | 
|---|
 | 701 |     set x | 
|---|
 | 702 | } "" | 
|---|
 | 703 | test interp-16.4 {testing deletion order} { | 
|---|
 | 704 |     catch {interp delete xxx} | 
|---|
 | 705 |     interp create xxx | 
|---|
 | 706 |     interp create {xxx yyy} | 
|---|
 | 707 |     interp alias {xxx yyy} kill "" kill | 
|---|
 | 708 |     interp create ddd | 
|---|
 | 709 |     interp alias ddd kill {xxx yyy} kill | 
|---|
 | 710 |     set x [ddd eval kill] | 
|---|
 | 711 |     interp delete ddd | 
|---|
 | 712 |     set x | 
|---|
 | 713 | } "" | 
|---|
 | 714 | test interp-16.5 {testing deletion order, bgerror} { | 
|---|
 | 715 |     catch {interp delete xxx} | 
|---|
 | 716 |     interp create xxx | 
|---|
 | 717 |     xxx eval {proc bgerror {args} {exit}} | 
|---|
 | 718 |     xxx alias exit kill xxx | 
|---|
 | 719 |     proc kill {i} {interp delete $i} | 
|---|
 | 720 |     xxx eval after 100 expr a + b | 
|---|
 | 721 |     after 200 | 
|---|
 | 722 |     update | 
|---|
 | 723 |     interp exists xxx | 
|---|
 | 724 | } 0 | 
|---|
 | 725 |  | 
|---|
 | 726 | # | 
|---|
 | 727 | # Alias loop prevention testing. | 
|---|
 | 728 | # | 
|---|
 | 729 |  | 
|---|
 | 730 | test interp-17.1 {alias loop prevention} { | 
|---|
 | 731 |     list [catch {interp alias {} a {} a} msg] $msg | 
|---|
 | 732 | } {1 {cannot define or rename alias "a": would create a loop}} | 
|---|
 | 733 | test interp-17.2 {alias loop prevention} { | 
|---|
 | 734 |     catch {interp delete x} | 
|---|
 | 735 |     interp create x | 
|---|
 | 736 |     x alias a loop | 
|---|
 | 737 |     list [catch {interp alias {} loop x a} msg] $msg | 
|---|
 | 738 | } {1 {cannot define or rename alias "loop": would create a loop}} | 
|---|
 | 739 | test interp-17.3 {alias loop prevention} { | 
|---|
 | 740 |     catch {interp delete x} | 
|---|
 | 741 |     interp create x | 
|---|
 | 742 |     interp alias x a x b | 
|---|
 | 743 |     list [catch {interp alias x b x a} msg] $msg | 
|---|
 | 744 | } {1 {cannot define or rename alias "b": would create a loop}} | 
|---|
 | 745 | test interp-17.4 {alias loop prevention} { | 
|---|
 | 746 |     catch {interp delete x} | 
|---|
 | 747 |     interp create x | 
|---|
 | 748 |     interp alias x b x a | 
|---|
 | 749 |     list [catch {x eval rename b a} msg] $msg | 
|---|
 | 750 | } {1 {cannot define or rename alias "a": would create a loop}} | 
|---|
 | 751 | test interp-17.5 {alias loop prevention} { | 
|---|
 | 752 |     catch {interp delete x} | 
|---|
 | 753 |     interp create x | 
|---|
 | 754 |     x alias z l1 | 
|---|
 | 755 |     interp alias {} l2 x z | 
|---|
 | 756 |     list [catch {rename l2 l1} msg] $msg | 
|---|
 | 757 | } {1 {cannot define or rename alias "l1": would create a loop}} | 
|---|
 | 758 | test interp-17.6 {alias loop prevention} { | 
|---|
 | 759 |     catch {interp delete x} | 
|---|
 | 760 |     interp create x | 
|---|
 | 761 |     interp alias x a x b | 
|---|
 | 762 |     x eval rename a c | 
|---|
 | 763 |     list [catch {x eval rename c b} msg] $msg | 
|---|
 | 764 | } {1 {cannot define or rename alias "b": would create a loop}} | 
|---|
 | 765 |  | 
|---|
 | 766 | # | 
|---|
 | 767 | # Test robustness of Tcl_DeleteInterp when applied to a slave interpreter. | 
|---|
 | 768 | # If there are bugs in the implementation these tests are likely to expose | 
|---|
 | 769 | # the bugs as a core dump. | 
|---|
 | 770 | # | 
|---|
 | 771 |  | 
|---|
 | 772 | test interp-18.1 {testing Tcl_DeleteInterp vs slaves} testinterpdelete { | 
|---|
 | 773 |     list [catch {testinterpdelete} msg] $msg | 
|---|
 | 774 | } {1 {wrong # args: should be "testinterpdelete path"}} | 
|---|
 | 775 | test interp-18.2 {testing Tcl_DeleteInterp vs slaves} testinterpdelete { | 
|---|
 | 776 |     catch {interp delete a} | 
|---|
 | 777 |     interp create a | 
|---|
 | 778 |     testinterpdelete a | 
|---|
 | 779 | } "" | 
|---|
 | 780 | test interp-18.3 {testing Tcl_DeleteInterp vs slaves} testinterpdelete { | 
|---|
 | 781 |     catch {interp delete a} | 
|---|
 | 782 |     interp create a | 
|---|
 | 783 |     interp create {a b} | 
|---|
 | 784 |     testinterpdelete {a b} | 
|---|
 | 785 | } "" | 
|---|
 | 786 | test interp-18.4 {testing Tcl_DeleteInterp vs slaves} testinterpdelete { | 
|---|
 | 787 |     catch {interp delete a} | 
|---|
 | 788 |     interp create a | 
|---|
 | 789 |     interp create {a b} | 
|---|
 | 790 |     testinterpdelete a | 
|---|
 | 791 | } "" | 
|---|
 | 792 | test interp-18.5 {testing Tcl_DeleteInterp vs slaves} testinterpdelete { | 
|---|
 | 793 |     catch {interp delete a} | 
|---|
 | 794 |     interp create a | 
|---|
 | 795 |     interp create {a b} | 
|---|
 | 796 |     interp alias {a b} dodel {} dodel | 
|---|
 | 797 |     proc dodel {x} {testinterpdelete $x} | 
|---|
 | 798 |     list [catch {interp eval {a b} {dodel {a b}}} msg] $msg | 
|---|
 | 799 | } {0 {}} | 
|---|
 | 800 | test interp-18.6 {testing Tcl_DeleteInterp vs slaves} testinterpdelete { | 
|---|
 | 801 |     catch {interp delete a} | 
|---|
 | 802 |     interp create a | 
|---|
 | 803 |     interp create {a b} | 
|---|
 | 804 |     interp alias {a b} dodel {} dodel | 
|---|
 | 805 |     proc dodel {x} {testinterpdelete $x} | 
|---|
 | 806 |     list [catch {interp eval {a b} {dodel a}} msg] $msg | 
|---|
 | 807 | } {0 {}} | 
|---|
 | 808 | test interp-18.7 {eval in deleted interp} { | 
|---|
 | 809 |     catch {interp delete a} | 
|---|
 | 810 |     interp create a | 
|---|
 | 811 |     a eval { | 
|---|
 | 812 |         proc dodel {} { | 
|---|
 | 813 |             delme | 
|---|
 | 814 |             dosomething else | 
|---|
 | 815 |         } | 
|---|
 | 816 |         proc dosomething args { | 
|---|
 | 817 |             puts "I should not have been called!!" | 
|---|
 | 818 |         } | 
|---|
 | 819 |     } | 
|---|
 | 820 |     a alias delme dela | 
|---|
 | 821 |     proc dela {} {interp delete a} | 
|---|
 | 822 |     list [catch {a eval dodel} msg] $msg | 
|---|
 | 823 | } {1 {attempt to call eval in deleted interpreter}} | 
|---|
 | 824 | test interp-18.8 {eval in deleted interp} { | 
|---|
 | 825 |     catch {interp delete a} | 
|---|
 | 826 |     interp create a | 
|---|
 | 827 |     a eval { | 
|---|
 | 828 |         interp create b | 
|---|
 | 829 |         b eval { | 
|---|
 | 830 |             proc dodel {} { | 
|---|
 | 831 |                 dela | 
|---|
 | 832 |             } | 
|---|
 | 833 |         } | 
|---|
 | 834 |         proc foo {} { | 
|---|
 | 835 |             b eval dela | 
|---|
 | 836 |             dosomething else | 
|---|
 | 837 |         } | 
|---|
 | 838 |         proc dosomething args { | 
|---|
 | 839 |             puts "I should not have been called!!" | 
|---|
 | 840 |         } | 
|---|
 | 841 |     } | 
|---|
 | 842 |     interp alias {a b} dela {} dela | 
|---|
 | 843 |     proc dela {} {interp delete a} | 
|---|
 | 844 |     list [catch {a eval foo} msg] $msg | 
|---|
 | 845 | } {1 {attempt to call eval in deleted interpreter}} | 
|---|
 | 846 | test interp-18.9 {eval in deleted interp, bug 495830} { | 
|---|
 | 847 |     interp create tst | 
|---|
 | 848 |     interp alias tst suicide {} interp delete tst | 
|---|
 | 849 |     list [catch {tst eval {suicide; set a 5}} msg] $msg | 
|---|
 | 850 | } {1 {attempt to call eval in deleted interpreter}}      | 
|---|
 | 851 | test interp-18.10 {eval in deleted interp, bug 495830} { | 
|---|
 | 852 |     interp create tst | 
|---|
 | 853 |     interp alias tst suicide {} interp delete tst | 
|---|
 | 854 |     list [catch {tst eval {set set set; suicide; $set a 5}} msg] $msg | 
|---|
 | 855 | } {1 {attempt to call eval in deleted interpreter}}      | 
|---|
 | 856 |  | 
|---|
 | 857 | # Test alias deletion | 
|---|
 | 858 |  | 
|---|
 | 859 | test interp-19.1 {alias deletion} { | 
|---|
 | 860 |     catch {interp delete a} | 
|---|
 | 861 |     interp create a | 
|---|
 | 862 |     interp alias a foo a bar | 
|---|
 | 863 |     set s [interp alias a foo {}] | 
|---|
 | 864 |     interp delete a | 
|---|
 | 865 |     set s | 
|---|
 | 866 | } {} | 
|---|
 | 867 | test interp-19.2 {alias deletion} { | 
|---|
 | 868 |     catch {interp delete a} | 
|---|
 | 869 |     interp create a | 
|---|
 | 870 |     catch {interp alias a foo {}} msg | 
|---|
 | 871 |     interp delete a | 
|---|
 | 872 |     set msg | 
|---|
 | 873 | } {alias "foo" not found} | 
|---|
 | 874 | test interp-19.3 {alias deletion} { | 
|---|
 | 875 |     catch {interp delete a} | 
|---|
 | 876 |     interp create a | 
|---|
 | 877 |     interp alias a foo a bar | 
|---|
 | 878 |     interp eval a {rename foo zop} | 
|---|
 | 879 |     interp alias a foo a zop | 
|---|
 | 880 |     catch {interp eval a foo} msg | 
|---|
 | 881 |     interp delete a | 
|---|
 | 882 |     set msg | 
|---|
 | 883 | } {invalid command name "bar"} | 
|---|
 | 884 | test interp-19.4 {alias deletion} { | 
|---|
 | 885 |     catch {interp delete a} | 
|---|
 | 886 |     interp create a | 
|---|
 | 887 |     interp alias a foo a bar | 
|---|
 | 888 |     interp eval a {rename foo zop} | 
|---|
 | 889 |     catch {interp eval a foo} msg | 
|---|
 | 890 |     interp delete a | 
|---|
 | 891 |     set msg | 
|---|
 | 892 | } {invalid command name "foo"} | 
|---|
 | 893 | test interp-19.5 {alias deletion} { | 
|---|
 | 894 |     catch {interp delete a} | 
|---|
 | 895 |     interp create a | 
|---|
 | 896 |     interp eval a {proc bar {} {return 1}} | 
|---|
 | 897 |     interp alias a foo a bar | 
|---|
 | 898 |     interp eval a {rename foo zop} | 
|---|
 | 899 |     catch {interp eval a zop} msg | 
|---|
 | 900 |     interp delete a | 
|---|
 | 901 |     set msg | 
|---|
 | 902 | } 1 | 
|---|
 | 903 | test interp-19.6 {alias deletion} { | 
|---|
 | 904 |     catch {interp delete a} | 
|---|
 | 905 |     interp create a | 
|---|
 | 906 |     interp alias a foo a bar | 
|---|
 | 907 |     interp eval a {rename foo zop} | 
|---|
 | 908 |     interp alias a foo a zop | 
|---|
 | 909 |     set s [interp aliases a] | 
|---|
 | 910 |     interp delete a | 
|---|
 | 911 |     set s | 
|---|
 | 912 | } {::foo foo} | 
|---|
 | 913 | test interp-19.7 {alias deletion, renaming} { | 
|---|
 | 914 |     catch {interp delete a} | 
|---|
 | 915 |     interp create a | 
|---|
 | 916 |     interp alias a foo a bar | 
|---|
 | 917 |     interp eval a rename foo blotz | 
|---|
 | 918 |     interp alias a foo {} | 
|---|
 | 919 |     set s [interp aliases a] | 
|---|
 | 920 |     interp delete a | 
|---|
 | 921 |     set s | 
|---|
 | 922 | } {} | 
|---|
 | 923 | test interp-19.8 {alias deletion, renaming} { | 
|---|
 | 924 |     catch {interp delete a} | 
|---|
 | 925 |     interp create a | 
|---|
 | 926 |     interp alias a foo a bar | 
|---|
 | 927 |     interp eval a rename foo blotz | 
|---|
 | 928 |     set l "" | 
|---|
 | 929 |     lappend l [interp aliases a] | 
|---|
 | 930 |     interp alias a foo {} | 
|---|
 | 931 |     lappend l [interp aliases a] | 
|---|
 | 932 |     interp delete a | 
|---|
 | 933 |     set l | 
|---|
 | 934 | } {foo {}} | 
|---|
 | 935 | test interp-19.9 {alias deletion, renaming} { | 
|---|
 | 936 |     catch {interp delete a} | 
|---|
 | 937 |     interp create a | 
|---|
 | 938 |     interp alias a foo a bar | 
|---|
 | 939 |     interp eval a rename foo blotz | 
|---|
 | 940 |     interp eval a {proc foo {} {expr 34 * 34}} | 
|---|
 | 941 |     interp alias a foo {} | 
|---|
 | 942 |     set l [interp eval a foo] | 
|---|
 | 943 |     interp delete a | 
|---|
 | 944 |     set l | 
|---|
 | 945 | } 1156     | 
|---|
 | 946 |  | 
|---|
 | 947 | test interp-20.1 {interp hide, interp expose and interp invokehidden} { | 
|---|
 | 948 |     set a [interp create] | 
|---|
 | 949 |     $a eval {proc unknown {x args} {error "invalid command name \"$x\""}} | 
|---|
 | 950 |     $a eval {proc foo {} {}} | 
|---|
 | 951 |     $a hide foo | 
|---|
 | 952 |     catch {$a eval foo something} msg | 
|---|
 | 953 |     interp delete $a | 
|---|
 | 954 |     set msg | 
|---|
 | 955 | } {invalid command name "foo"} | 
|---|
 | 956 | test interp-20.2 {interp hide, interp expose and interp invokehidden} { | 
|---|
 | 957 |     set a [interp create] | 
|---|
 | 958 |     $a eval {proc unknown {x args} {error "invalid command name \"$x\""}} | 
|---|
 | 959 |     $a hide list | 
|---|
 | 960 |     set l "" | 
|---|
 | 961 |     lappend l [catch {$a eval {list 1 2 3}} msg] $msg | 
|---|
 | 962 |     $a expose list | 
|---|
 | 963 |     lappend l [catch {$a eval {list 1 2 3}} msg] $msg | 
|---|
 | 964 |     interp delete $a | 
|---|
 | 965 |     set l | 
|---|
 | 966 | } {1 {invalid command name "list"} 0 {1 2 3}} | 
|---|
 | 967 | test interp-20.3 {interp hide, interp expose and interp invokehidden} { | 
|---|
 | 968 |     set a [interp create] | 
|---|
 | 969 |     $a eval {proc unknown {x args} {error "invalid command name \"$x\""}} | 
|---|
 | 970 |     $a hide list | 
|---|
 | 971 |     set l "" | 
|---|
 | 972 |     lappend l [catch { $a eval {list 1 2 3}       } msg] $msg | 
|---|
 | 973 |     lappend l [catch { $a invokehidden list 1 2 3 } msg] $msg | 
|---|
 | 974 |     $a expose list | 
|---|
 | 975 |     lappend l [catch { $a eval {list 1 2 3}       } msg] $msg | 
|---|
 | 976 |     interp delete $a | 
|---|
 | 977 |     set l | 
|---|
 | 978 | } {1 {invalid command name "list"} 0 {1 2 3} 0 {1 2 3}} | 
|---|
 | 979 | test interp-20.4 {interp hide, interp expose and interp invokehidden -- passing {}} { | 
|---|
 | 980 |     set a [interp create] | 
|---|
 | 981 |     $a eval {proc unknown {x args} {error "invalid command name \"$x\""}} | 
|---|
 | 982 |     $a hide list | 
|---|
 | 983 |     set l "" | 
|---|
 | 984 |     lappend l [catch { $a eval {list 1 2 3}            } msg] $msg | 
|---|
 | 985 |     lappend l [catch { $a invokehidden list {"" 1 2 3} } msg] $msg | 
|---|
 | 986 |     $a expose list | 
|---|
 | 987 |     lappend l [catch { $a eval {list 1 2 3}            } msg] $msg | 
|---|
 | 988 |     interp delete $a | 
|---|
 | 989 |     set l | 
|---|
 | 990 | } {1 {invalid command name "list"} 0 {{"" 1 2 3}} 0 {1 2 3}} | 
|---|
 | 991 | test interp-20.5 {interp hide, interp expose and interp invokehidden -- passing {}} { | 
|---|
 | 992 |     set a [interp create] | 
|---|
 | 993 |     $a eval {proc unknown {x args} {error "invalid command name \"$x\""}} | 
|---|
 | 994 |     $a hide list | 
|---|
 | 995 |     set l "" | 
|---|
 | 996 |     lappend l [catch { $a eval {list 1 2 3}            } msg] $msg | 
|---|
 | 997 |     lappend l [catch { $a invokehidden list {{} 1 2 3} } msg] $msg | 
|---|
 | 998 |     $a expose list | 
|---|
 | 999 |     lappend l [catch { $a eval {list 1 2 3}            } msg] $msg | 
|---|
 | 1000 |     interp delete $a | 
|---|
 | 1001 |     set l | 
|---|
 | 1002 | } {1 {invalid command name "list"} 0 {{{} 1 2 3}} 0 {1 2 3}} | 
|---|
 | 1003 | test interp-20.6 {interp invokehidden -- eval args} { | 
|---|
 | 1004 |     set a [interp create] | 
|---|
 | 1005 |     $a hide list | 
|---|
 | 1006 |     set l "" | 
|---|
 | 1007 |     set z 45 | 
|---|
 | 1008 |     lappend l [catch { $a invokehidden list $z 1 2 3 } msg] $msg | 
|---|
 | 1009 |     $a expose list | 
|---|
 | 1010 |     lappend l [catch { $a eval list $z 1 2 3         } msg] $msg | 
|---|
 | 1011 |     interp delete $a | 
|---|
 | 1012 |     set l | 
|---|
 | 1013 | } {0 {45 1 2 3} 0 {45 1 2 3}} | 
|---|
 | 1014 | test interp-20.7 {interp invokehidden vs variable eval} { | 
|---|
 | 1015 |     set a [interp create] | 
|---|
 | 1016 |     $a hide list | 
|---|
 | 1017 |     set z 45 | 
|---|
 | 1018 |     set l [list [catch {$a invokehidden list {$z a b c}} msg] $msg] | 
|---|
 | 1019 |     interp delete $a | 
|---|
 | 1020 |     set l | 
|---|
 | 1021 | } {0 {{$z a b c}}} | 
|---|
 | 1022 | test interp-20.8 {interp invokehidden vs variable eval} { | 
|---|
 | 1023 |     set a [interp create] | 
|---|
 | 1024 |     $a hide list | 
|---|
 | 1025 |     $a eval set z 89 | 
|---|
 | 1026 |     set z 45 | 
|---|
 | 1027 |     set l [list [catch {$a invokehidden list {$z a b c}} msg] $msg] | 
|---|
 | 1028 |     interp delete $a | 
|---|
 | 1029 |     set l | 
|---|
 | 1030 | } {0 {{$z a b c}}} | 
|---|
 | 1031 | test interp-20.9 {interp invokehidden vs variable eval} { | 
|---|
 | 1032 |     set a [interp create] | 
|---|
 | 1033 |     $a hide list | 
|---|
 | 1034 |     $a eval set z 89 | 
|---|
 | 1035 |     set z 45 | 
|---|
 | 1036 |     set l "" | 
|---|
 | 1037 |     lappend l [catch {$a invokehidden list $z {$z a b c}} msg] $msg | 
|---|
 | 1038 |     interp delete $a | 
|---|
 | 1039 |     set l | 
|---|
 | 1040 | } {0 {45 {$z a b c}}} | 
|---|
 | 1041 | test interp-20.10 {interp hide, interp expose and interp invokehidden} { | 
|---|
 | 1042 |     set a [interp create] | 
|---|
 | 1043 |     $a eval {proc unknown {x args} {error "invalid command name \"$x\""}} | 
|---|
 | 1044 |     $a eval {proc foo {} {}} | 
|---|
 | 1045 |     interp hide $a foo | 
|---|
 | 1046 |     catch {interp eval $a foo something} msg | 
|---|
 | 1047 |     interp delete $a | 
|---|
 | 1048 |     set msg | 
|---|
 | 1049 | } {invalid command name "foo"} | 
|---|
 | 1050 | test interp-20.11 {interp hide, interp expose and interp invokehidden} { | 
|---|
 | 1051 |     set a [interp create] | 
|---|
 | 1052 |     $a eval {proc unknown {x args} {error "invalid command name \"$x\""}} | 
|---|
 | 1053 |     interp hide $a list | 
|---|
 | 1054 |     set l "" | 
|---|
 | 1055 |     lappend l [catch {interp eval $a {list 1 2 3}} msg] $msg | 
|---|
 | 1056 |     interp expose $a list | 
|---|
 | 1057 |     lappend l [catch {interp eval $a {list 1 2 3}} msg] $msg | 
|---|
 | 1058 |     interp delete $a | 
|---|
 | 1059 |     set l | 
|---|
 | 1060 | } {1 {invalid command name "list"} 0 {1 2 3}} | 
|---|
 | 1061 | test interp-20.12 {interp hide, interp expose and interp invokehidden} { | 
|---|
 | 1062 |     set a [interp create] | 
|---|
 | 1063 |     $a eval {proc unknown {x args} {error "invalid command name \"$x\""}} | 
|---|
 | 1064 |     interp hide $a list | 
|---|
 | 1065 |     set l "" | 
|---|
 | 1066 |     lappend l [catch {interp eval $a {list 1 2 3}      } msg] $msg | 
|---|
 | 1067 |     lappend l [catch {interp invokehidden $a list 1 2 3} msg] $msg | 
|---|
 | 1068 |     interp expose $a list | 
|---|
 | 1069 |     lappend l [catch {interp eval $a {list 1 2 3}      } msg] $msg | 
|---|
 | 1070 |     interp delete $a | 
|---|
 | 1071 |     set l | 
|---|
 | 1072 | } {1 {invalid command name "list"} 0 {1 2 3} 0 {1 2 3}} | 
|---|
 | 1073 | test interp-20.13 {interp hide, interp expose, interp invokehidden -- passing {}} { | 
|---|
 | 1074 |     set a [interp create] | 
|---|
 | 1075 |     $a eval {proc unknown {x args} {error "invalid command name \"$x\""}} | 
|---|
 | 1076 |     interp hide $a list | 
|---|
 | 1077 |     set l "" | 
|---|
 | 1078 |     lappend l [catch {interp eval $a {list 1 2 3}           } msg] $msg | 
|---|
 | 1079 |     lappend l [catch {interp invokehidden $a list {"" 1 2 3}} msg] $msg | 
|---|
 | 1080 |     interp expose $a list | 
|---|
 | 1081 |     lappend l [catch {interp eval $a {list 1 2 3}           } msg] $msg | 
|---|
 | 1082 |     interp delete $a | 
|---|
 | 1083 |     set l | 
|---|
 | 1084 | } {1 {invalid command name "list"} 0 {{"" 1 2 3}} 0 {1 2 3}} | 
|---|
 | 1085 | test interp-20.14 {interp hide, interp expose, interp invokehidden -- passing {}} { | 
|---|
 | 1086 |     set a [interp create] | 
|---|
 | 1087 |     $a eval {proc unknown {x args} {error "invalid command name \"$x\""}} | 
|---|
 | 1088 |     interp hide $a list | 
|---|
 | 1089 |     set l "" | 
|---|
 | 1090 |     lappend l [catch {interp eval $a {list 1 2 3}           } msg] $msg | 
|---|
 | 1091 |     lappend l [catch {interp invokehidden $a list {{} 1 2 3}} msg] $msg | 
|---|
 | 1092 |     interp expose $a list | 
|---|
 | 1093 |     lappend l [catch {$a eval {list 1 2 3}                  } msg] $msg | 
|---|
 | 1094 |     interp delete $a | 
|---|
 | 1095 |     set l | 
|---|
 | 1096 | } {1 {invalid command name "list"} 0 {{{} 1 2 3}} 0 {1 2 3}} | 
|---|
 | 1097 | test interp-20.15 {interp invokehidden -- eval args} { | 
|---|
 | 1098 |     catch {interp delete a} | 
|---|
 | 1099 |     interp create a | 
|---|
 | 1100 |     interp hide a list | 
|---|
 | 1101 |     set l "" | 
|---|
 | 1102 |     set z 45 | 
|---|
 | 1103 |     lappend l [catch {interp invokehidden a list $z 1 2 3} msg] | 
|---|
 | 1104 |     lappend l $msg | 
|---|
 | 1105 |     a expose list | 
|---|
 | 1106 |     lappend l [catch {interp eval a list $z 1 2 3} msg] | 
|---|
 | 1107 |     lappend l $msg | 
|---|
 | 1108 |     interp delete a | 
|---|
 | 1109 |     set l | 
|---|
 | 1110 | } {0 {45 1 2 3} 0 {45 1 2 3}} | 
|---|
 | 1111 | test interp-20.16 {interp invokehidden vs variable eval} { | 
|---|
 | 1112 |     catch {interp delete a} | 
|---|
 | 1113 |     interp create a | 
|---|
 | 1114 |     interp hide a list | 
|---|
 | 1115 |     set z 45 | 
|---|
 | 1116 |     set l "" | 
|---|
 | 1117 |     lappend l [catch {interp invokehidden a list {$z a b c}} msg] | 
|---|
 | 1118 |     lappend l $msg | 
|---|
 | 1119 |     interp delete a | 
|---|
 | 1120 |     set l | 
|---|
 | 1121 | } {0 {{$z a b c}}} | 
|---|
 | 1122 | test interp-20.17 {interp invokehidden vs variable eval} { | 
|---|
 | 1123 |     catch {interp delete a} | 
|---|
 | 1124 |     interp create a | 
|---|
 | 1125 |     interp hide a list | 
|---|
 | 1126 |     a eval set z 89 | 
|---|
 | 1127 |     set z 45 | 
|---|
 | 1128 |     set l "" | 
|---|
 | 1129 |     lappend l [catch {interp invokehidden a list {$z a b c}} msg] | 
|---|
 | 1130 |     lappend l $msg | 
|---|
 | 1131 |     interp delete a | 
|---|
 | 1132 |     set l | 
|---|
 | 1133 | } {0 {{$z a b c}}} | 
|---|
 | 1134 | test interp-20.18 {interp invokehidden vs variable eval} { | 
|---|
 | 1135 |     catch {interp delete a} | 
|---|
 | 1136 |     interp create a | 
|---|
 | 1137 |     interp hide a list | 
|---|
 | 1138 |     a eval set z 89 | 
|---|
 | 1139 |     set z 45 | 
|---|
 | 1140 |     set l "" | 
|---|
 | 1141 |     lappend l [catch {interp invokehidden a list $z {$z a b c}} msg] | 
|---|
 | 1142 |     lappend l $msg | 
|---|
 | 1143 |     interp delete a | 
|---|
 | 1144 |     set l | 
|---|
 | 1145 | } {0 {45 {$z a b c}}} | 
|---|
 | 1146 | test interp-20.19 {interp invokehidden vs nested commands} { | 
|---|
 | 1147 |     catch {interp delete a} | 
|---|
 | 1148 |     interp create a | 
|---|
 | 1149 |     a hide list | 
|---|
 | 1150 |     set l [a invokehidden list {[list x y z] f g h} z] | 
|---|
 | 1151 |     interp delete a | 
|---|
 | 1152 |     set l | 
|---|
 | 1153 | } {{[list x y z] f g h} z} | 
|---|
 | 1154 | test interp-20.20 {interp invokehidden vs nested commands} { | 
|---|
 | 1155 |     catch {interp delete a} | 
|---|
 | 1156 |     interp create a | 
|---|
 | 1157 |     a hide list | 
|---|
 | 1158 |     set l [interp invokehidden a list {[list x y z] f g h} z] | 
|---|
 | 1159 |     interp delete a | 
|---|
 | 1160 |     set l | 
|---|
 | 1161 | } {{[list x y z] f g h} z} | 
|---|
 | 1162 | test interp-20.21 {interp hide vs safety} { | 
|---|
 | 1163 |     catch {interp delete a} | 
|---|
 | 1164 |     interp create a -safe | 
|---|
 | 1165 |     set l "" | 
|---|
 | 1166 |     lappend l [catch {a hide list} msg]     | 
|---|
 | 1167 |     lappend l $msg | 
|---|
 | 1168 |     interp delete a | 
|---|
 | 1169 |     set l | 
|---|
 | 1170 | } {0 {}} | 
|---|
 | 1171 | test interp-20.22 {interp hide vs safety} { | 
|---|
 | 1172 |     catch {interp delete a} | 
|---|
 | 1173 |     interp create a -safe | 
|---|
 | 1174 |     set l "" | 
|---|
 | 1175 |     lappend l [catch {interp hide a list} msg]     | 
|---|
 | 1176 |     lappend l $msg | 
|---|
 | 1177 |     interp delete a | 
|---|
 | 1178 |     set l | 
|---|
 | 1179 | } {0 {}} | 
|---|
 | 1180 | test interp-20.23 {interp hide vs safety} { | 
|---|
 | 1181 |     catch {interp delete a} | 
|---|
 | 1182 |     interp create a -safe | 
|---|
 | 1183 |     set l "" | 
|---|
 | 1184 |     lappend l [catch {a eval {interp hide {} list}} msg]     | 
|---|
 | 1185 |     lappend l $msg | 
|---|
 | 1186 |     interp delete a | 
|---|
 | 1187 |     set l | 
|---|
 | 1188 | } {1 {permission denied: safe interpreter cannot hide commands}} | 
|---|
 | 1189 | test interp-20.24 {interp hide vs safety} { | 
|---|
 | 1190 |     catch {interp delete a} | 
|---|
 | 1191 |     interp create a -safe | 
|---|
 | 1192 |     interp create {a b} | 
|---|
 | 1193 |     set l "" | 
|---|
 | 1194 |     lappend l [catch {a eval {interp hide b list}} msg]     | 
|---|
 | 1195 |     lappend l $msg | 
|---|
 | 1196 |     interp delete a | 
|---|
 | 1197 |     set l | 
|---|
 | 1198 | } {1 {permission denied: safe interpreter cannot hide commands}} | 
|---|
 | 1199 | test interp-20.25 {interp hide vs safety} { | 
|---|
 | 1200 |     catch {interp delete a} | 
|---|
 | 1201 |     interp create a -safe | 
|---|
 | 1202 |     interp create {a b} | 
|---|
 | 1203 |     set l "" | 
|---|
 | 1204 |     lappend l [catch {interp hide {a b} list} msg] | 
|---|
 | 1205 |     lappend l $msg | 
|---|
 | 1206 |     interp delete a | 
|---|
 | 1207 |     set l | 
|---|
 | 1208 | } {0 {}} | 
|---|
 | 1209 | test interp-20.26 {interp expoose vs safety} { | 
|---|
 | 1210 |     catch {interp delete a} | 
|---|
 | 1211 |     interp create a -safe | 
|---|
 | 1212 |     set l "" | 
|---|
 | 1213 |     lappend l [catch {a hide list} msg]     | 
|---|
 | 1214 |     lappend l $msg | 
|---|
 | 1215 |     lappend l [catch {a expose list} msg] | 
|---|
 | 1216 |     lappend l $msg | 
|---|
 | 1217 |     interp delete a | 
|---|
 | 1218 |     set l | 
|---|
 | 1219 | } {0 {} 0 {}} | 
|---|
 | 1220 | test interp-20.27 {interp expose vs safety} { | 
|---|
 | 1221 |     catch {interp delete a} | 
|---|
 | 1222 |     interp create a -safe | 
|---|
 | 1223 |     set l "" | 
|---|
 | 1224 |     lappend l [catch {interp hide a list} msg]     | 
|---|
 | 1225 |     lappend l $msg | 
|---|
 | 1226 |     lappend l [catch {interp expose a list} msg]     | 
|---|
 | 1227 |     lappend l $msg | 
|---|
 | 1228 |     interp delete a | 
|---|
 | 1229 |     set l | 
|---|
 | 1230 | } {0 {} 0 {}} | 
|---|
 | 1231 | test interp-20.28 {interp expose vs safety} { | 
|---|
 | 1232 |     catch {interp delete a} | 
|---|
 | 1233 |     interp create a -safe | 
|---|
 | 1234 |     set l "" | 
|---|
 | 1235 |     lappend l [catch {a hide list} msg]     | 
|---|
 | 1236 |     lappend l $msg | 
|---|
 | 1237 |     lappend l [catch {a eval {interp expose {} list}} msg] | 
|---|
 | 1238 |     lappend l $msg | 
|---|
 | 1239 |     interp delete a | 
|---|
 | 1240 |     set l | 
|---|
 | 1241 | } {0 {} 1 {permission denied: safe interpreter cannot expose commands}} | 
|---|
 | 1242 | test interp-20.29 {interp expose vs safety} { | 
|---|
 | 1243 |     catch {interp delete a} | 
|---|
 | 1244 |     interp create a -safe | 
|---|
 | 1245 |     set l "" | 
|---|
 | 1246 |     lappend l [catch {interp hide a list} msg]     | 
|---|
 | 1247 |     lappend l $msg | 
|---|
 | 1248 |     lappend l [catch {a eval {interp expose {} list}} msg]     | 
|---|
 | 1249 |     lappend l $msg | 
|---|
 | 1250 |     interp delete a | 
|---|
 | 1251 |     set l | 
|---|
 | 1252 | } {0 {} 1 {permission denied: safe interpreter cannot expose commands}} | 
|---|
 | 1253 | test interp-20.30 {interp expose vs safety} { | 
|---|
 | 1254 |     catch {interp delete a} | 
|---|
 | 1255 |     interp create a -safe | 
|---|
 | 1256 |     interp create {a b} | 
|---|
 | 1257 |     set l "" | 
|---|
 | 1258 |     lappend l [catch {interp hide {a b} list} msg]     | 
|---|
 | 1259 |     lappend l $msg | 
|---|
 | 1260 |     lappend l [catch {a eval {interp expose b list}} msg]     | 
|---|
 | 1261 |     lappend l $msg | 
|---|
 | 1262 |     interp delete a | 
|---|
 | 1263 |     set l | 
|---|
 | 1264 | } {0 {} 1 {permission denied: safe interpreter cannot expose commands}} | 
|---|
 | 1265 | test interp-20.31 {interp expose vs safety} { | 
|---|
 | 1266 |     catch {interp delete a} | 
|---|
 | 1267 |     interp create a -safe | 
|---|
 | 1268 |     interp create {a b} | 
|---|
 | 1269 |     set l "" | 
|---|
 | 1270 |     lappend l [catch {interp hide {a b} list} msg]     | 
|---|
 | 1271 |     lappend l $msg | 
|---|
 | 1272 |     lappend l [catch {interp expose {a b} list} msg] | 
|---|
 | 1273 |     lappend l $msg | 
|---|
 | 1274 |     interp delete a | 
|---|
 | 1275 |     set l | 
|---|
 | 1276 | } {0 {} 0 {}} | 
|---|
 | 1277 | test interp-20.32 {interp invokehidden vs safety} { | 
|---|
 | 1278 |     catch {interp delete a} | 
|---|
 | 1279 |     interp create a -safe | 
|---|
 | 1280 |     interp hide a list | 
|---|
 | 1281 |     set l "" | 
|---|
 | 1282 |     lappend l [catch {a eval {interp invokehidden {} list a b c}} msg] | 
|---|
 | 1283 |     lappend l $msg | 
|---|
 | 1284 |     interp delete a | 
|---|
 | 1285 |     set l | 
|---|
 | 1286 | } {1 {not allowed to invoke hidden commands from safe interpreter}} | 
|---|
 | 1287 | test interp-20.33 {interp invokehidden vs safety} { | 
|---|
 | 1288 |     catch {interp delete a} | 
|---|
 | 1289 |     interp create a -safe | 
|---|
 | 1290 |     interp hide a list | 
|---|
 | 1291 |     set l "" | 
|---|
 | 1292 |     lappend l [catch {a eval {interp invokehidden {} list a b c}} msg] | 
|---|
 | 1293 |     lappend l $msg | 
|---|
 | 1294 |     lappend l [catch {a invokehidden list a b c} msg] | 
|---|
 | 1295 |     lappend l $msg | 
|---|
 | 1296 |     interp delete a | 
|---|
 | 1297 |     set l | 
|---|
 | 1298 | } {1 {not allowed to invoke hidden commands from safe interpreter}\ | 
|---|
 | 1299 | 0 {a b c}} | 
|---|
 | 1300 | test interp-20.34 {interp invokehidden vs safety} { | 
|---|
 | 1301 |     catch {interp delete a} | 
|---|
 | 1302 |     interp create a -safe | 
|---|
 | 1303 |     interp create {a b} | 
|---|
 | 1304 |     interp hide {a b} list | 
|---|
 | 1305 |     set l "" | 
|---|
 | 1306 |     lappend l [catch {a eval {interp invokehidden b list a b c}} msg] | 
|---|
 | 1307 |     lappend l $msg | 
|---|
 | 1308 |     lappend l [catch {interp invokehidden {a b} list a b c} msg] | 
|---|
 | 1309 |     lappend l $msg | 
|---|
 | 1310 |     interp delete a | 
|---|
 | 1311 |     set l | 
|---|
 | 1312 | } {1 {not allowed to invoke hidden commands from safe interpreter}\ | 
|---|
 | 1313 | 0 {a b c}} | 
|---|
 | 1314 | test interp-20.35 {invokehidden at local level} { | 
|---|
 | 1315 |     catch {interp delete a} | 
|---|
 | 1316 |     interp create a | 
|---|
 | 1317 |     a eval { | 
|---|
 | 1318 |         proc p1 {} { | 
|---|
 | 1319 |             set z 90 | 
|---|
 | 1320 |             a1 | 
|---|
 | 1321 |             set z | 
|---|
 | 1322 |         } | 
|---|
 | 1323 |         proc h1 {} { | 
|---|
 | 1324 |             upvar z z | 
|---|
 | 1325 |             set z 91 | 
|---|
 | 1326 |         } | 
|---|
 | 1327 |     } | 
|---|
 | 1328 |     a hide h1 | 
|---|
 | 1329 |     a alias a1 a1 | 
|---|
 | 1330 |     proc a1 {} { | 
|---|
 | 1331 |         interp invokehidden a h1 | 
|---|
 | 1332 |     } | 
|---|
 | 1333 |     set r [interp eval a p1] | 
|---|
 | 1334 |     interp delete a | 
|---|
 | 1335 |     set r | 
|---|
 | 1336 | } 91 | 
|---|
 | 1337 | test interp-20.36 {invokehidden at local level} { | 
|---|
 | 1338 |     catch {interp delete a} | 
|---|
 | 1339 |     interp create a | 
|---|
 | 1340 |     a eval { | 
|---|
 | 1341 |         set z 90 | 
|---|
 | 1342 |         proc p1 {} { | 
|---|
 | 1343 |             global z | 
|---|
 | 1344 |             a1 | 
|---|
 | 1345 |             set z | 
|---|
 | 1346 |         } | 
|---|
 | 1347 |         proc h1 {} { | 
|---|
 | 1348 |             upvar z z | 
|---|
 | 1349 |             set z 91 | 
|---|
 | 1350 |         } | 
|---|
 | 1351 |     } | 
|---|
 | 1352 |     a hide h1 | 
|---|
 | 1353 |     a alias a1 a1 | 
|---|
 | 1354 |     proc a1 {} { | 
|---|
 | 1355 |         interp invokehidden a h1 | 
|---|
 | 1356 |     } | 
|---|
 | 1357 |     set r [interp eval a p1] | 
|---|
 | 1358 |     interp delete a | 
|---|
 | 1359 |     set r | 
|---|
 | 1360 | } 91 | 
|---|
 | 1361 | test interp-20.37 {invokehidden at local level} { | 
|---|
 | 1362 |     catch {interp delete a} | 
|---|
 | 1363 |     interp create a | 
|---|
 | 1364 |     a eval { | 
|---|
 | 1365 |         proc p1 {} { | 
|---|
 | 1366 |             a1 | 
|---|
 | 1367 |             set z | 
|---|
 | 1368 |         } | 
|---|
 | 1369 |         proc h1 {} { | 
|---|
 | 1370 |             upvar z z | 
|---|
 | 1371 |             set z 91 | 
|---|
 | 1372 |         } | 
|---|
 | 1373 |     } | 
|---|
 | 1374 |     a hide h1 | 
|---|
 | 1375 |     a alias a1 a1 | 
|---|
 | 1376 |     proc a1 {} { | 
|---|
 | 1377 |         interp invokehidden a h1 | 
|---|
 | 1378 |     } | 
|---|
 | 1379 |     set r [interp eval a p1] | 
|---|
 | 1380 |     interp delete a | 
|---|
 | 1381 |     set r | 
|---|
 | 1382 | } 91 | 
|---|
 | 1383 | test interp-20.38 {invokehidden at global level} { | 
|---|
 | 1384 |     catch {interp delete a} | 
|---|
 | 1385 |     interp create a | 
|---|
 | 1386 |     a eval { | 
|---|
 | 1387 |         proc p1 {} { | 
|---|
 | 1388 |             a1 | 
|---|
 | 1389 |             set z | 
|---|
 | 1390 |         } | 
|---|
 | 1391 |         proc h1 {} { | 
|---|
 | 1392 |             upvar z z | 
|---|
 | 1393 |             set z 91 | 
|---|
 | 1394 |         } | 
|---|
 | 1395 |     } | 
|---|
 | 1396 |     a hide h1 | 
|---|
 | 1397 |     a alias a1 a1 | 
|---|
 | 1398 |     proc a1 {} { | 
|---|
 | 1399 |         interp invokehidden a -global h1 | 
|---|
 | 1400 |     } | 
|---|
 | 1401 |     set r [catch {interp eval a p1} msg] | 
|---|
 | 1402 |     interp delete a | 
|---|
 | 1403 |     list $r $msg | 
|---|
 | 1404 | } {1 {can't read "z": no such variable}} | 
|---|
 | 1405 | test interp-20.39 {invokehidden at global level} { | 
|---|
 | 1406 |     catch {interp delete a} | 
|---|
 | 1407 |     interp create a | 
|---|
 | 1408 |     a eval { | 
|---|
 | 1409 |         proc p1 {} { | 
|---|
 | 1410 |             global z | 
|---|
 | 1411 |             a1 | 
|---|
 | 1412 |             set z | 
|---|
 | 1413 |         } | 
|---|
 | 1414 |         proc h1 {} { | 
|---|
 | 1415 |             upvar z z | 
|---|
 | 1416 |             set z 91 | 
|---|
 | 1417 |         } | 
|---|
 | 1418 |     } | 
|---|
 | 1419 |     a hide h1 | 
|---|
 | 1420 |     a alias a1 a1 | 
|---|
 | 1421 |     proc a1 {} { | 
|---|
 | 1422 |         interp invokehidden a -global h1 | 
|---|
 | 1423 |     } | 
|---|
 | 1424 |     set r [catch {interp eval a p1} msg] | 
|---|
 | 1425 |     interp delete a | 
|---|
 | 1426 |     list $r $msg | 
|---|
 | 1427 | } {0 91} | 
|---|
 | 1428 | test interp-20.40 {safe, invokehidden at local level} { | 
|---|
 | 1429 |     catch {interp delete a} | 
|---|
 | 1430 |     interp create a -safe | 
|---|
 | 1431 |     a eval { | 
|---|
 | 1432 |         proc p1 {} { | 
|---|
 | 1433 |             set z 90 | 
|---|
 | 1434 |             a1 | 
|---|
 | 1435 |             set z | 
|---|
 | 1436 |         } | 
|---|
 | 1437 |         proc h1 {} { | 
|---|
 | 1438 |             upvar z z | 
|---|
 | 1439 |             set z 91 | 
|---|
 | 1440 |         } | 
|---|
 | 1441 |     } | 
|---|
 | 1442 |     a hide h1 | 
|---|
 | 1443 |     a alias a1 a1 | 
|---|
 | 1444 |     proc a1 {} { | 
|---|
 | 1445 |         interp invokehidden a h1 | 
|---|
 | 1446 |     } | 
|---|
 | 1447 |     set r [interp eval a p1] | 
|---|
 | 1448 |     interp delete a | 
|---|
 | 1449 |     set r | 
|---|
 | 1450 | } 91 | 
|---|
 | 1451 | test interp-20.41 {safe, invokehidden at local level} { | 
|---|
 | 1452 |     catch {interp delete a} | 
|---|
 | 1453 |     interp create a -safe | 
|---|
 | 1454 |     a eval { | 
|---|
 | 1455 |         set z 90 | 
|---|
 | 1456 |         proc p1 {} { | 
|---|
 | 1457 |             global z | 
|---|
 | 1458 |             a1 | 
|---|
 | 1459 |             set z | 
|---|
 | 1460 |         } | 
|---|
 | 1461 |         proc h1 {} { | 
|---|
 | 1462 |             upvar z z | 
|---|
 | 1463 |             set z 91 | 
|---|
 | 1464 |         } | 
|---|
 | 1465 |     } | 
|---|
 | 1466 |     a hide h1 | 
|---|
 | 1467 |     a alias a1 a1 | 
|---|
 | 1468 |     proc a1 {} { | 
|---|
 | 1469 |         interp invokehidden a h1 | 
|---|
 | 1470 |     } | 
|---|
 | 1471 |     set r [interp eval a p1] | 
|---|
 | 1472 |     interp delete a | 
|---|
 | 1473 |     set r | 
|---|
 | 1474 | } 91 | 
|---|
 | 1475 | test interp-20.42 {safe, invokehidden at local level} { | 
|---|
 | 1476 |     catch {interp delete a} | 
|---|
 | 1477 |     interp create a -safe | 
|---|
 | 1478 |     a eval { | 
|---|
 | 1479 |         proc p1 {} { | 
|---|
 | 1480 |             a1 | 
|---|
 | 1481 |             set z | 
|---|
 | 1482 |         } | 
|---|
 | 1483 |         proc h1 {} { | 
|---|
 | 1484 |             upvar z z | 
|---|
 | 1485 |             set z 91 | 
|---|
 | 1486 |         } | 
|---|
 | 1487 |     } | 
|---|
 | 1488 |     a hide h1 | 
|---|
 | 1489 |     a alias a1 a1 | 
|---|
 | 1490 |     proc a1 {} { | 
|---|
 | 1491 |         interp invokehidden a h1 | 
|---|
 | 1492 |     } | 
|---|
 | 1493 |     set r [interp eval a p1] | 
|---|
 | 1494 |     interp delete a | 
|---|
 | 1495 |     set r | 
|---|
 | 1496 | } 91 | 
|---|
 | 1497 | test interp-20.43 {invokehidden at global level} { | 
|---|
 | 1498 |     catch {interp delete a} | 
|---|
 | 1499 |     interp create a | 
|---|
 | 1500 |     a eval { | 
|---|
 | 1501 |         proc p1 {} { | 
|---|
 | 1502 |             a1 | 
|---|
 | 1503 |             set z | 
|---|
 | 1504 |         } | 
|---|
 | 1505 |         proc h1 {} { | 
|---|
 | 1506 |             upvar z z | 
|---|
 | 1507 |             set z 91 | 
|---|
 | 1508 |         } | 
|---|
 | 1509 |     } | 
|---|
 | 1510 |     a hide h1 | 
|---|
 | 1511 |     a alias a1 a1 | 
|---|
 | 1512 |     proc a1 {} { | 
|---|
 | 1513 |         interp invokehidden a -global h1 | 
|---|
 | 1514 |     } | 
|---|
 | 1515 |     set r [catch {interp eval a p1} msg] | 
|---|
 | 1516 |     interp delete a | 
|---|
 | 1517 |     list $r $msg | 
|---|
 | 1518 | } {1 {can't read "z": no such variable}} | 
|---|
 | 1519 | test interp-20.44 {invokehidden at global level} { | 
|---|
 | 1520 |     catch {interp delete a} | 
|---|
 | 1521 |     interp create a | 
|---|
 | 1522 |     a eval { | 
|---|
 | 1523 |         proc p1 {} { | 
|---|
 | 1524 |             global z | 
|---|
 | 1525 |             a1 | 
|---|
 | 1526 |             set z | 
|---|
 | 1527 |         } | 
|---|
 | 1528 |         proc h1 {} { | 
|---|
 | 1529 |             upvar z z | 
|---|
 | 1530 |             set z 91 | 
|---|
 | 1531 |         } | 
|---|
 | 1532 |     } | 
|---|
 | 1533 |     a hide h1 | 
|---|
 | 1534 |     a alias a1 a1 | 
|---|
 | 1535 |     proc a1 {} { | 
|---|
 | 1536 |         interp invokehidden a -global h1 | 
|---|
 | 1537 |     } | 
|---|
 | 1538 |     set r [catch {interp eval a p1} msg] | 
|---|
 | 1539 |     interp delete a | 
|---|
 | 1540 |     list $r $msg | 
|---|
 | 1541 | } {0 91} | 
|---|
 | 1542 | test interp-20.45 {interp hide vs namespaces} { | 
|---|
 | 1543 |     catch {interp delete a} | 
|---|
 | 1544 |     interp create a | 
|---|
 | 1545 |     a eval { | 
|---|
 | 1546 |         namespace eval foo {} | 
|---|
 | 1547 |         proc foo::x {} {} | 
|---|
 | 1548 |     } | 
|---|
 | 1549 |     set l [list [catch {interp hide a foo::x} msg] $msg] | 
|---|
 | 1550 |     interp delete a | 
|---|
 | 1551 |     set l | 
|---|
 | 1552 | } {1 {cannot use namespace qualifiers in hidden command token (rename)}} | 
|---|
 | 1553 | test interp-20.46 {interp hide vs namespaces} { | 
|---|
 | 1554 |     catch {interp delete a} | 
|---|
 | 1555 |     interp create a | 
|---|
 | 1556 |     a eval { | 
|---|
 | 1557 |         namespace eval foo {} | 
|---|
 | 1558 |         proc foo::x {} {} | 
|---|
 | 1559 |     } | 
|---|
 | 1560 |     set l [list [catch {interp hide a foo::x x} msg] $msg] | 
|---|
 | 1561 |     interp delete a | 
|---|
 | 1562 |     set l | 
|---|
 | 1563 | } {1 {can only hide global namespace commands (use rename then hide)}} | 
|---|
 | 1564 | test interp-20.47 {interp hide vs namespaces} { | 
|---|
 | 1565 |     catch {interp delete a} | 
|---|
 | 1566 |     interp create a | 
|---|
 | 1567 |     a eval { | 
|---|
 | 1568 |         proc x {} {} | 
|---|
 | 1569 |     } | 
|---|
 | 1570 |     set l [list [catch {interp hide a x foo::x} msg] $msg] | 
|---|
 | 1571 |     interp delete a | 
|---|
 | 1572 |     set l | 
|---|
 | 1573 | } {1 {cannot use namespace qualifiers in hidden command token (rename)}} | 
|---|
 | 1574 | test interp-20.48 {interp hide vs namespaces} { | 
|---|
 | 1575 |     catch {interp delete a} | 
|---|
 | 1576 |     interp create a | 
|---|
 | 1577 |     a eval { | 
|---|
 | 1578 |         namespace eval foo {} | 
|---|
 | 1579 |         proc foo::x {} {} | 
|---|
 | 1580 |     } | 
|---|
 | 1581 |     set l [list [catch {interp hide a foo::x bar::x} msg] $msg] | 
|---|
 | 1582 |     interp delete a | 
|---|
 | 1583 |     set l | 
|---|
 | 1584 | } {1 {cannot use namespace qualifiers in hidden command token (rename)}} | 
|---|
 | 1585 | test interp-20.49 {interp invokehidden -namespace} -setup { | 
|---|
 | 1586 |     set script [makeFile { | 
|---|
 | 1587 |         set x [namespace current] | 
|---|
 | 1588 |     } script] | 
|---|
 | 1589 |     interp create -safe slave | 
|---|
 | 1590 | } -body { | 
|---|
 | 1591 |     slave invokehidden -namespace ::foo source $script | 
|---|
 | 1592 |     slave eval {set ::foo::x} | 
|---|
 | 1593 | } -cleanup { | 
|---|
 | 1594 |     interp delete slave | 
|---|
 | 1595 |     removeFile script | 
|---|
 | 1596 | } -result ::foo | 
|---|
 | 1597 |  | 
|---|
 | 1598 |  | 
|---|
 | 1599 | test interp-21.1 {interp hidden} { | 
|---|
 | 1600 |     interp hidden {} | 
|---|
 | 1601 | } "" | 
|---|
 | 1602 | test interp-21.2 {interp hidden} { | 
|---|
 | 1603 |     interp hidden | 
|---|
 | 1604 | } "" | 
|---|
 | 1605 | test interp-21.3 {interp hidden vs interp hide, interp expose} { | 
|---|
 | 1606 |     set l "" | 
|---|
 | 1607 |     lappend l [interp hidden] | 
|---|
 | 1608 |     interp hide {} pwd | 
|---|
 | 1609 |     lappend l [interp hidden] | 
|---|
 | 1610 |     interp expose {} pwd | 
|---|
 | 1611 |     lappend l [interp hidden] | 
|---|
 | 1612 |     set l | 
|---|
 | 1613 | } {{} pwd {}} | 
|---|
 | 1614 | test interp-21.4 {interp hidden} { | 
|---|
 | 1615 |     catch {interp delete a} | 
|---|
 | 1616 |     interp create a | 
|---|
 | 1617 |     set l [interp hidden a] | 
|---|
 | 1618 |     interp delete a | 
|---|
 | 1619 |     set l | 
|---|
 | 1620 | } "" | 
|---|
 | 1621 | test interp-21.5 {interp hidden} { | 
|---|
 | 1622 |     catch {interp delete a} | 
|---|
 | 1623 |     interp create -safe a | 
|---|
 | 1624 |     set l [lsort [interp hidden a]] | 
|---|
 | 1625 |     interp delete a | 
|---|
 | 1626 |     set l | 
|---|
 | 1627 | } $hidden_cmds  | 
|---|
 | 1628 | test interp-21.6 {interp hidden vs interp hide, interp expose} { | 
|---|
 | 1629 |     catch {interp delete a} | 
|---|
 | 1630 |     interp create a | 
|---|
 | 1631 |     set l "" | 
|---|
 | 1632 |     lappend l [interp hidden a] | 
|---|
 | 1633 |     interp hide a pwd | 
|---|
 | 1634 |     lappend l [interp hidden a] | 
|---|
 | 1635 |     interp expose a pwd | 
|---|
 | 1636 |     lappend l [interp hidden a] | 
|---|
 | 1637 |     interp delete a | 
|---|
 | 1638 |     set l | 
|---|
 | 1639 | } {{} pwd {}} | 
|---|
 | 1640 | test interp-21.7 {interp hidden} { | 
|---|
 | 1641 |     catch {interp delete a} | 
|---|
 | 1642 |     interp create a | 
|---|
 | 1643 |     set l [a hidden] | 
|---|
 | 1644 |     interp delete a | 
|---|
 | 1645 |     set l | 
|---|
 | 1646 | } "" | 
|---|
 | 1647 | test interp-21.8 {interp hidden} { | 
|---|
 | 1648 |     catch {interp delete a} | 
|---|
 | 1649 |     interp create a -safe | 
|---|
 | 1650 |     set l [lsort [a hidden]] | 
|---|
 | 1651 |     interp delete a | 
|---|
 | 1652 |     set l | 
|---|
 | 1653 | } $hidden_cmds | 
|---|
 | 1654 | test interp-21.9 {interp hidden vs interp hide, interp expose} { | 
|---|
 | 1655 |     catch {interp delete a} | 
|---|
 | 1656 |     interp create a | 
|---|
 | 1657 |     set l "" | 
|---|
 | 1658 |     lappend l [a hidden] | 
|---|
 | 1659 |     a hide pwd | 
|---|
 | 1660 |     lappend l [a hidden] | 
|---|
 | 1661 |     a expose pwd | 
|---|
 | 1662 |     lappend l [a hidden] | 
|---|
 | 1663 |     interp delete a | 
|---|
 | 1664 |     set l | 
|---|
 | 1665 | } {{} pwd {}} | 
|---|
 | 1666 |  | 
|---|
 | 1667 | test interp-22.1 {testing interp marktrusted} { | 
|---|
 | 1668 |     catch {interp delete a} | 
|---|
 | 1669 |     interp create a | 
|---|
 | 1670 |     set l "" | 
|---|
 | 1671 |     lappend l [a issafe] | 
|---|
 | 1672 |     lappend l [a marktrusted] | 
|---|
 | 1673 |     lappend l [a issafe] | 
|---|
 | 1674 |     interp delete a | 
|---|
 | 1675 |     set l | 
|---|
 | 1676 | } {0 {} 0} | 
|---|
 | 1677 | test interp-22.2 {testing interp marktrusted} { | 
|---|
 | 1678 |     catch {interp delete a} | 
|---|
 | 1679 |     interp create a | 
|---|
 | 1680 |     set l "" | 
|---|
 | 1681 |     lappend l [interp issafe a] | 
|---|
 | 1682 |     lappend l [interp marktrusted a] | 
|---|
 | 1683 |     lappend l [interp issafe a] | 
|---|
 | 1684 |     interp delete a | 
|---|
 | 1685 |     set l | 
|---|
 | 1686 | } {0 {} 0} | 
|---|
 | 1687 | test interp-22.3 {testing interp marktrusted} { | 
|---|
 | 1688 |     catch {interp delete a} | 
|---|
 | 1689 |     interp create a -safe | 
|---|
 | 1690 |     set l "" | 
|---|
 | 1691 |     lappend l [a issafe] | 
|---|
 | 1692 |     lappend l [a marktrusted] | 
|---|
 | 1693 |     lappend l [a issafe] | 
|---|
 | 1694 |     interp delete a | 
|---|
 | 1695 |     set l | 
|---|
 | 1696 | } {1 {} 0} | 
|---|
 | 1697 | test interp-22.4 {testing interp marktrusted} { | 
|---|
 | 1698 |     catch {interp delete a} | 
|---|
 | 1699 |     interp create a -safe | 
|---|
 | 1700 |     set l "" | 
|---|
 | 1701 |     lappend l [interp issafe a] | 
|---|
 | 1702 |     lappend l [interp marktrusted a] | 
|---|
 | 1703 |     lappend l [interp issafe a] | 
|---|
 | 1704 |     interp delete a | 
|---|
 | 1705 |     set l | 
|---|
 | 1706 | } {1 {} 0} | 
|---|
 | 1707 | test interp-22.5 {testing interp marktrusted} { | 
|---|
 | 1708 |     catch {interp delete a} | 
|---|
 | 1709 |     interp create a -safe | 
|---|
 | 1710 |     interp create {a b} | 
|---|
 | 1711 |     catch {a eval {interp marktrusted b}} msg | 
|---|
 | 1712 |     interp delete a | 
|---|
 | 1713 |     set msg | 
|---|
 | 1714 | } {permission denied: safe interpreter cannot mark trusted} | 
|---|
 | 1715 | test interp-22.6 {testing interp marktrusted} { | 
|---|
 | 1716 |     catch {interp delete a} | 
|---|
 | 1717 |     interp create a -safe | 
|---|
 | 1718 |     interp create {a b} | 
|---|
 | 1719 |     catch {a eval {b marktrusted}} msg | 
|---|
 | 1720 |     interp delete a | 
|---|
 | 1721 |     set msg | 
|---|
 | 1722 | } {permission denied: safe interpreter cannot mark trusted} | 
|---|
 | 1723 | test interp-22.7 {testing interp marktrusted} { | 
|---|
 | 1724 |     catch {interp delete a} | 
|---|
 | 1725 |     interp create a -safe | 
|---|
 | 1726 |     set l "" | 
|---|
 | 1727 |     lappend l [interp issafe a] | 
|---|
 | 1728 |     interp marktrusted a | 
|---|
 | 1729 |     interp create {a b} | 
|---|
 | 1730 |     lappend l [interp issafe a] | 
|---|
 | 1731 |     lappend l [interp issafe {a b}] | 
|---|
 | 1732 |     interp delete a | 
|---|
 | 1733 |     set l | 
|---|
 | 1734 | } {1 0 0} | 
|---|
 | 1735 | test interp-22.8 {testing interp marktrusted} { | 
|---|
 | 1736 |     catch {interp delete a} | 
|---|
 | 1737 |     interp create a -safe | 
|---|
 | 1738 |     set l "" | 
|---|
 | 1739 |     lappend l [interp issafe a] | 
|---|
 | 1740 |     interp create {a b} | 
|---|
 | 1741 |     lappend l [interp issafe {a b}] | 
|---|
 | 1742 |     interp marktrusted a | 
|---|
 | 1743 |     interp create {a c} | 
|---|
 | 1744 |     lappend l [interp issafe a] | 
|---|
 | 1745 |     lappend l [interp issafe {a c}] | 
|---|
 | 1746 |     interp delete a | 
|---|
 | 1747 |     set l | 
|---|
 | 1748 | } {1 1 0 0} | 
|---|
 | 1749 | test interp-22.9 {testing interp marktrusted} { | 
|---|
 | 1750 |     catch {interp delete a} | 
|---|
 | 1751 |     interp create a -safe | 
|---|
 | 1752 |     set l "" | 
|---|
 | 1753 |     lappend l [interp issafe a] | 
|---|
 | 1754 |     interp create {a b} | 
|---|
 | 1755 |     lappend l [interp issafe {a b}] | 
|---|
 | 1756 |     interp marktrusted {a b} | 
|---|
 | 1757 |     lappend l [interp issafe a] | 
|---|
 | 1758 |     lappend l [interp issafe {a b}] | 
|---|
 | 1759 |     interp create {a b c} | 
|---|
 | 1760 |     lappend l [interp issafe {a b c}] | 
|---|
 | 1761 |     interp delete a | 
|---|
 | 1762 |     set l | 
|---|
 | 1763 | } {1 1 1 0 0} | 
|---|
 | 1764 |  | 
|---|
 | 1765 | test interp-23.1 {testing hiding vs aliases} { | 
|---|
 | 1766 |     catch {interp delete a} | 
|---|
 | 1767 |     interp create a | 
|---|
 | 1768 |     set l "" | 
|---|
 | 1769 |     lappend l [interp hidden a] | 
|---|
 | 1770 |     a alias bar bar | 
|---|
 | 1771 |     lappend l [interp aliases a] | 
|---|
 | 1772 |     lappend l [interp hidden a] | 
|---|
 | 1773 |     a hide bar | 
|---|
 | 1774 |     lappend l [interp aliases a] | 
|---|
 | 1775 |     lappend l [interp hidden a] | 
|---|
 | 1776 |     a alias bar {} | 
|---|
 | 1777 |     lappend l [interp aliases a] | 
|---|
 | 1778 |     lappend l [interp hidden a] | 
|---|
 | 1779 |     interp delete a | 
|---|
 | 1780 |     set l | 
|---|
 | 1781 | } {{} bar {} bar bar {} {}} | 
|---|
 | 1782 | test interp-23.2 {testing hiding vs aliases} {unixOrPc} { | 
|---|
 | 1783 |     catch {interp delete a} | 
|---|
 | 1784 |     interp create a -safe | 
|---|
 | 1785 |     set l "" | 
|---|
 | 1786 |     lappend l [lsort [interp hidden a]] | 
|---|
 | 1787 |     a alias bar bar | 
|---|
 | 1788 |     lappend l [lsort [interp aliases a]] | 
|---|
 | 1789 |     lappend l [lsort [interp hidden a]] | 
|---|
 | 1790 |     a hide bar | 
|---|
 | 1791 |     lappend l [lsort [interp aliases a]] | 
|---|
 | 1792 |     lappend l [lsort [interp hidden a]] | 
|---|
 | 1793 |     a alias bar {} | 
|---|
 | 1794 |     lappend l [interp aliases a] | 
|---|
 | 1795 |     lappend l [lsort [interp hidden a]] | 
|---|
 | 1796 |     interp delete a | 
|---|
 | 1797 |     set l | 
|---|
 | 1798 | } {{cd encoding exec exit fconfigure file glob load open pwd socket source unload} {bar clock} {cd encoding exec exit fconfigure file glob load open pwd socket source unload} {bar clock} {bar cd encoding exec exit fconfigure file glob load open pwd socket source unload} clock {cd encoding exec exit fconfigure file glob load open pwd socket source unload}}  | 
|---|
 | 1799 |  | 
|---|
 | 1800 | test interp-24.1 {result resetting on error} { | 
|---|
 | 1801 |     catch {interp delete a} | 
|---|
 | 1802 |     interp create a | 
|---|
 | 1803 |     proc foo args {error $args} | 
|---|
 | 1804 |     interp alias a foo {} foo | 
|---|
 | 1805 |     set l [interp eval a { | 
|---|
 | 1806 |         set l {} | 
|---|
 | 1807 |         lappend l [catch {foo 1 2 3} msg] | 
|---|
 | 1808 |         lappend l $msg | 
|---|
 | 1809 |         lappend l [catch {foo 3 4 5} msg] | 
|---|
 | 1810 |         lappend l $msg | 
|---|
 | 1811 |         set l | 
|---|
 | 1812 |     }] | 
|---|
 | 1813 |     interp delete a | 
|---|
 | 1814 |     rename foo {} | 
|---|
 | 1815 |     set l | 
|---|
 | 1816 | } {1 {1 2 3} 1 {3 4 5}} | 
|---|
 | 1817 | test interp-24.2 {result resetting on error} { | 
|---|
 | 1818 |     catch {interp delete a} | 
|---|
 | 1819 |     interp create a -safe | 
|---|
 | 1820 |     proc foo args {error $args} | 
|---|
 | 1821 |     interp alias a foo {} foo | 
|---|
 | 1822 |     set l [interp eval a { | 
|---|
 | 1823 |         set l {} | 
|---|
 | 1824 |         lappend l [catch {foo 1 2 3} msg] | 
|---|
 | 1825 |         lappend l $msg | 
|---|
 | 1826 |         lappend l [catch {foo 3 4 5} msg] | 
|---|
 | 1827 |         lappend l $msg | 
|---|
 | 1828 |         set l | 
|---|
 | 1829 |     }] | 
|---|
 | 1830 |     interp delete a | 
|---|
 | 1831 |     rename foo {} | 
|---|
 | 1832 |     set l | 
|---|
 | 1833 | } {1 {1 2 3} 1 {3 4 5}} | 
|---|
 | 1834 | test interp-24.3 {result resetting on error} { | 
|---|
 | 1835 |     catch {interp delete a} | 
|---|
 | 1836 |     interp create a | 
|---|
 | 1837 |     interp create {a b} | 
|---|
 | 1838 |     interp eval a { | 
|---|
 | 1839 |         proc foo args {error $args} | 
|---|
 | 1840 |     } | 
|---|
 | 1841 |     interp alias {a b} foo a foo | 
|---|
 | 1842 |     set l [interp eval {a b} { | 
|---|
 | 1843 |         set l {} | 
|---|
 | 1844 |         lappend l [catch {foo 1 2 3} msg] | 
|---|
 | 1845 |         lappend l $msg | 
|---|
 | 1846 |         lappend l [catch {foo 3 4 5} msg] | 
|---|
 | 1847 |         lappend l $msg | 
|---|
 | 1848 |         set l | 
|---|
 | 1849 |     }] | 
|---|
 | 1850 |     interp delete a | 
|---|
 | 1851 |     set l | 
|---|
 | 1852 | } {1 {1 2 3} 1 {3 4 5}} | 
|---|
 | 1853 | test interp-24.4 {result resetting on error} { | 
|---|
 | 1854 |     catch {interp delete a} | 
|---|
 | 1855 |     interp create a -safe | 
|---|
 | 1856 |     interp create {a b} | 
|---|
 | 1857 |     interp eval a { | 
|---|
 | 1858 |         proc foo args {error $args} | 
|---|
 | 1859 |     } | 
|---|
 | 1860 |     interp alias {a b} foo a foo | 
|---|
 | 1861 |     set l [interp eval {a b} { | 
|---|
 | 1862 |         set l {} | 
|---|
 | 1863 |         lappend l [catch {foo 1 2 3} msg] | 
|---|
 | 1864 |         lappend l $msg | 
|---|
 | 1865 |         lappend l [catch {foo 3 4 5} msg] | 
|---|
 | 1866 |         lappend l $msg | 
|---|
 | 1867 |         set l | 
|---|
 | 1868 |     }] | 
|---|
 | 1869 |     interp delete a | 
|---|
 | 1870 |     set l | 
|---|
 | 1871 | } {1 {1 2 3} 1 {3 4 5}} | 
|---|
 | 1872 | test interp-24.5 {result resetting on error} { | 
|---|
 | 1873 |     catch {interp delete a} | 
|---|
 | 1874 |     catch {interp delete b} | 
|---|
 | 1875 |     interp create a | 
|---|
 | 1876 |     interp create b | 
|---|
 | 1877 |     interp eval a { | 
|---|
 | 1878 |         proc foo args {error $args} | 
|---|
 | 1879 |     } | 
|---|
 | 1880 |     interp alias b foo a foo | 
|---|
 | 1881 |     set l [interp eval b { | 
|---|
 | 1882 |         set l {} | 
|---|
 | 1883 |         lappend l [catch {foo 1 2 3} msg] | 
|---|
 | 1884 |         lappend l $msg | 
|---|
 | 1885 |         lappend l [catch {foo 3 4 5} msg] | 
|---|
 | 1886 |         lappend l $msg | 
|---|
 | 1887 |         set l | 
|---|
 | 1888 |     }] | 
|---|
 | 1889 |     interp delete a | 
|---|
 | 1890 |     set l | 
|---|
 | 1891 | } {1 {1 2 3} 1 {3 4 5}} | 
|---|
 | 1892 | test interp-24.6 {result resetting on error} { | 
|---|
 | 1893 |     catch {interp delete a} | 
|---|
 | 1894 |     catch {interp delete b} | 
|---|
 | 1895 |     interp create a -safe | 
|---|
 | 1896 |     interp create b -safe | 
|---|
 | 1897 |     interp eval a { | 
|---|
 | 1898 |         proc foo args {error $args} | 
|---|
 | 1899 |     } | 
|---|
 | 1900 |     interp alias b foo a foo | 
|---|
 | 1901 |     set l [interp eval b { | 
|---|
 | 1902 |         set l {} | 
|---|
 | 1903 |         lappend l [catch {foo 1 2 3} msg] | 
|---|
 | 1904 |         lappend l $msg | 
|---|
 | 1905 |         lappend l [catch {foo 3 4 5} msg] | 
|---|
 | 1906 |         lappend l $msg | 
|---|
 | 1907 |         set l | 
|---|
 | 1908 |     }] | 
|---|
 | 1909 |     interp delete a | 
|---|
 | 1910 |     set l | 
|---|
 | 1911 | } {1 {1 2 3} 1 {3 4 5}} | 
|---|
 | 1912 | test interp-24.7 {result resetting on error} { | 
|---|
 | 1913 |     catch {interp delete a} | 
|---|
 | 1914 |     interp create a | 
|---|
 | 1915 |     interp eval a { | 
|---|
 | 1916 |         proc foo args {error $args} | 
|---|
 | 1917 |     } | 
|---|
 | 1918 |     set l {} | 
|---|
 | 1919 |     lappend l [catch {interp eval a foo 1 2 3} msg] | 
|---|
 | 1920 |     lappend l $msg | 
|---|
 | 1921 |     lappend l [catch {interp eval a foo 3 4 5} msg] | 
|---|
 | 1922 |     lappend l $msg | 
|---|
 | 1923 |     interp delete a | 
|---|
 | 1924 |     set l | 
|---|
 | 1925 | } {1 {1 2 3} 1 {3 4 5}} | 
|---|
 | 1926 | test interp-24.8 {result resetting on error} { | 
|---|
 | 1927 |     catch {interp delete a} | 
|---|
 | 1928 |     interp create a -safe | 
|---|
 | 1929 |     interp eval a { | 
|---|
 | 1930 |         proc foo args {error $args} | 
|---|
 | 1931 |     } | 
|---|
 | 1932 |     set l {} | 
|---|
 | 1933 |     lappend l [catch {interp eval a foo 1 2 3} msg] | 
|---|
 | 1934 |     lappend l $msg | 
|---|
 | 1935 |     lappend l [catch {interp eval a foo 3 4 5} msg] | 
|---|
 | 1936 |     lappend l $msg | 
|---|
 | 1937 |     interp delete a | 
|---|
 | 1938 |     set l | 
|---|
 | 1939 | } {1 {1 2 3} 1 {3 4 5}} | 
|---|
 | 1940 | test interp-24.9 {result resetting on error} { | 
|---|
 | 1941 |     catch {interp delete a} | 
|---|
 | 1942 |     interp create a | 
|---|
 | 1943 |     interp create {a b} | 
|---|
 | 1944 |     interp eval {a b} { | 
|---|
 | 1945 |         proc foo args {error $args} | 
|---|
 | 1946 |     } | 
|---|
 | 1947 |     interp eval a { | 
|---|
 | 1948 |         proc foo args { | 
|---|
 | 1949 |             eval interp eval b foo $args | 
|---|
 | 1950 |         } | 
|---|
 | 1951 |     } | 
|---|
 | 1952 |     set l {} | 
|---|
 | 1953 |     lappend l [catch {interp eval a foo 1 2 3} msg] | 
|---|
 | 1954 |     lappend l $msg | 
|---|
 | 1955 |     lappend l [catch {interp eval a foo 3 4 5} msg] | 
|---|
 | 1956 |     lappend l $msg | 
|---|
 | 1957 |     interp delete a | 
|---|
 | 1958 |     set l | 
|---|
 | 1959 | } {1 {1 2 3} 1 {3 4 5}} | 
|---|
 | 1960 | test interp-24.10 {result resetting on error} { | 
|---|
 | 1961 |     catch {interp delete a} | 
|---|
 | 1962 |     interp create a -safe | 
|---|
 | 1963 |     interp create {a b} | 
|---|
 | 1964 |     interp eval {a b} { | 
|---|
 | 1965 |         proc foo args {error $args} | 
|---|
 | 1966 |     } | 
|---|
 | 1967 |     interp eval a { | 
|---|
 | 1968 |         proc foo args { | 
|---|
 | 1969 |             eval interp eval b foo $args | 
|---|
 | 1970 |         } | 
|---|
 | 1971 |     } | 
|---|
 | 1972 |     set l {} | 
|---|
 | 1973 |     lappend l [catch {interp eval a foo 1 2 3} msg] | 
|---|
 | 1974 |     lappend l $msg | 
|---|
 | 1975 |     lappend l [catch {interp eval a foo 3 4 5} msg] | 
|---|
 | 1976 |     lappend l $msg | 
|---|
 | 1977 |     interp delete a | 
|---|
 | 1978 |     set l | 
|---|
 | 1979 | } {1 {1 2 3} 1 {3 4 5}} | 
|---|
 | 1980 | test interp-24.11 {result resetting on error} { | 
|---|
 | 1981 |     catch {interp delete a} | 
|---|
 | 1982 |     interp create a | 
|---|
 | 1983 |     interp create {a b} | 
|---|
 | 1984 |     interp eval {a b} { | 
|---|
 | 1985 |         proc foo args {error $args} | 
|---|
 | 1986 |     } | 
|---|
 | 1987 |     interp eval a { | 
|---|
 | 1988 |         proc foo args { | 
|---|
 | 1989 |             set l {} | 
|---|
 | 1990 |             lappend l [catch {eval interp eval b foo $args} msg] | 
|---|
 | 1991 |             lappend l $msg | 
|---|
 | 1992 |             lappend l [catch {eval interp eval b foo $args} msg] | 
|---|
 | 1993 |             lappend l $msg | 
|---|
 | 1994 |             set l | 
|---|
 | 1995 |         } | 
|---|
 | 1996 |     } | 
|---|
 | 1997 |     set l [interp eval a foo 1 2 3] | 
|---|
 | 1998 |     interp delete a | 
|---|
 | 1999 |     set l | 
|---|
 | 2000 | } {1 {1 2 3} 1 {1 2 3}} | 
|---|
 | 2001 | test interp-24.12 {result resetting on error} { | 
|---|
 | 2002 |     catch {interp delete a} | 
|---|
 | 2003 |     interp create a -safe | 
|---|
 | 2004 |     interp create {a b} | 
|---|
 | 2005 |     interp eval {a b} { | 
|---|
 | 2006 |         proc foo args {error $args} | 
|---|
 | 2007 |     } | 
|---|
 | 2008 |     interp eval a { | 
|---|
 | 2009 |         proc foo args { | 
|---|
 | 2010 |             set l {} | 
|---|
 | 2011 |             lappend l [catch {eval interp eval b foo $args} msg] | 
|---|
 | 2012 |             lappend l $msg | 
|---|
 | 2013 |             lappend l [catch {eval interp eval b foo $args} msg] | 
|---|
 | 2014 |             lappend l $msg | 
|---|
 | 2015 |             set l | 
|---|
 | 2016 |         } | 
|---|
 | 2017 |     } | 
|---|
 | 2018 |     set l [interp eval a foo 1 2 3] | 
|---|
 | 2019 |     interp delete a | 
|---|
 | 2020 |     set l | 
|---|
 | 2021 | } {1 {1 2 3} 1 {1 2 3}} | 
|---|
 | 2022 |  | 
|---|
 | 2023 | unset hidden_cmds | 
|---|
 | 2024 |  | 
|---|
 | 2025 | test interp-25.1 {testing aliasing of string commands} { | 
|---|
 | 2026 |     catch {interp delete a} | 
|---|
 | 2027 |     interp create a | 
|---|
 | 2028 |     a alias exec foo            ;# Relies on exec being a string command! | 
|---|
 | 2029 |     interp delete a | 
|---|
 | 2030 | } "" | 
|---|
 | 2031 |  | 
|---|
 | 2032 |  | 
|---|
 | 2033 | # | 
|---|
 | 2034 | # Interps result transmission | 
|---|
 | 2035 | # | 
|---|
 | 2036 |  | 
|---|
 | 2037 | test interp-26.1 {result code transmission : interp eval direct} { | 
|---|
 | 2038 |     # Test that all the possibles error codes from Tcl get passed up | 
|---|
 | 2039 |     # from the slave interp's context to the master, even though the | 
|---|
 | 2040 |     # slave nominally thinks the command is running at the root level. | 
|---|
 | 2041 |      | 
|---|
 | 2042 |     catch {interp delete a} | 
|---|
 | 2043 |     interp create a | 
|---|
 | 2044 |     set res {} | 
|---|
 | 2045 |     # use a for so if a return -code break 'escapes' we would notice | 
|---|
 | 2046 |     for {set code -1} {$code<=5} {incr code} { | 
|---|
 | 2047 |         lappend res [catch {interp eval a return -code $code} msg] | 
|---|
 | 2048 |     } | 
|---|
 | 2049 |     interp delete a | 
|---|
 | 2050 |     set res | 
|---|
 | 2051 | } {-1 0 1 2 3 4 5} | 
|---|
 | 2052 |  | 
|---|
 | 2053 |  | 
|---|
 | 2054 | test interp-26.2 {result code transmission : interp eval indirect} { | 
|---|
 | 2055 |     # retcode == 2 == return is special | 
|---|
 | 2056 |     catch {interp delete a} | 
|---|
 | 2057 |     interp create a | 
|---|
 | 2058 |     interp eval a {proc retcode {code} {return -code $code ret$code}} | 
|---|
 | 2059 |     set res {} | 
|---|
 | 2060 |     # use a for so if a return -code break 'escapes' we would notice | 
|---|
 | 2061 |     for {set code -1} {$code<=5} {incr code} { | 
|---|
 | 2062 |         lappend res [catch {interp eval a retcode $code} msg] $msg | 
|---|
 | 2063 |     } | 
|---|
 | 2064 |     interp delete a | 
|---|
 | 2065 |     set res | 
|---|
 | 2066 | } {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5} | 
|---|
 | 2067 |  | 
|---|
 | 2068 | test interp-26.3 {result code transmission : aliases} { | 
|---|
 | 2069 |     # Test that all the possibles error codes from Tcl get passed up | 
|---|
 | 2070 |     # from the slave interp's context to the master, even though the | 
|---|
 | 2071 |     # slave nominally thinks the command is running at the root level. | 
|---|
 | 2072 |      | 
|---|
 | 2073 |     catch {interp delete a} | 
|---|
 | 2074 |     interp create a | 
|---|
 | 2075 |     set res {} | 
|---|
 | 2076 |     proc MyTestAlias {code} { | 
|---|
 | 2077 |         return -code $code ret$code | 
|---|
 | 2078 |     } | 
|---|
 | 2079 |     interp alias a Test {} MyTestAlias | 
|---|
 | 2080 |     for {set code -1} {$code<=5} {incr code} { | 
|---|
 | 2081 |         lappend res [interp eval a [list catch [list Test $code] msg]] | 
|---|
 | 2082 |     } | 
|---|
 | 2083 |     interp delete a | 
|---|
 | 2084 |     set res | 
|---|
 | 2085 | } {-1 0 1 2 3 4 5} | 
|---|
 | 2086 |  | 
|---|
 | 2087 | test interp-26.4 {result code transmission: invoke hidden direct--bug 1637} \ | 
|---|
 | 2088 |         {knownBug} { | 
|---|
 | 2089 |     # The known bug is that code 2 is returned, not the -code argument | 
|---|
 | 2090 |     catch {interp delete a} | 
|---|
 | 2091 |     interp create a | 
|---|
 | 2092 |     set res {} | 
|---|
 | 2093 |     interp hide a return | 
|---|
 | 2094 |     for {set code -1} {$code<=5} {incr code} { | 
|---|
 | 2095 |         lappend res [catch {interp invokehidden a return -code $code ret$code}] | 
|---|
 | 2096 |     } | 
|---|
 | 2097 |     interp delete a | 
|---|
 | 2098 |     set res | 
|---|
 | 2099 | } {-1 0 1 2 3 4 5} | 
|---|
 | 2100 |  | 
|---|
 | 2101 | test interp-26.5 {result code transmission: invoke hidden indirect--bug 1637} \ | 
|---|
 | 2102 |         {knownBug} { | 
|---|
 | 2103 |     # The known bug is that the break and continue should raise errors | 
|---|
 | 2104 |     # that they are used outside a loop. | 
|---|
 | 2105 |     catch {interp delete a} | 
|---|
 | 2106 |     interp create a | 
|---|
 | 2107 |     set res {} | 
|---|
 | 2108 |     interp eval a {proc retcode {code} {return -code $code ret$code}} | 
|---|
 | 2109 |     interp hide a retcode | 
|---|
 | 2110 |     for {set code -1} {$code<=5} {incr code} { | 
|---|
 | 2111 |         lappend res [catch {interp invokehidden a retcode $code} msg] $msg | 
|---|
 | 2112 |     } | 
|---|
 | 2113 |     interp delete a | 
|---|
 | 2114 |     set res | 
|---|
 | 2115 | } {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5} | 
|---|
 | 2116 |  | 
|---|
 | 2117 | test interp-26.6 {result code transmission: all combined--bug 1637} \ | 
|---|
 | 2118 |         {knownBug} { | 
|---|
 | 2119 |     # Test that all the possibles error codes from Tcl get passed | 
|---|
 | 2120 |     # In both directions.  This doesn't work. | 
|---|
 | 2121 |     set interp [interp create]; | 
|---|
 | 2122 |     proc MyTestAlias {interp args} { | 
|---|
 | 2123 |         global aliasTrace; | 
|---|
 | 2124 |         lappend aliasTrace $args; | 
|---|
 | 2125 |         interp invokehidden $interp {*}$args | 
|---|
 | 2126 |     } | 
|---|
 | 2127 |     foreach c {return} { | 
|---|
 | 2128 |         interp hide $interp  $c; | 
|---|
 | 2129 |         interp alias $interp $c {} MyTestAlias $interp $c; | 
|---|
 | 2130 |     } | 
|---|
 | 2131 |     interp eval $interp {proc ret {code} {return -code $code ret$code}} | 
|---|
 | 2132 |     set res {} | 
|---|
 | 2133 |     set aliasTrace {} | 
|---|
 | 2134 |     for {set code -1} {$code<=5} {incr code} { | 
|---|
 | 2135 |         lappend res [catch {interp eval $interp ret $code} msg] $msg | 
|---|
 | 2136 |     } | 
|---|
 | 2137 |     interp delete $interp; | 
|---|
 | 2138 |     set res | 
|---|
 | 2139 | } {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5} | 
|---|
 | 2140 |  | 
|---|
 | 2141 | # Some tests might need to be added to check for difference between | 
|---|
 | 2142 | # toplevel and non toplevel evals. | 
|---|
 | 2143 |  | 
|---|
 | 2144 | # End of return code transmission section | 
|---|
 | 2145 |  | 
|---|
 | 2146 | test interp-26.7 {errorInfo transmission: regular interps} { | 
|---|
 | 2147 |     set interp [interp create]; | 
|---|
 | 2148 |     proc MyError {secret} { | 
|---|
 | 2149 |         return -code error "msg" | 
|---|
 | 2150 |     } | 
|---|
 | 2151 |     proc MyTestAlias {interp args} { | 
|---|
 | 2152 |         MyError "some secret" | 
|---|
 | 2153 |     } | 
|---|
 | 2154 |     interp alias $interp test {} MyTestAlias $interp; | 
|---|
 | 2155 |     set res [interp eval $interp {catch test;set ::errorInfo}] | 
|---|
 | 2156 |     interp delete $interp; | 
|---|
 | 2157 |     set res | 
|---|
 | 2158 | } {msg | 
|---|
 | 2159 |     while executing | 
|---|
 | 2160 | "MyError "some secret"" | 
|---|
 | 2161 |     (procedure "MyTestAlias" line 2) | 
|---|
 | 2162 |     invoked from within | 
|---|
 | 2163 | "test"} | 
|---|
 | 2164 |  | 
|---|
 | 2165 | test interp-26.8 {errorInfo transmission: safe interps--bug 1637} {knownBug} { | 
|---|
 | 2166 |     # this test fails because the errorInfo is fully transmitted | 
|---|
 | 2167 |     # whether the interp is safe or not.  The errorInfo should never | 
|---|
 | 2168 |     # report data from the master interpreter because it could | 
|---|
 | 2169 |     # contain sensitive information. | 
|---|
 | 2170 |     set interp [interp create -safe]; | 
|---|
 | 2171 |     proc MyError {secret} { | 
|---|
 | 2172 |         return -code error "msg" | 
|---|
 | 2173 |     } | 
|---|
 | 2174 |     proc MyTestAlias {interp args} { | 
|---|
 | 2175 |         MyError "some secret" | 
|---|
 | 2176 |     } | 
|---|
 | 2177 |     interp alias $interp test {} MyTestAlias $interp; | 
|---|
 | 2178 |     set res [interp eval $interp {catch test;set ::errorInfo}] | 
|---|
 | 2179 |     interp delete $interp; | 
|---|
 | 2180 |     set res | 
|---|
 | 2181 | } {msg | 
|---|
 | 2182 |     while executing | 
|---|
 | 2183 | "test"} | 
|---|
 | 2184 |  | 
|---|
 | 2185 | # Interps & Namespaces | 
|---|
 | 2186 | test interp-27.1 {interp aliases & namespaces} { | 
|---|
 | 2187 |     set i [interp create]; | 
|---|
 | 2188 |     set aliasTrace {}; | 
|---|
 | 2189 |     proc tstAlias {args} {  | 
|---|
 | 2190 |         global aliasTrace; | 
|---|
 | 2191 |         lappend aliasTrace [list [namespace current] $args]; | 
|---|
 | 2192 |     } | 
|---|
 | 2193 |     $i alias foo::bar tstAlias foo::bar; | 
|---|
 | 2194 |     $i eval foo::bar test | 
|---|
 | 2195 |     interp delete $i | 
|---|
 | 2196 |     set aliasTrace; | 
|---|
 | 2197 | } {{:: {foo::bar test}}} | 
|---|
 | 2198 |  | 
|---|
 | 2199 | test interp-27.2 {interp aliases & namespaces} { | 
|---|
 | 2200 |     set i [interp create]; | 
|---|
 | 2201 |     set aliasTrace {}; | 
|---|
 | 2202 |     proc tstAlias {args} {  | 
|---|
 | 2203 |         global aliasTrace; | 
|---|
 | 2204 |         lappend aliasTrace [list [namespace current] $args]; | 
|---|
 | 2205 |     } | 
|---|
 | 2206 |     $i alias foo::bar tstAlias foo::bar; | 
|---|
 | 2207 |     $i eval namespace eval foo {bar test} | 
|---|
 | 2208 |     interp delete $i | 
|---|
 | 2209 |     set aliasTrace; | 
|---|
 | 2210 | } {{:: {foo::bar test}}} | 
|---|
 | 2211 |  | 
|---|
 | 2212 | test interp-27.3 {interp aliases & namespaces} { | 
|---|
 | 2213 |     set i [interp create]; | 
|---|
 | 2214 |     set aliasTrace {}; | 
|---|
 | 2215 |     proc tstAlias {args} {  | 
|---|
 | 2216 |         global aliasTrace; | 
|---|
 | 2217 |         lappend aliasTrace [list [namespace current] $args]; | 
|---|
 | 2218 |     } | 
|---|
 | 2219 |     interp eval $i {namespace eval foo {proc bar {} {error "bar called"}}} | 
|---|
 | 2220 |     interp alias $i foo::bar {} tstAlias foo::bar; | 
|---|
 | 2221 |     interp eval $i {namespace eval foo {bar test}} | 
|---|
 | 2222 |     interp delete $i | 
|---|
 | 2223 |     set aliasTrace; | 
|---|
 | 2224 | } {{:: {foo::bar test}}} | 
|---|
 | 2225 |  | 
|---|
 | 2226 | test interp-27.4 {interp aliases & namespaces} { | 
|---|
 | 2227 |     set i [interp create]; | 
|---|
 | 2228 |     namespace eval foo2 { | 
|---|
 | 2229 |         variable aliasTrace {}; | 
|---|
 | 2230 |         proc bar {args} {  | 
|---|
 | 2231 |             variable aliasTrace; | 
|---|
 | 2232 |             lappend aliasTrace [list [namespace current] $args]; | 
|---|
 | 2233 |         } | 
|---|
 | 2234 |     } | 
|---|
 | 2235 |     $i alias foo::bar foo2::bar foo::bar; | 
|---|
 | 2236 |     $i eval namespace eval foo {bar test} | 
|---|
 | 2237 |     set r $foo2::aliasTrace; | 
|---|
 | 2238 |     namespace delete foo2; | 
|---|
 | 2239 |     set r | 
|---|
 | 2240 | } {{::foo2 {foo::bar test}}} | 
|---|
 | 2241 |  | 
|---|
 | 2242 | # the following tests are commented out while we don't support | 
|---|
 | 2243 | # hiding in namespaces | 
|---|
 | 2244 |  | 
|---|
 | 2245 | # test interp-27.5 {interp hidden & namespaces} { | 
|---|
 | 2246 | #    set i [interp create]; | 
|---|
 | 2247 | #    interp eval $i { | 
|---|
 | 2248 | #        namespace eval foo { | 
|---|
 | 2249 | #           proc bar {args} { | 
|---|
 | 2250 | #               return "bar called ([namespace current]) ($args)" | 
|---|
 | 2251 | #           } | 
|---|
 | 2252 | #       } | 
|---|
 | 2253 | #    } | 
|---|
 | 2254 | #    set res [list [interp eval $i {namespace eval foo {bar test1}}]] | 
|---|
 | 2255 | #    interp hide $i foo::bar; | 
|---|
 | 2256 | #    lappend res [list [catch {interp eval $i {namespace eval foo {bar test2}}} msg] $msg] | 
|---|
 | 2257 | #    interp delete $i; | 
|---|
 | 2258 | #    set res; | 
|---|
 | 2259 | #} {{bar called (::foo) (test1)} {1 {invalid command name "bar"}}} | 
|---|
 | 2260 |  | 
|---|
 | 2261 | # test interp-27.6 {interp hidden & aliases & namespaces} { | 
|---|
 | 2262 | #     set i [interp create]; | 
|---|
 | 2263 | #     set v root-master; | 
|---|
 | 2264 | #     namespace eval foo { | 
|---|
 | 2265 | #       variable v foo-master; | 
|---|
 | 2266 | #       proc bar {interp args} { | 
|---|
 | 2267 | #           variable v; | 
|---|
 | 2268 | #           list "master bar called ($v) ([namespace current]) ($args)"\ | 
|---|
 | 2269 | #                   [interp invokehidden $interp foo::bar $args]; | 
|---|
 | 2270 | #       } | 
|---|
 | 2271 | #     } | 
|---|
 | 2272 | #     interp eval $i { | 
|---|
 | 2273 | #        namespace eval foo { | 
|---|
 | 2274 | #           namespace export * | 
|---|
 | 2275 | #           variable v foo-slave; | 
|---|
 | 2276 | #           proc bar {args} { | 
|---|
 | 2277 | #               variable v; | 
|---|
 | 2278 | #               return "slave bar called ($v) ([namespace current]) ($args)" | 
|---|
 | 2279 | #           } | 
|---|
 | 2280 | #       } | 
|---|
 | 2281 | #     } | 
|---|
 | 2282 | #     set res [list [interp eval $i {namespace eval foo {bar test1}}]] | 
|---|
 | 2283 | #     $i hide foo::bar; | 
|---|
 | 2284 | #     $i alias foo::bar foo::bar $i; | 
|---|
 | 2285 | #     set res [concat $res [interp eval $i { | 
|---|
 | 2286 | #       set v root-slave; | 
|---|
 | 2287 | #         namespace eval test { | 
|---|
 | 2288 | #           variable v foo-test; | 
|---|
 | 2289 | #           namespace import ::foo::*; | 
|---|
 | 2290 | #           bar test2 | 
|---|
 | 2291 | #         } | 
|---|
 | 2292 | #     }]] | 
|---|
 | 2293 | #     namespace delete foo; | 
|---|
 | 2294 | #     interp delete $i; | 
|---|
 | 2295 | #     set res | 
|---|
 | 2296 | # } {{slave bar called (foo-slave) (::foo) (test1)} {master bar called (foo-master) (::foo) (test2)} {slave bar called (foo-slave) (::foo) (test2)}} | 
|---|
 | 2297 |  | 
|---|
 | 2298 |  | 
|---|
 | 2299 | # test interp-27.7 {interp hidden & aliases & imports & namespaces} { | 
|---|
 | 2300 | #     set i [interp create]; | 
|---|
 | 2301 | #     set v root-master; | 
|---|
 | 2302 | #     namespace eval mfoo { | 
|---|
 | 2303 | #       variable v foo-master; | 
|---|
 | 2304 | #       proc bar {interp args} { | 
|---|
 | 2305 | #           variable v; | 
|---|
 | 2306 | #           list "master bar called ($v) ([namespace current]) ($args)"\ | 
|---|
 | 2307 | #                   [interp invokehidden $interp test::bar $args]; | 
|---|
 | 2308 | #       } | 
|---|
 | 2309 | #     } | 
|---|
 | 2310 | #     interp eval $i { | 
|---|
 | 2311 | #       namespace eval foo { | 
|---|
 | 2312 | #           namespace export * | 
|---|
 | 2313 | #           variable v foo-slave; | 
|---|
 | 2314 | #           proc bar {args} { | 
|---|
 | 2315 | #               variable v; | 
|---|
 | 2316 | #               return "slave bar called ($v) ([info level 0]) ([uplevel namespace current]) ([namespace current]) ($args)" | 
|---|
 | 2317 | #           } | 
|---|
 | 2318 | #       } | 
|---|
 | 2319 | #       set v root-slave; | 
|---|
 | 2320 | #       namespace eval test { | 
|---|
 | 2321 | #           variable v foo-test; | 
|---|
 | 2322 | #           namespace import ::foo::*; | 
|---|
 | 2323 | #         } | 
|---|
 | 2324 | #     } | 
|---|
 | 2325 | #     set res [list [interp eval $i {namespace eval test {bar test1}}]] | 
|---|
 | 2326 | #     $i hide test::bar; | 
|---|
 | 2327 | #     $i alias test::bar mfoo::bar $i; | 
|---|
 | 2328 | #     set res [concat $res [interp eval $i {test::bar test2}]]; | 
|---|
 | 2329 | #     namespace delete mfoo; | 
|---|
 | 2330 | #     interp delete $i; | 
|---|
 | 2331 | #     set res | 
|---|
 | 2332 | # } {{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)}} | 
|---|
 | 2333 |  | 
|---|
 | 2334 | #test interp-27.8 {hiding, namespaces and integrity} { | 
|---|
 | 2335 | #    namespace eval foo { | 
|---|
 | 2336 | #       variable v 3; | 
|---|
 | 2337 | #       proc bar {} {variable v; set v} | 
|---|
 | 2338 | #       # next command would currently generate an unknown command "bar" error. | 
|---|
 | 2339 | #       interp hide {} bar; | 
|---|
 | 2340 | #    } | 
|---|
 | 2341 | #    namespace delete foo; | 
|---|
 | 2342 | #    list [catch {interp invokehidden {} foo} msg] $msg; | 
|---|
 | 2343 | #} {1 {invalid hidden command name "foo"}} | 
|---|
 | 2344 |  | 
|---|
 | 2345 |  | 
|---|
 | 2346 | test interp-28.1 {getting fooled by slave's namespace ?} { | 
|---|
 | 2347 |     set i [interp create -safe]; | 
|---|
 | 2348 |     proc master {interp args} {interp hide $interp list} | 
|---|
 | 2349 |     $i alias master master $i; | 
|---|
 | 2350 |     set r [interp eval $i { | 
|---|
 | 2351 |         namespace eval foo { | 
|---|
 | 2352 |             proc list {args} { | 
|---|
 | 2353 |                 return "dummy foo::list"; | 
|---|
 | 2354 |             } | 
|---|
 | 2355 |             master; | 
|---|
 | 2356 |         } | 
|---|
 | 2357 |         info commands list | 
|---|
 | 2358 |     }] | 
|---|
 | 2359 |     interp delete $i; | 
|---|
 | 2360 |     set r | 
|---|
 | 2361 | } {} | 
|---|
 | 2362 |  | 
|---|
 | 2363 | test interp-28.2 {master's nsName cache should not cross} { | 
|---|
 | 2364 |     set i [interp create] | 
|---|
 | 2365 |     set res [$i eval { | 
|---|
 | 2366 |         set x {namespace children ::} | 
|---|
 | 2367 |         set y [list namespace children ::] | 
|---|
 | 2368 |         namespace delete [{*}$y] | 
|---|
 | 2369 |         set j [interp create] | 
|---|
 | 2370 |         $j eval {namespace delete {*}[namespace children ::]} | 
|---|
 | 2371 |         namespace eval foo {} | 
|---|
 | 2372 |         set res [list [eval $x] [eval $y] [$j eval $x] [$j eval $y]] | 
|---|
 | 2373 |         interp delete $j | 
|---|
 | 2374 |         set res | 
|---|
 | 2375 |     }] | 
|---|
 | 2376 |     interp delete $i | 
|---|
 | 2377 |     set res | 
|---|
 | 2378 | } {::foo ::foo {} {}} | 
|---|
 | 2379 |  | 
|---|
 | 2380 | # Part 29: recursion limit | 
|---|
 | 2381 | #  29.1.*  Argument checking | 
|---|
 | 2382 | #  29.2.*  Reading and setting the recursion limit | 
|---|
 | 2383 | #  29.3.*  Does the recursion limit work? | 
|---|
 | 2384 | #  29.4.*  Recursion limit inheritance by sub-interpreters | 
|---|
 | 2385 | #  29.5.*  Confirming the recursionlimit command does not affect the parent | 
|---|
 | 2386 | #  29.6.*  Safe interpreter restriction | 
|---|
 | 2387 |  | 
|---|
 | 2388 | test interp-29.1.1 {interp recursionlimit argument checking} { | 
|---|
 | 2389 |     list [catch {interp recursionlimit} msg] $msg | 
|---|
 | 2390 | } {1 {wrong # args: should be "interp recursionlimit path ?newlimit?"}} | 
|---|
 | 2391 |  | 
|---|
 | 2392 | test interp-29.1.2 {interp recursionlimit argument checking} { | 
|---|
 | 2393 |     list [catch {interp recursionlimit foo bar} msg] $msg | 
|---|
 | 2394 | } {1 {could not find interpreter "foo"}} | 
|---|
 | 2395 |  | 
|---|
 | 2396 | test interp-29.1.3 {interp recursionlimit argument checking} { | 
|---|
 | 2397 |     list [catch {interp recursionlimit foo bar baz} msg] $msg | 
|---|
 | 2398 | } {1 {wrong # args: should be "interp recursionlimit path ?newlimit?"}} | 
|---|
 | 2399 |  | 
|---|
 | 2400 | test interp-29.1.4 {interp recursionlimit argument checking} { | 
|---|
 | 2401 |     interp create moo | 
|---|
 | 2402 |     set result [catch {interp recursionlimit moo bar} msg] | 
|---|
 | 2403 |     interp delete moo | 
|---|
 | 2404 |     list $result $msg | 
|---|
 | 2405 | } {1 {expected integer but got "bar"}} | 
|---|
 | 2406 |  | 
|---|
 | 2407 | test interp-29.1.5 {interp recursionlimit argument checking} { | 
|---|
 | 2408 |     interp create moo | 
|---|
 | 2409 |     set result [catch {interp recursionlimit moo 0} msg] | 
|---|
 | 2410 |     interp delete moo | 
|---|
 | 2411 |     list $result $msg | 
|---|
 | 2412 | } {1 {recursion limit must be > 0}} | 
|---|
 | 2413 |  | 
|---|
 | 2414 | test interp-29.1.6 {interp recursionlimit argument checking} { | 
|---|
 | 2415 |     interp create moo | 
|---|
 | 2416 |     set result [catch {interp recursionlimit moo -1} msg] | 
|---|
 | 2417 |     interp delete moo | 
|---|
 | 2418 |     list $result $msg | 
|---|
 | 2419 | } {1 {recursion limit must be > 0}} | 
|---|
 | 2420 |  | 
|---|
 | 2421 | test interp-29.1.7 {interp recursionlimit argument checking} { | 
|---|
 | 2422 |     interp create moo | 
|---|
 | 2423 |     set result [catch {interp recursionlimit moo [expr {wide(1)<<32}]} msg] | 
|---|
 | 2424 |     interp delete moo | 
|---|
 | 2425 |     list $result [string range $msg 0 35] | 
|---|
 | 2426 | } {1 {integer value too large to represent}} | 
|---|
 | 2427 |  | 
|---|
 | 2428 | test interp-29.1.8 {slave recursionlimit argument checking} { | 
|---|
 | 2429 |     interp create moo | 
|---|
 | 2430 |     set result [catch {moo recursionlimit foo bar} msg] | 
|---|
 | 2431 |     interp delete moo | 
|---|
 | 2432 |     list $result $msg | 
|---|
 | 2433 | } {1 {wrong # args: should be "moo recursionlimit ?newlimit?"}} | 
|---|
 | 2434 |  | 
|---|
 | 2435 | test interp-29.1.9 {slave recursionlimit argument checking} { | 
|---|
 | 2436 |     interp create moo | 
|---|
 | 2437 |     set result [catch {moo recursionlimit foo} msg] | 
|---|
 | 2438 |     interp delete moo | 
|---|
 | 2439 |     list $result $msg | 
|---|
 | 2440 | } {1 {expected integer but got "foo"}} | 
|---|
 | 2441 |  | 
|---|
 | 2442 | test interp-29.1.10 {slave recursionlimit argument checking} { | 
|---|
 | 2443 |     interp create moo | 
|---|
 | 2444 |     set result [catch {moo recursionlimit 0} msg] | 
|---|
 | 2445 |     interp delete moo | 
|---|
 | 2446 |     list $result $msg | 
|---|
 | 2447 | } {1 {recursion limit must be > 0}} | 
|---|
 | 2448 |  | 
|---|
 | 2449 | test interp-29.1.11 {slave recursionlimit argument checking} { | 
|---|
 | 2450 |     interp create moo | 
|---|
 | 2451 |     set result [catch {moo recursionlimit -1} msg] | 
|---|
 | 2452 |     interp delete moo | 
|---|
 | 2453 |     list $result $msg | 
|---|
 | 2454 | } {1 {recursion limit must be > 0}} | 
|---|
 | 2455 |  | 
|---|
 | 2456 | test interp-29.1.12 {slave recursionlimit argument checking} { | 
|---|
 | 2457 |     interp create moo | 
|---|
 | 2458 |     set result [catch {moo recursionlimit [expr {wide(1)<<32}]} msg] | 
|---|
 | 2459 |     interp delete moo | 
|---|
 | 2460 |     list $result [string range $msg 0 35] | 
|---|
 | 2461 | } {1 {integer value too large to represent}} | 
|---|
 | 2462 |  | 
|---|
 | 2463 | test interp-29.2.1 {query recursion limit} { | 
|---|
 | 2464 |     interp recursionlimit {} | 
|---|
 | 2465 | } 1000 | 
|---|
 | 2466 |  | 
|---|
 | 2467 | test interp-29.2.2 {query recursion limit} { | 
|---|
 | 2468 |     set i [interp create] | 
|---|
 | 2469 |     set n [interp recursionlimit $i] | 
|---|
 | 2470 |     interp delete $i | 
|---|
 | 2471 |     set n | 
|---|
 | 2472 | } 1000 | 
|---|
 | 2473 |  | 
|---|
 | 2474 | test interp-29.2.3 {query recursion limit} { | 
|---|
 | 2475 |     set i [interp create] | 
|---|
 | 2476 |     set n [$i recursionlimit] | 
|---|
 | 2477 |     interp delete $i | 
|---|
 | 2478 |     set n | 
|---|
 | 2479 | } 1000 | 
|---|
 | 2480 |  | 
|---|
 | 2481 | test interp-29.2.4 {query recursion limit} { | 
|---|
 | 2482 |     set i [interp create] | 
|---|
 | 2483 |     set r [$i eval { | 
|---|
 | 2484 |         set n1 [interp recursionlimit {} 42] | 
|---|
 | 2485 |         set n2 [interp recursionlimit {}] | 
|---|
 | 2486 |         list $n1 $n2 | 
|---|
 | 2487 |     }] | 
|---|
 | 2488 |     interp delete $i | 
|---|
 | 2489 |     set r | 
|---|
 | 2490 | } {42 42} | 
|---|
 | 2491 |  | 
|---|
 | 2492 | test interp-29.2.5 {query recursion limit} { | 
|---|
 | 2493 |     set i [interp create] | 
|---|
 | 2494 |     set n1 [interp recursionlimit $i 42] | 
|---|
 | 2495 |     set n2 [interp recursionlimit $i] | 
|---|
 | 2496 |     interp delete $i | 
|---|
 | 2497 |     list $n1 $n2 | 
|---|
 | 2498 | } {42 42} | 
|---|
 | 2499 |  | 
|---|
 | 2500 | test interp-29.2.6 {query recursion limit} { | 
|---|
 | 2501 |     set i [interp create] | 
|---|
 | 2502 |     set n1 [interp recursionlimit $i 42] | 
|---|
 | 2503 |     set n2 [$i recursionlimit] | 
|---|
 | 2504 |     interp delete $i | 
|---|
 | 2505 |     list $n1 $n2 | 
|---|
 | 2506 | } {42 42} | 
|---|
 | 2507 |  | 
|---|
 | 2508 | test interp-29.2.7 {query recursion limit} { | 
|---|
 | 2509 |     set i [interp create] | 
|---|
 | 2510 |     set n1 [$i recursionlimit 42] | 
|---|
 | 2511 |     set n2 [interp recursionlimit $i] | 
|---|
 | 2512 |     interp delete $i | 
|---|
 | 2513 |     list $n1 $n2 | 
|---|
 | 2514 | } {42 42} | 
|---|
 | 2515 |  | 
|---|
 | 2516 | test interp-29.2.8 {query recursion limit} { | 
|---|
 | 2517 |     set i [interp create] | 
|---|
 | 2518 |     set n1 [$i recursionlimit 42] | 
|---|
 | 2519 |     set n2 [$i recursionlimit] | 
|---|
 | 2520 |     interp delete $i | 
|---|
 | 2521 |     list $n1 $n2 | 
|---|
 | 2522 | } {42 42} | 
|---|
 | 2523 |  | 
|---|
 | 2524 | test interp-29.3.1 {recursion limit} { | 
|---|
 | 2525 |     set i [interp create] | 
|---|
 | 2526 |     set r [interp eval $i { | 
|---|
 | 2527 |         interp recursionlimit {} 50 | 
|---|
 | 2528 |         proc p {} {incr ::i; p} | 
|---|
 | 2529 |         set i 0 | 
|---|
 | 2530 |         list [catch p msg] $msg $i | 
|---|
 | 2531 |     }] | 
|---|
 | 2532 |     interp delete $i | 
|---|
 | 2533 |     set r | 
|---|
 | 2534 | } {1 {too many nested evaluations (infinite loop?)} 48} | 
|---|
 | 2535 |  | 
|---|
 | 2536 | test interp-29.3.2 {recursion limit} { | 
|---|
 | 2537 |     set i [interp create] | 
|---|
 | 2538 |     interp recursionlimit $i 50 | 
|---|
 | 2539 |     set r [interp eval $i { | 
|---|
 | 2540 |         proc p {} {incr ::i; p} | 
|---|
 | 2541 |         set i 0 | 
|---|
 | 2542 |         list [catch p msg] $msg $i | 
|---|
 | 2543 |     }] | 
|---|
 | 2544 |    interp delete $i | 
|---|
 | 2545 |    set r | 
|---|
 | 2546 | } {1 {too many nested evaluations (infinite loop?)} 48} | 
|---|
 | 2547 |  | 
|---|
 | 2548 | test interp-29.3.3 {recursion limit} { | 
|---|
 | 2549 |     set i [interp create] | 
|---|
 | 2550 |     $i recursionlimit 50 | 
|---|
 | 2551 |     set r [interp eval $i { | 
|---|
 | 2552 |         proc p {} {incr ::i; p} | 
|---|
 | 2553 |         set i 0 | 
|---|
 | 2554 |         list [catch p msg] $msg $i | 
|---|
 | 2555 |     }] | 
|---|
 | 2556 |    interp delete $i | 
|---|
 | 2557 |    set r | 
|---|
 | 2558 | } {1 {too many nested evaluations (infinite loop?)} 48} | 
|---|
 | 2559 |  | 
|---|
 | 2560 | test interp-29.3.4 {recursion limit error reporting} { | 
|---|
 | 2561 |     interp create slave | 
|---|
 | 2562 |     set r1 [slave eval { | 
|---|
 | 2563 |         catch {                 # nesting level 1 | 
|---|
 | 2564 |             eval {              # 2 | 
|---|
 | 2565 |                 eval {          # 3 | 
|---|
 | 2566 |                     eval {      # 4 | 
|---|
 | 2567 |                         eval {  # 5 | 
|---|
 | 2568 |                              interp recursionlimit {} 5 | 
|---|
 | 2569 |                              set x ok | 
|---|
 | 2570 |                         } | 
|---|
 | 2571 |                     } | 
|---|
 | 2572 |                 } | 
|---|
 | 2573 |             } | 
|---|
 | 2574 |         } msg | 
|---|
 | 2575 |     }] | 
|---|
 | 2576 |     set r2 [slave eval { set msg }] | 
|---|
 | 2577 |     interp delete slave | 
|---|
 | 2578 |     list $r1 $r2 | 
|---|
 | 2579 | } {1 {falling back due to new recursion limit}} | 
|---|
 | 2580 |  | 
|---|
 | 2581 | test interp-29.3.5 {recursion limit error reporting} { | 
|---|
 | 2582 |     interp create slave | 
|---|
 | 2583 |     set r1 [slave eval { | 
|---|
 | 2584 |         catch {                 # nesting level 1 | 
|---|
 | 2585 |             eval {              # 2 | 
|---|
 | 2586 |                 eval {          # 3 | 
|---|
 | 2587 |                     eval {      # 4 | 
|---|
 | 2588 |                         eval {  # 5 | 
|---|
 | 2589 |                             interp recursionlimit {} 4 | 
|---|
 | 2590 |                             set x ok | 
|---|
 | 2591 |                         } | 
|---|
 | 2592 |                     } | 
|---|
 | 2593 |                 } | 
|---|
 | 2594 |             } | 
|---|
 | 2595 |         } msg | 
|---|
 | 2596 |     }] | 
|---|
 | 2597 |     set r2 [slave eval { set msg }] | 
|---|
 | 2598 |     interp delete slave | 
|---|
 | 2599 |     list $r1 $r2 | 
|---|
 | 2600 | } {1 {falling back due to new recursion limit}} | 
|---|
 | 2601 |  | 
|---|
 | 2602 | test interp-29.3.6 {recursion limit error reporting} { | 
|---|
 | 2603 |     interp create slave | 
|---|
 | 2604 |     set r1 [slave eval { | 
|---|
 | 2605 |         catch {                 # nesting level 1 | 
|---|
 | 2606 |             eval {              # 2 | 
|---|
 | 2607 |                 eval {          # 3 | 
|---|
 | 2608 |                     eval {      # 4 | 
|---|
 | 2609 |                         eval {  # 5 | 
|---|
 | 2610 |                             interp recursionlimit {} 6 | 
|---|
 | 2611 |                             set x ok | 
|---|
 | 2612 |                         } | 
|---|
 | 2613 |                     } | 
|---|
 | 2614 |                 } | 
|---|
 | 2615 |             } | 
|---|
 | 2616 |         } msg | 
|---|
 | 2617 |     }] | 
|---|
 | 2618 |     set r2 [slave eval { set msg }] | 
|---|
 | 2619 |     interp delete slave | 
|---|
 | 2620 |     list $r1 $r2 | 
|---|
 | 2621 | } {0 ok} | 
|---|
 | 2622 |  | 
|---|
 | 2623 | test interp-29.3.7 {recursion limit error reporting} { | 
|---|
 | 2624 |     interp create slave | 
|---|
 | 2625 |     after 0 {interp recursionlimit slave 5} | 
|---|
 | 2626 |     set r1 [slave eval { | 
|---|
 | 2627 |         catch {                 # nesting level 1 | 
|---|
 | 2628 |             eval {              # 2 | 
|---|
 | 2629 |                 eval {          # 3 | 
|---|
 | 2630 |                     eval {      # 4 | 
|---|
 | 2631 |                         eval {  # 5 | 
|---|
 | 2632 |                              update | 
|---|
 | 2633 |                              set x ok | 
|---|
 | 2634 |                         } | 
|---|
 | 2635 |                     } | 
|---|
 | 2636 |                 } | 
|---|
 | 2637 |             } | 
|---|
 | 2638 |         } msg | 
|---|
 | 2639 |     }] | 
|---|
 | 2640 |     set r2 [slave eval { set msg }] | 
|---|
 | 2641 |     interp delete slave | 
|---|
 | 2642 |     list $r1 $r2 | 
|---|
 | 2643 | } {1 {too many nested evaluations (infinite loop?)}} | 
|---|
 | 2644 |  | 
|---|
 | 2645 | test interp-29.3.8 {recursion limit error reporting} { | 
|---|
 | 2646 |     interp create slave | 
|---|
 | 2647 |     after 0 {interp recursionlimit slave 4} | 
|---|
 | 2648 |     set r1 [slave eval { | 
|---|
 | 2649 |         catch {                 # nesting level 1 | 
|---|
 | 2650 |             eval {              # 2 | 
|---|
 | 2651 |                 eval {          # 3 | 
|---|
 | 2652 |                     eval {      # 4 | 
|---|
 | 2653 |                         eval {  # 5 | 
|---|
 | 2654 |                              update | 
|---|
 | 2655 |                              set x ok | 
|---|
 | 2656 |                         } | 
|---|
 | 2657 |                     } | 
|---|
 | 2658 |                 } | 
|---|
 | 2659 |             } | 
|---|
 | 2660 |         } msg | 
|---|
 | 2661 |     }] | 
|---|
 | 2662 |     set r2 [slave eval { set msg }] | 
|---|
 | 2663 |     interp delete slave | 
|---|
 | 2664 |     list $r1 $r2 | 
|---|
 | 2665 | } {1 {too many nested evaluations (infinite loop?)}} | 
|---|
 | 2666 |  | 
|---|
 | 2667 | test interp-29.3.9 {recursion limit error reporting} { | 
|---|
 | 2668 |     interp create slave | 
|---|
 | 2669 |     after 0 {interp recursionlimit slave 6} | 
|---|
 | 2670 |     set r1 [slave eval { | 
|---|
 | 2671 |         catch {                 # nesting level 1 | 
|---|
 | 2672 |             eval {              # 2 | 
|---|
 | 2673 |                 eval {          # 3 | 
|---|
 | 2674 |                     eval {      # 4 | 
|---|
 | 2675 |                         eval {  # 5 | 
|---|
 | 2676 |                              update | 
|---|
 | 2677 |                              set x ok | 
|---|
 | 2678 |                         } | 
|---|
 | 2679 |                     } | 
|---|
 | 2680 |                 } | 
|---|
 | 2681 |             } | 
|---|
 | 2682 |         } msg | 
|---|
 | 2683 |     }] | 
|---|
 | 2684 |     set r2 [slave eval { set msg }] | 
|---|
 | 2685 |     interp delete slave | 
|---|
 | 2686 |     list $r1 $r2 | 
|---|
 | 2687 | } {0 ok} | 
|---|
 | 2688 |  | 
|---|
 | 2689 | test interp-29.3.10 {recursion limit error reporting} { | 
|---|
 | 2690 |     interp create slave | 
|---|
 | 2691 |     after 0 {slave recursionlimit 4} | 
|---|
 | 2692 |     set r1 [slave eval { | 
|---|
 | 2693 |         catch {                 # nesting level 1 | 
|---|
 | 2694 |             eval {              # 2 | 
|---|
 | 2695 |                 eval {          # 3 | 
|---|
 | 2696 |                     eval {      # 4 | 
|---|
 | 2697 |                         eval {  # 5 | 
|---|
 | 2698 |                              update | 
|---|
 | 2699 |                              set x ok | 
|---|
 | 2700 |                         } | 
|---|
 | 2701 |                     } | 
|---|
 | 2702 |                 } | 
|---|
 | 2703 |             } | 
|---|
 | 2704 |         } msg | 
|---|
 | 2705 |     }] | 
|---|
 | 2706 |     set r2 [slave eval { set msg }] | 
|---|
 | 2707 |     interp delete slave | 
|---|
 | 2708 |     list $r1 $r2 | 
|---|
 | 2709 | } {1 {too many nested evaluations (infinite loop?)}} | 
|---|
 | 2710 |  | 
|---|
 | 2711 | test interp-29.3.11 {recursion limit error reporting} { | 
|---|
 | 2712 |     interp create slave | 
|---|
 | 2713 |     after 0 {slave recursionlimit 5} | 
|---|
 | 2714 |     set r1 [slave eval { | 
|---|
 | 2715 |         catch {                 # nesting level 1 | 
|---|
 | 2716 |             eval {              # 2 | 
|---|
 | 2717 |                 eval {          # 3 | 
|---|
 | 2718 |                     eval {      # 4 | 
|---|
 | 2719 |                         eval {  # 5 | 
|---|
 | 2720 |                              update | 
|---|
 | 2721 |                              set x ok | 
|---|
 | 2722 |                         } | 
|---|
 | 2723 |                     } | 
|---|
 | 2724 |                 } | 
|---|
 | 2725 |             } | 
|---|
 | 2726 |         } msg | 
|---|
 | 2727 |     }] | 
|---|
 | 2728 |     set r2 [slave eval { set msg }] | 
|---|
 | 2729 |     interp delete slave | 
|---|
 | 2730 |     list $r1 $r2 | 
|---|
 | 2731 | } {1 {too many nested evaluations (infinite loop?)}} | 
|---|
 | 2732 |  | 
|---|
 | 2733 | test interp-29.3.12 {recursion limit error reporting} { | 
|---|
 | 2734 |     interp create slave | 
|---|
 | 2735 |     after 0 {slave recursionlimit 6} | 
|---|
 | 2736 |     set r1 [slave eval { | 
|---|
 | 2737 |         catch {                 # nesting level 1 | 
|---|
 | 2738 |             eval {              # 2 | 
|---|
 | 2739 |                 eval {          # 3 | 
|---|
 | 2740 |                     eval {      # 4 | 
|---|
 | 2741 |                         eval {  # 5 | 
|---|
 | 2742 |                              update | 
|---|
 | 2743 |                              set x ok | 
|---|
 | 2744 |                         } | 
|---|
 | 2745 |                     } | 
|---|
 | 2746 |                 } | 
|---|
 | 2747 |             } | 
|---|
 | 2748 |         } msg | 
|---|
 | 2749 |     }] | 
|---|
 | 2750 |     set r2 [slave eval { set msg }] | 
|---|
 | 2751 |     interp delete slave | 
|---|
 | 2752 |     list $r1 $r2 | 
|---|
 | 2753 | } {0 ok} | 
|---|
 | 2754 |  | 
|---|
 | 2755 | test interp-29.4.1 {recursion limit inheritance} { | 
|---|
 | 2756 |     set i [interp create] | 
|---|
 | 2757 |     set ii [interp eval $i { | 
|---|
 | 2758 |         interp recursionlimit {} 50 | 
|---|
 | 2759 |         interp create | 
|---|
 | 2760 |     }] | 
|---|
 | 2761 |     set r [interp eval [list $i $ii] { | 
|---|
 | 2762 |         proc p {} {incr ::i; p} | 
|---|
 | 2763 |         set i 0 | 
|---|
 | 2764 |         catch p | 
|---|
 | 2765 |         set i | 
|---|
 | 2766 |     }] | 
|---|
 | 2767 |    interp delete $i | 
|---|
 | 2768 |    set r | 
|---|
 | 2769 | } 49 | 
|---|
 | 2770 |  | 
|---|
 | 2771 | test interp-29.4.2 {recursion limit inheritance} { | 
|---|
 | 2772 |     set i [interp create] | 
|---|
 | 2773 |     $i recursionlimit 50 | 
|---|
 | 2774 |     set ii [interp eval $i {interp create}] | 
|---|
 | 2775 |     set r [interp eval [list $i $ii] { | 
|---|
 | 2776 |         proc p {} {incr ::i; p} | 
|---|
 | 2777 |         set i 0 | 
|---|
 | 2778 |         catch p | 
|---|
 | 2779 |         set i | 
|---|
 | 2780 |     }] | 
|---|
 | 2781 |    interp delete $i | 
|---|
 | 2782 |    set r | 
|---|
 | 2783 | } 49 | 
|---|
 | 2784 |  | 
|---|
 | 2785 | test interp-29.5.1 {does slave recursion limit affect master?} { | 
|---|
 | 2786 |     set before [interp recursionlimit {}] | 
|---|
 | 2787 |     set i [interp create] | 
|---|
 | 2788 |     interp recursionlimit $i 20000 | 
|---|
 | 2789 |     set after [interp recursionlimit {}] | 
|---|
 | 2790 |     set slavelimit [interp recursionlimit $i] | 
|---|
 | 2791 |     interp delete $i | 
|---|
 | 2792 |     list [expr {$before == $after}] $slavelimit | 
|---|
 | 2793 | } {1 20000} | 
|---|
 | 2794 |  | 
|---|
 | 2795 | test interp-29.5.2 {does slave recursion limit affect master?} { | 
|---|
 | 2796 |     set before [interp recursionlimit {}] | 
|---|
 | 2797 |     set i [interp create] | 
|---|
 | 2798 |     interp recursionlimit $i 20000 | 
|---|
 | 2799 |     set after [interp recursionlimit {}] | 
|---|
 | 2800 |     set slavelimit [$i recursionlimit] | 
|---|
 | 2801 |     interp delete $i | 
|---|
 | 2802 |     list [expr {$before == $after}] $slavelimit | 
|---|
 | 2803 | } {1 20000} | 
|---|
 | 2804 |  | 
|---|
 | 2805 | test interp-29.5.3 {does slave recursion limit affect master?} { | 
|---|
 | 2806 |     set before [interp recursionlimit {}] | 
|---|
 | 2807 |     set i [interp create] | 
|---|
 | 2808 |     $i recursionlimit 20000 | 
|---|
 | 2809 |     set after [interp recursionlimit {}] | 
|---|
 | 2810 |     set slavelimit [interp recursionlimit $i] | 
|---|
 | 2811 |     interp delete $i | 
|---|
 | 2812 |     list [expr {$before == $after}] $slavelimit | 
|---|
 | 2813 | } {1 20000} | 
|---|
 | 2814 |  | 
|---|
 | 2815 | test interp-29.5.4 {does slave recursion limit affect master?} { | 
|---|
 | 2816 |     set before [interp recursionlimit {}] | 
|---|
 | 2817 |     set i [interp create] | 
|---|
 | 2818 |     $i recursionlimit 20000 | 
|---|
 | 2819 |     set after [interp recursionlimit {}] | 
|---|
 | 2820 |     set slavelimit [$i recursionlimit] | 
|---|
 | 2821 |     interp delete $i | 
|---|
 | 2822 |     list [expr {$before == $after}] $slavelimit | 
|---|
 | 2823 | } {1 20000} | 
|---|
 | 2824 |  | 
|---|
 | 2825 | test interp-29.6.1 {safe interpreter recursion limit} { | 
|---|
 | 2826 |     interp create slave -safe | 
|---|
 | 2827 |     set n [interp recursionlimit slave] | 
|---|
 | 2828 |     interp delete slave | 
|---|
 | 2829 |     set n | 
|---|
 | 2830 | } 1000 | 
|---|
 | 2831 |  | 
|---|
 | 2832 | test interp-29.6.2 {safe interpreter recursion limit} { | 
|---|
 | 2833 |     interp create slave -safe | 
|---|
 | 2834 |     set n [slave recursionlimit] | 
|---|
 | 2835 |     interp delete slave | 
|---|
 | 2836 |     set n | 
|---|
 | 2837 | } 1000 | 
|---|
 | 2838 |  | 
|---|
 | 2839 | test interp-29.6.3 {safe interpreter recursion limit} { | 
|---|
 | 2840 |     interp create slave -safe | 
|---|
 | 2841 |     set n1 [interp recursionlimit slave 42] | 
|---|
 | 2842 |     set n2 [interp recursionlimit slave] | 
|---|
 | 2843 |     interp delete slave | 
|---|
 | 2844 |     list $n1 $n2 | 
|---|
 | 2845 | } {42 42} | 
|---|
 | 2846 |  | 
|---|
 | 2847 | test interp-29.6.4 {safe interpreter recursion limit} { | 
|---|
 | 2848 |     interp create slave -safe | 
|---|
 | 2849 |     set n1 [slave recursionlimit 42] | 
|---|
 | 2850 |     set n2 [interp recursionlimit slave] | 
|---|
 | 2851 |     interp delete slave | 
|---|
 | 2852 |     list $n1 $n2 | 
|---|
 | 2853 | } {42 42} | 
|---|
 | 2854 |  | 
|---|
 | 2855 | test interp-29.6.5 {safe interpreter recursion limit} { | 
|---|
 | 2856 |     interp create slave -safe | 
|---|
 | 2857 |     set n1 [interp recursionlimit slave 42] | 
|---|
 | 2858 |     set n2 [slave recursionlimit] | 
|---|
 | 2859 |     interp delete slave | 
|---|
 | 2860 |     list $n1 $n2 | 
|---|
 | 2861 | } {42 42} | 
|---|
 | 2862 |  | 
|---|
 | 2863 | test interp-29.6.6 {safe interpreter recursion limit} { | 
|---|
 | 2864 |     interp create slave -safe | 
|---|
 | 2865 |     set n1 [slave recursionlimit 42] | 
|---|
 | 2866 |     set n2 [slave recursionlimit] | 
|---|
 | 2867 |     interp delete slave | 
|---|
 | 2868 |     list $n1 $n2 | 
|---|
 | 2869 | } {42 42} | 
|---|
 | 2870 |  | 
|---|
 | 2871 | test interp-29.6.7 {safe interpreter recursion limit} { | 
|---|
 | 2872 |     interp create slave -safe | 
|---|
 | 2873 |     set n1 [slave recursionlimit 42] | 
|---|
 | 2874 |     set n2 [slave recursionlimit] | 
|---|
 | 2875 |     interp delete slave | 
|---|
 | 2876 |     list $n1 $n2 | 
|---|
 | 2877 | } {42 42} | 
|---|
 | 2878 |  | 
|---|
 | 2879 | test interp-29.6.8 {safe interpreter recursion limit} { | 
|---|
 | 2880 |     interp create slave -safe | 
|---|
 | 2881 |     set n [catch {slave eval {interp recursionlimit {} 42}} msg] | 
|---|
 | 2882 |     interp delete slave | 
|---|
 | 2883 |     list $n $msg | 
|---|
 | 2884 | } {1 {permission denied: safe interpreters cannot change recursion limit}} | 
|---|
 | 2885 |  | 
|---|
 | 2886 | test interp-29.6.9 {safe interpreter recursion limit} { | 
|---|
 | 2887 |     interp create slave -safe | 
|---|
 | 2888 |     set result [ | 
|---|
 | 2889 |         slave eval { | 
|---|
 | 2890 |             interp create slave2 -safe | 
|---|
 | 2891 |             set n [catch { | 
|---|
 | 2892 |                 interp recursionlimit slave2 42 | 
|---|
 | 2893 |             } msg] | 
|---|
 | 2894 |             list $n $msg | 
|---|
 | 2895 |         } | 
|---|
 | 2896 |     ] | 
|---|
 | 2897 |     interp delete slave | 
|---|
 | 2898 |     set result | 
|---|
 | 2899 | } {1 {permission denied: safe interpreters cannot change recursion limit}} | 
|---|
 | 2900 |  | 
|---|
 | 2901 | test interp-29.6.10 {safe interpreter recursion limit} { | 
|---|
 | 2902 |     interp create slave -safe | 
|---|
 | 2903 |     set result [ | 
|---|
 | 2904 |         slave eval { | 
|---|
 | 2905 |             interp create slave2 -safe | 
|---|
 | 2906 |             set n [catch { | 
|---|
 | 2907 |                 slave2 recursionlimit 42 | 
|---|
 | 2908 |             } msg] | 
|---|
 | 2909 |             list $n $msg | 
|---|
 | 2910 |         } | 
|---|
 | 2911 |     ] | 
|---|
 | 2912 |     interp delete slave | 
|---|
 | 2913 |     set result | 
|---|
 | 2914 | } {1 {permission denied: safe interpreters cannot change recursion limit}} | 
|---|
 | 2915 |  | 
|---|
 | 2916 |  | 
|---|
 | 2917 | #    # Deep recursion (into interps when the regular one fails): | 
|---|
 | 2918 | #    # still crashes... | 
|---|
 | 2919 | #    proc p {} { | 
|---|
 | 2920 | #       if {[catch p ret]} { | 
|---|
 | 2921 | #           catch { | 
|---|
 | 2922 | #               set i [interp create] | 
|---|
 | 2923 | #               interp eval $i [list proc p {} [info body p]] | 
|---|
 | 2924 | #               interp eval $i p | 
|---|
 | 2925 | #           } | 
|---|
 | 2926 | #           interp delete $i | 
|---|
 | 2927 | #           return ok | 
|---|
 | 2928 | #       } | 
|---|
 | 2929 | #       return $ret | 
|---|
 | 2930 | #    } | 
|---|
 | 2931 | #    p | 
|---|
 | 2932 |  | 
|---|
 | 2933 | # more tests needed... | 
|---|
 | 2934 |  | 
|---|
 | 2935 | # Interp & stack | 
|---|
 | 2936 | #test interp-29.1 {interp and stack (info level)} { | 
|---|
 | 2937 | #} {} | 
|---|
 | 2938 |  | 
|---|
 | 2939 | # End of stack-recursion tests | 
|---|
 | 2940 |  | 
|---|
 | 2941 | # This test dumps core in Tcl 8.0.3! | 
|---|
 | 2942 | test interp-30.1 {deletion of aliases inside namespaces} { | 
|---|
 | 2943 |     set i [interp create] | 
|---|
 | 2944 |     $i alias ns::cmd list | 
|---|
 | 2945 |     $i alias ns::cmd {} | 
|---|
 | 2946 | } {} | 
|---|
 | 2947 |  | 
|---|
 | 2948 | test interp-31.1 {alias invocation scope} { | 
|---|
 | 2949 |     proc mySet {varName value} { | 
|---|
 | 2950 |         upvar 1 $varName localVar | 
|---|
 | 2951 |         set localVar $value | 
|---|
 | 2952 |     } | 
|---|
 | 2953 |  | 
|---|
 | 2954 |     interp alias {} myNewSet {} mySet | 
|---|
 | 2955 |     proc testMyNewSet {value} { | 
|---|
 | 2956 |         myNewSet a $value | 
|---|
 | 2957 |         return $a | 
|---|
 | 2958 |     } | 
|---|
 | 2959 |     catch {unset a} | 
|---|
 | 2960 |     set result [testMyNewSet "ok"] | 
|---|
 | 2961 |     rename testMyNewSet {} | 
|---|
 | 2962 |     rename mySet {} | 
|---|
 | 2963 |     rename myNewSet {} | 
|---|
 | 2964 |     set result | 
|---|
 | 2965 | } ok | 
|---|
 | 2966 |  | 
|---|
 | 2967 | test interp-32.1 {parent's working directory should be inherited by a child interp} { | 
|---|
 | 2968 |     cd [temporaryDirectory] | 
|---|
 | 2969 |     set parent [pwd] | 
|---|
 | 2970 |     set i [interp create] | 
|---|
 | 2971 |     set child [$i eval pwd] | 
|---|
 | 2972 |     interp delete $i | 
|---|
 | 2973 |     file mkdir cwd_test | 
|---|
 | 2974 |     cd cwd_test | 
|---|
 | 2975 |     lappend parent [pwd] | 
|---|
 | 2976 |     set i [interp create] | 
|---|
 | 2977 |     lappend child [$i eval pwd] | 
|---|
 | 2978 |     cd .. | 
|---|
 | 2979 |     file delete cwd_test | 
|---|
 | 2980 |     interp delete $i | 
|---|
 | 2981 |     cd [workingDirectory] | 
|---|
 | 2982 |     expr {[string equal $parent $child] ? 1 : | 
|---|
 | 2983 |              "\{$parent\} != \{$child\}"} | 
|---|
 | 2984 | } 1 | 
|---|
 | 2985 |  | 
|---|
 | 2986 | test interp-33.1 {refCounting for target words of alias [Bug 730244]} { | 
|---|
 | 2987 |     # This test will panic if Bug 730244 is not fixed. | 
|---|
 | 2988 |     set i [interp create] | 
|---|
 | 2989 |     proc testHelper args {rename testHelper {}; return $args} | 
|---|
 | 2990 |     # Note: interp names are simple words by default | 
|---|
 | 2991 |     trace add execution testHelper enter "interp alias $i alias {} ;#" | 
|---|
 | 2992 |     interp alias $i alias {} testHelper this | 
|---|
 | 2993 |     $i eval alias | 
|---|
 | 2994 | } this | 
|---|
 | 2995 |  | 
|---|
 | 2996 | test interp-34.1 {basic test of limits - calling commands} -body { | 
|---|
 | 2997 |     set i [interp create] | 
|---|
 | 2998 |     $i eval { | 
|---|
 | 2999 |         proc foobar {} { | 
|---|
 | 3000 |             for {set x 0} {$x<1000000} {incr x} { | 
|---|
 | 3001 |                 # Calls to this are not bytecoded away | 
|---|
 | 3002 |                 pid | 
|---|
 | 3003 |             } | 
|---|
 | 3004 |         } | 
|---|
 | 3005 |     } | 
|---|
 | 3006 |     $i limit command -value 1000 | 
|---|
 | 3007 |     $i eval foobar | 
|---|
 | 3008 | } -returnCodes error -result {command count limit exceeded} -cleanup { | 
|---|
 | 3009 |     interp delete $i | 
|---|
 | 3010 | } | 
|---|
 | 3011 | test interp-34.2 {basic test of limits - bytecoded commands} -body { | 
|---|
 | 3012 |     set i [interp create] | 
|---|
 | 3013 |     $i eval { | 
|---|
 | 3014 |         proc foobar {} { | 
|---|
 | 3015 |             for {set x 0} {$x<1000000} {incr x} { | 
|---|
 | 3016 |                 # Calls to this *are* bytecoded away | 
|---|
 | 3017 |                 expr {1+2+3} | 
|---|
 | 3018 |             } | 
|---|
 | 3019 |         } | 
|---|
 | 3020 |     } | 
|---|
 | 3021 |     $i limit command -value 1000 | 
|---|
 | 3022 |     $i eval foobar | 
|---|
 | 3023 | } -returnCodes error -result {command count limit exceeded} -cleanup { | 
|---|
 | 3024 |     interp delete $i | 
|---|
 | 3025 | } | 
|---|
 | 3026 | test interp-34.3 {basic test of limits - pure bytecode loop} -body { | 
|---|
 | 3027 |     set i [interp create] | 
|---|
 | 3028 |     $i eval { | 
|---|
 | 3029 |         proc foobar {} { | 
|---|
 | 3030 |             while {1} { | 
|---|
 | 3031 |                 # No bytecode at all here... | 
|---|
 | 3032 |             } | 
|---|
 | 3033 |         } | 
|---|
 | 3034 |     } | 
|---|
 | 3035 |     # We use a time limit here; command limits don't trap this case | 
|---|
 | 3036 |     $i limit time -seconds [expr {[clock seconds]+2}] | 
|---|
 | 3037 |     $i eval foobar | 
|---|
 | 3038 | } -returnCodes error -result {time limit exceeded} -cleanup { | 
|---|
 | 3039 |     interp delete $i | 
|---|
 | 3040 | } | 
|---|
 | 3041 | test interp-34.3.1 {basic test of limits - pure inside-command loop} -body { | 
|---|
 | 3042 |     set i [interp create] | 
|---|
 | 3043 |     $i eval { | 
|---|
 | 3044 |         proc foobar {} { | 
|---|
 | 3045 |             set while while | 
|---|
 | 3046 |             $while {1} { | 
|---|
 | 3047 |                 # No bytecode at all here... | 
|---|
 | 3048 |             } | 
|---|
 | 3049 |         } | 
|---|
 | 3050 |     } | 
|---|
 | 3051 |     # We use a time limit here; command limits don't trap this case | 
|---|
 | 3052 |     $i limit time -seconds [expr {[clock seconds]+2}] | 
|---|
 | 3053 |     $i eval foobar | 
|---|
 | 3054 | } -returnCodes error -result {time limit exceeded} -cleanup { | 
|---|
 | 3055 |     interp delete $i | 
|---|
 | 3056 | } | 
|---|
 | 3057 | test interp-34.4 {limits with callbacks: extending limits} -setup { | 
|---|
 | 3058 |     set i [interp create] | 
|---|
 | 3059 |     set a 0 | 
|---|
 | 3060 |     set b 0 | 
|---|
 | 3061 |     set c a | 
|---|
 | 3062 |     proc cb1 {} { | 
|---|
 | 3063 |         global c | 
|---|
 | 3064 |         incr ::$c | 
|---|
 | 3065 |     } | 
|---|
 | 3066 |     proc cb2 {newlimit args} { | 
|---|
 | 3067 |         global c i | 
|---|
 | 3068 |         set c b | 
|---|
 | 3069 |         $i limit command -value $newlimit | 
|---|
 | 3070 |     } | 
|---|
 | 3071 | } -body { | 
|---|
 | 3072 |     interp alias $i foo {} cb1 | 
|---|
 | 3073 |     set curlim [$i eval info cmdcount] | 
|---|
 | 3074 |     $i limit command -command "cb2 [expr $curlim+100]" \ | 
|---|
 | 3075 |             -value [expr {$curlim+10}] | 
|---|
 | 3076 |     $i eval {for {set i 0} {$i<10} {incr i} {foo}} | 
|---|
 | 3077 |     list $a $b $c | 
|---|
 | 3078 | } -result {6 4 b} -cleanup { | 
|---|
 | 3079 |     interp delete $i | 
|---|
 | 3080 |     rename cb1 {} | 
|---|
 | 3081 |     rename cb2 {} | 
|---|
 | 3082 | } | 
|---|
 | 3083 | # The next three tests exercise all the three ways that limit handlers | 
|---|
 | 3084 | # can be deleted.  Fully verifying this requires additional source | 
|---|
 | 3085 | # code instrumentation. | 
|---|
 | 3086 | test interp-34.5 {limits with callbacks: removing limits} -setup { | 
|---|
 | 3087 |     set i [interp create] | 
|---|
 | 3088 |     set a 0 | 
|---|
 | 3089 |     set b 0 | 
|---|
 | 3090 |     set c a | 
|---|
 | 3091 |     proc cb1 {} { | 
|---|
 | 3092 |         global c | 
|---|
 | 3093 |         incr ::$c | 
|---|
 | 3094 |     } | 
|---|
 | 3095 |     proc cb2 {newlimit args} { | 
|---|
 | 3096 |         global c i | 
|---|
 | 3097 |         set c b | 
|---|
 | 3098 |         $i limit command -value $newlimit | 
|---|
 | 3099 |     } | 
|---|
 | 3100 | } -body { | 
|---|
 | 3101 |     interp alias $i foo {} cb1 | 
|---|
 | 3102 |     set curlim [$i eval info cmdcount] | 
|---|
 | 3103 |     $i limit command -command "cb2 {}" -value [expr {$curlim+10}] | 
|---|
 | 3104 |     $i eval {for {set i 0} {$i<10} {incr i} {foo}} | 
|---|
 | 3105 |     list $a $b $c | 
|---|
 | 3106 | } -result {6 4 b} -cleanup { | 
|---|
 | 3107 |     interp delete $i | 
|---|
 | 3108 |     rename cb1 {} | 
|---|
 | 3109 |     rename cb2 {} | 
|---|
 | 3110 | } | 
|---|
 | 3111 | test interp-34.6 {limits with callbacks: removing limits and handlers} -setup { | 
|---|
 | 3112 |     set i [interp create] | 
|---|
 | 3113 |     set a 0 | 
|---|
 | 3114 |     set b 0 | 
|---|
 | 3115 |     set c a | 
|---|
 | 3116 |     proc cb1 {} { | 
|---|
 | 3117 |         global c | 
|---|
 | 3118 |         incr ::$c | 
|---|
 | 3119 |     } | 
|---|
 | 3120 |     proc cb2 {args} { | 
|---|
 | 3121 |         global c i | 
|---|
 | 3122 |         set c b | 
|---|
 | 3123 |         $i limit command -value {} -command {} | 
|---|
 | 3124 |     } | 
|---|
 | 3125 | } -body { | 
|---|
 | 3126 |     interp alias $i foo {} cb1 | 
|---|
 | 3127 |     set curlim [$i eval info cmdcount] | 
|---|
 | 3128 |     $i limit command -command cb2 -value [expr {$curlim+10}] | 
|---|
 | 3129 |     $i eval {for {set i 0} {$i<10} {incr i} {foo}} | 
|---|
 | 3130 |     list $a $b $c | 
|---|
 | 3131 | } -result {6 4 b} -cleanup { | 
|---|
 | 3132 |     interp delete $i | 
|---|
 | 3133 |     rename cb1 {} | 
|---|
 | 3134 |     rename cb2 {} | 
|---|
 | 3135 | } | 
|---|
 | 3136 | test interp-34.7 {limits with callbacks: deleting the handler interp} -setup { | 
|---|
 | 3137 |     set i [interp create] | 
|---|
 | 3138 |     $i eval { | 
|---|
 | 3139 |         set i [interp create] | 
|---|
 | 3140 |         proc cb1 {} { | 
|---|
 | 3141 |             global c | 
|---|
 | 3142 |             incr ::$c | 
|---|
 | 3143 |         } | 
|---|
 | 3144 |         proc cb2 {args} { | 
|---|
 | 3145 |             global c i curlim | 
|---|
 | 3146 |             set c b | 
|---|
 | 3147 |             $i limit command -value [expr {$curlim+1000}] | 
|---|
 | 3148 |             trapToParent | 
|---|
 | 3149 |         } | 
|---|
 | 3150 |     } | 
|---|
 | 3151 |     proc cb3 {} { | 
|---|
 | 3152 |         global i subi | 
|---|
 | 3153 |         interp alias [list $i $subi] foo {} cb4 | 
|---|
 | 3154 |         interp delete $i | 
|---|
 | 3155 |     } | 
|---|
 | 3156 |     proc cb4 {} { | 
|---|
 | 3157 |         global n | 
|---|
 | 3158 |         incr n | 
|---|
 | 3159 |     } | 
|---|
 | 3160 | } -body { | 
|---|
 | 3161 |     set subi [$i eval set i] | 
|---|
 | 3162 |     interp alias $i trapToParent {} cb3 | 
|---|
 | 3163 |     set n 0 | 
|---|
 | 3164 |     $i eval { | 
|---|
 | 3165 |         set a 0 | 
|---|
 | 3166 |         set b 0 | 
|---|
 | 3167 |         set c a | 
|---|
 | 3168 |         interp alias $i foo {} cb1 | 
|---|
 | 3169 |         set curlim [$i eval info cmdcount] | 
|---|
 | 3170 |         $i limit command -command cb2 -value [expr {$curlim+10}] | 
|---|
 | 3171 |     } | 
|---|
 | 3172 |     $i eval { | 
|---|
 | 3173 |         $i eval { | 
|---|
 | 3174 |             for {set i 0} {$i<10} {incr i} {foo} | 
|---|
 | 3175 |         } | 
|---|
 | 3176 |     } | 
|---|
 | 3177 |     list $n [interp exists $i] | 
|---|
 | 3178 | } -result {4 0} -cleanup { | 
|---|
 | 3179 |     rename cb3 {} | 
|---|
 | 3180 |     rename cb4 {} | 
|---|
 | 3181 | } | 
|---|
 | 3182 | # Bug 1085023 | 
|---|
 | 3183 | test interp-34.8 {time limits trigger in vwaits} -body { | 
|---|
 | 3184 |     set i [interp create] | 
|---|
 | 3185 |     interp limit $i time -seconds [expr {[clock seconds]+1}] -granularity 1 | 
|---|
 | 3186 |     $i eval { | 
|---|
 | 3187 |         set x {} | 
|---|
 | 3188 |         vwait x | 
|---|
 | 3189 |     } | 
|---|
 | 3190 | } -cleanup { | 
|---|
 | 3191 |     interp delete $i | 
|---|
 | 3192 | } -returnCodes error -result {limit exceeded} | 
|---|
 | 3193 | test interp-34.9 {time limits trigger in blocking after} { | 
|---|
 | 3194 |     set i [interp create] | 
|---|
 | 3195 |     set t0 [clock seconds] | 
|---|
 | 3196 |     interp limit $i time -seconds [expr {$t0 + 1}] -granularity 1 | 
|---|
 | 3197 |     set code [catch { | 
|---|
 | 3198 |         $i eval {after 10000} | 
|---|
 | 3199 |     } msg] | 
|---|
 | 3200 |     set t1 [clock seconds] | 
|---|
 | 3201 |     interp delete $i | 
|---|
 | 3202 |     list $code $msg [expr {($t1-$t0) < 3 ? "OK" : $t1-$t0}]  | 
|---|
 | 3203 | } {1 {time limit exceeded} OK} | 
|---|
 | 3204 | test interp-34.10 {time limits trigger in vwaits: Bug 1221395} -body { | 
|---|
 | 3205 |     set i [interp create] | 
|---|
 | 3206 |     # Assume someone hasn't set the clock to early 1970! | 
|---|
 | 3207 |     $i limit time -seconds 1 -granularity 4 | 
|---|
 | 3208 |     interp alias $i log {} lappend result | 
|---|
 | 3209 |     set result {} | 
|---|
 | 3210 |     catch { | 
|---|
 | 3211 |         $i eval { | 
|---|
 | 3212 |             log 1 | 
|---|
 | 3213 |             after 100 | 
|---|
 | 3214 |             log 2 | 
|---|
 | 3215 |         } | 
|---|
 | 3216 |     } msg | 
|---|
 | 3217 |     interp delete $i | 
|---|
 | 3218 |     lappend result $msg | 
|---|
 | 3219 | } -result {1 {time limit exceeded}} | 
|---|
 | 3220 | test interp-34.11 {time limit extension in callbacks} -setup { | 
|---|
 | 3221 |     proc cb1 {i t} { | 
|---|
 | 3222 |         global result | 
|---|
 | 3223 |         lappend result cb1 | 
|---|
 | 3224 |         $i limit time -seconds $t -command cb2 | 
|---|
 | 3225 |     } | 
|---|
 | 3226 |     proc cb2 {} { | 
|---|
 | 3227 |         global result | 
|---|
 | 3228 |         lappend result cb2 | 
|---|
 | 3229 |     } | 
|---|
 | 3230 | } -body { | 
|---|
 | 3231 |     set i [interp create] | 
|---|
 | 3232 |     set t0 [clock seconds] | 
|---|
 | 3233 |     $i limit time -seconds [expr {$t0+1}] -granularity 1 \ | 
|---|
 | 3234 |         -command "cb1 $i [expr {$t0+2}]" | 
|---|
 | 3235 |     set ::result {} | 
|---|
 | 3236 |     lappend ::result [catch { | 
|---|
 | 3237 |         $i eval { | 
|---|
 | 3238 |             for {set i 0} {$i<30} {incr i} { | 
|---|
 | 3239 |                 after 100 | 
|---|
 | 3240 |             } | 
|---|
 | 3241 |         } | 
|---|
 | 3242 |     } msg] $msg | 
|---|
 | 3243 |     set t1 [clock seconds] | 
|---|
 | 3244 |     lappend ::result [expr {$t1-$t0>=2 ? "ok" : "$t0,$t1"}] | 
|---|
 | 3245 |     interp delete $i | 
|---|
 | 3246 |     return $::result | 
|---|
 | 3247 | } -result {cb1 cb2 1 {time limit exceeded} ok} -cleanup { | 
|---|
 | 3248 |     rename cb1 {} | 
|---|
 | 3249 |     rename cb2 {} | 
|---|
 | 3250 | } | 
|---|
 | 3251 | test interp-34.12 {time limit extension in callbacks} -setup { | 
|---|
 | 3252 |     proc cb1 {i} { | 
|---|
 | 3253 |         global result times | 
|---|
 | 3254 |         lappend result cb1 | 
|---|
 | 3255 |         set times [lassign $times t] | 
|---|
 | 3256 |         $i limit time -seconds $t | 
|---|
 | 3257 |     } | 
|---|
 | 3258 | } -body { | 
|---|
 | 3259 |     set i [interp create] | 
|---|
 | 3260 |     set t0 [clock seconds] | 
|---|
 | 3261 |     set ::times "[expr {$t0+2}] [expr {$t0+100}]" | 
|---|
 | 3262 |     $i limit time -seconds [expr {$t0+1}] -granularity 1 -command "cb1 $i" | 
|---|
 | 3263 |     set ::result {} | 
|---|
 | 3264 |     lappend ::result [catch { | 
|---|
 | 3265 |         $i eval { | 
|---|
 | 3266 |             for {set i 0} {$i<30} {incr i} { | 
|---|
 | 3267 |                 after 100 | 
|---|
 | 3268 |             } | 
|---|
 | 3269 |         } | 
|---|
 | 3270 |     } msg] $msg | 
|---|
 | 3271 |     set t1 [clock seconds] | 
|---|
 | 3272 |     lappend ::result [expr {$t1-$t0>=2 ? "ok" : "$t0,$t1"}] | 
|---|
 | 3273 |     interp delete $i | 
|---|
 | 3274 |     return $::result | 
|---|
 | 3275 | } -result {cb1 cb1 0 {} ok} -cleanup { | 
|---|
 | 3276 |     rename cb1 {} | 
|---|
 | 3277 | } | 
|---|
 | 3278 |  | 
|---|
 | 3279 | test interp-35.1 {interp limit syntax} -body { | 
|---|
 | 3280 |     interp limit | 
|---|
 | 3281 | } -returnCodes error -result {wrong # args: should be "interp limit path limitType ?options?"} | 
|---|
 | 3282 | test interp-35.2 {interp limit syntax} -body { | 
|---|
 | 3283 |     interp limit {} | 
|---|
 | 3284 | } -returnCodes error -result {wrong # args: should be "interp limit path limitType ?options?"} | 
|---|
 | 3285 | test interp-35.3 {interp limit syntax} -body { | 
|---|
 | 3286 |     interp limit {} foo | 
|---|
 | 3287 | } -returnCodes error -result {bad limit type "foo": must be commands or time} | 
|---|
 | 3288 | test interp-35.4 {interp limit syntax} -body { | 
|---|
 | 3289 |     set i [interp create] | 
|---|
 | 3290 |     set dict [interp limit $i commands] | 
|---|
 | 3291 |     set result {} | 
|---|
 | 3292 |     foreach key [lsort [dict keys $dict]] { | 
|---|
 | 3293 |         lappend result $key [dict get $dict $key] | 
|---|
 | 3294 |     } | 
|---|
 | 3295 |     set result | 
|---|
 | 3296 | } -cleanup { | 
|---|
 | 3297 |     interp delete $i | 
|---|
 | 3298 | } -result {-command {} -granularity 1 -value {}} | 
|---|
 | 3299 | test interp-35.5 {interp limit syntax} -body { | 
|---|
 | 3300 |     set i [interp create] | 
|---|
 | 3301 |     interp limit $i commands -granularity | 
|---|
 | 3302 | } -cleanup { | 
|---|
 | 3303 |     interp delete $i | 
|---|
 | 3304 | } -result 1 | 
|---|
 | 3305 | test interp-35.6 {interp limit syntax} -body { | 
|---|
 | 3306 |     set i [interp create] | 
|---|
 | 3307 |     interp limit $i commands -granularity 2 | 
|---|
 | 3308 | } -cleanup { | 
|---|
 | 3309 |     interp delete $i | 
|---|
 | 3310 | } -result {} | 
|---|
 | 3311 | test interp-35.7 {interp limit syntax} -body { | 
|---|
 | 3312 |     set i [interp create] | 
|---|
 | 3313 |     interp limit $i commands -foobar | 
|---|
 | 3314 | } -cleanup { | 
|---|
 | 3315 |     interp delete $i | 
|---|
 | 3316 | } -returnCodes error -result {bad option "-foobar": must be -command, -granularity, or -value} | 
|---|
 | 3317 | test interp-35.8 {interp limit syntax} -body { | 
|---|
 | 3318 |     set i [interp create] | 
|---|
 | 3319 |     interp limit $i commands -granularity foobar | 
|---|
 | 3320 | } -cleanup { | 
|---|
 | 3321 |     interp delete $i | 
|---|
 | 3322 | } -returnCodes error -result {expected integer but got "foobar"} | 
|---|
 | 3323 | test interp-35.9 {interp limit syntax} -body { | 
|---|
 | 3324 |     set i [interp create] | 
|---|
 | 3325 |     interp limit $i commands -granularity 0 | 
|---|
 | 3326 | } -cleanup { | 
|---|
 | 3327 |     interp delete $i | 
|---|
 | 3328 | } -returnCodes error -result {granularity must be at least 1} | 
|---|
 | 3329 | test interp-35.10 {interp limit syntax} -body { | 
|---|
 | 3330 |     set i [interp create] | 
|---|
 | 3331 |     interp limit $i commands -value foobar | 
|---|
 | 3332 | } -cleanup { | 
|---|
 | 3333 |     interp delete $i | 
|---|
 | 3334 | } -returnCodes error -result {expected integer but got "foobar"} | 
|---|
 | 3335 | test interp-35.11 {interp limit syntax} -body { | 
|---|
 | 3336 |     set i [interp create] | 
|---|
 | 3337 |     interp limit $i commands -value -1 | 
|---|
 | 3338 | } -cleanup { | 
|---|
 | 3339 |     interp delete $i | 
|---|
 | 3340 | } -returnCodes error -result {command limit value must be at least 0} | 
|---|
 | 3341 | test interp-35.12 {interp limit syntax} -body { | 
|---|
 | 3342 |     set i [interp create] | 
|---|
 | 3343 |     set dict [interp limit $i time] | 
|---|
 | 3344 |     set result {} | 
|---|
 | 3345 |     foreach key [lsort [dict keys $dict]] { | 
|---|
 | 3346 |         lappend result $key [dict get $dict $key] | 
|---|
 | 3347 |     } | 
|---|
 | 3348 |     set result | 
|---|
 | 3349 | } -cleanup { | 
|---|
 | 3350 |     interp delete $i | 
|---|
 | 3351 | } -result {-command {} -granularity 10 -milliseconds {} -seconds {}} | 
|---|
 | 3352 | test interp-35.13 {interp limit syntax} -body { | 
|---|
 | 3353 |     set i [interp create] | 
|---|
 | 3354 |     interp limit $i time -granularity | 
|---|
 | 3355 | } -cleanup { | 
|---|
 | 3356 |     interp delete $i | 
|---|
 | 3357 | } -result 10 | 
|---|
 | 3358 | test interp-35.14 {interp limit syntax} -body { | 
|---|
 | 3359 |     set i [interp create] | 
|---|
 | 3360 |     interp limit $i time -granularity 2 | 
|---|
 | 3361 | } -cleanup { | 
|---|
 | 3362 |     interp delete $i | 
|---|
 | 3363 | } -result {} | 
|---|
 | 3364 | test interp-35.15 {interp limit syntax} -body { | 
|---|
 | 3365 |     set i [interp create] | 
|---|
 | 3366 |     interp limit $i time -foobar | 
|---|
 | 3367 | } -cleanup { | 
|---|
 | 3368 |     interp delete $i | 
|---|
 | 3369 | } -returnCodes error -result {bad option "-foobar": must be -command, -granularity, -milliseconds, or -seconds} | 
|---|
 | 3370 | test interp-35.16 {interp limit syntax} -body { | 
|---|
 | 3371 |     set i [interp create] | 
|---|
 | 3372 |     interp limit $i time -granularity foobar | 
|---|
 | 3373 | } -cleanup { | 
|---|
 | 3374 |     interp delete $i | 
|---|
 | 3375 | } -returnCodes error -result {expected integer but got "foobar"} | 
|---|
 | 3376 | test interp-35.17 {interp limit syntax} -body { | 
|---|
 | 3377 |     set i [interp create] | 
|---|
 | 3378 |     interp limit $i time -granularity 0 | 
|---|
 | 3379 | } -cleanup { | 
|---|
 | 3380 |     interp delete $i | 
|---|
 | 3381 | } -returnCodes error -result {granularity must be at least 1} | 
|---|
 | 3382 | test interp-35.18 {interp limit syntax} -body { | 
|---|
 | 3383 |     set i [interp create] | 
|---|
 | 3384 |     interp limit $i time -seconds foobar | 
|---|
 | 3385 | } -cleanup { | 
|---|
 | 3386 |     interp delete $i | 
|---|
 | 3387 | } -returnCodes error -result {expected integer but got "foobar"} | 
|---|
 | 3388 | test interp-35.19 {interp limit syntax} -body { | 
|---|
 | 3389 |     set i [interp create] | 
|---|
 | 3390 |     interp limit $i time -seconds -1 | 
|---|
 | 3391 | } -cleanup { | 
|---|
 | 3392 |     interp delete $i | 
|---|
 | 3393 | } -returnCodes error -result {seconds must be at least 0} | 
|---|
 | 3394 | test interp-35.20 {interp limit syntax} -body { | 
|---|
 | 3395 |     set i [interp create] | 
|---|
 | 3396 |     interp limit $i time -millis foobar | 
|---|
 | 3397 | } -cleanup { | 
|---|
 | 3398 |     interp delete $i | 
|---|
 | 3399 | } -returnCodes error -result {expected integer but got "foobar"} | 
|---|
 | 3400 | test interp-35.21 {interp limit syntax} -body { | 
|---|
 | 3401 |     set i [interp create] | 
|---|
 | 3402 |     interp limit $i time -millis -1 | 
|---|
 | 3403 | } -cleanup { | 
|---|
 | 3404 |     interp delete $i | 
|---|
 | 3405 | } -returnCodes error -result {milliseconds must be at least 0} | 
|---|
 | 3406 | test interp-35.22 {interp time limits normalize milliseconds} -body { | 
|---|
 | 3407 |     set i [interp create] | 
|---|
 | 3408 |     interp limit $i time -seconds 1 -millis 1500 | 
|---|
 | 3409 |     list [$i limit time -seconds] [$i limit time -millis] | 
|---|
 | 3410 | } -cleanup { | 
|---|
 | 3411 |     interp delete $i | 
|---|
 | 3412 | } -result {2 500} | 
|---|
 | 3413 |  | 
|---|
 | 3414 | test interp-36.1 {interp bgerror syntax} -body { | 
|---|
 | 3415 |     interp bgerror | 
|---|
 | 3416 | } -returnCodes error -result {wrong # args: should be "interp bgerror path ?cmdPrefix?"} | 
|---|
 | 3417 | test interp-36.2 {interp bgerror syntax} -body {  | 
|---|
 | 3418 |     interp bgerror x y z | 
|---|
 | 3419 | } -returnCodes error -result {wrong # args: should be "interp bgerror path ?cmdPrefix?"} | 
|---|
 | 3420 | test interp-36.3 {interp bgerror syntax} -setup { | 
|---|
 | 3421 |     interp create slave | 
|---|
 | 3422 | } -body { | 
|---|
 | 3423 |     slave bgerror x y | 
|---|
 | 3424 | } -cleanup { | 
|---|
 | 3425 |     interp delete slave | 
|---|
 | 3426 | } -returnCodes error -result {wrong # args: should be "slave bgerror ?cmdPrefix?"} | 
|---|
 | 3427 | test interp-36.4 {SlaveBgerror syntax} -setup { | 
|---|
 | 3428 |     interp create slave | 
|---|
 | 3429 | } -body { | 
|---|
 | 3430 |     slave bgerror \{ | 
|---|
 | 3431 | } -cleanup { | 
|---|
 | 3432 |     interp delete slave | 
|---|
 | 3433 | } -returnCodes error -result {cmdPrefix must be list of length >= 1} | 
|---|
 | 3434 | test interp-36.5 {SlaveBgerror syntax} -setup { | 
|---|
 | 3435 |     interp create slave | 
|---|
 | 3436 | } -body { | 
|---|
 | 3437 |     slave bgerror {} | 
|---|
 | 3438 | } -cleanup { | 
|---|
 | 3439 |     interp delete slave | 
|---|
 | 3440 | } -returnCodes error -result {cmdPrefix must be list of length >= 1} | 
|---|
 | 3441 | test interp-36.6 {SlaveBgerror returns handler} -setup { | 
|---|
 | 3442 |     interp create slave | 
|---|
 | 3443 | } -body { | 
|---|
 | 3444 |     slave bgerror {foo bar soom} | 
|---|
 | 3445 | } -cleanup { | 
|---|
 | 3446 |     interp delete slave | 
|---|
 | 3447 | } -result {foo bar soom} | 
|---|
 | 3448 |  | 
|---|
 | 3449 | # cleanup | 
|---|
 | 3450 | foreach i [interp slaves] { | 
|---|
 | 3451 |     interp delete $i | 
|---|
 | 3452 | } | 
|---|
 | 3453 | ::tcltest::cleanupTests | 
|---|
 | 3454 | return | 
|---|