1# interp.tcl -- 2# 3# Test file for compilation. 4# This file is a condensation of the Tcl test suite file interp.test. 5# It tests that the loader::bcproc object is correctly added at the end 6# of compilation. A now fixed bug caused it to crash the compiler executable 7# in GetCmdLocEncodingSize. 8# 9# Copyright (c) 1998-2000 by Ajuba Solutions. 10# 11# See the file "license.terms" for information on usage and redistribution 12# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 13# 14# RCS: @(#) $Id: interp.tcl,v 1.2 2000/05/30 22:19:11 wart Exp $ 15 16# The set of hidden commands is platform dependent: 17 18if {"$tcl_platform(platform)" == "macintosh"} { 19 set hidden_cmds {beep cd echo encoding exit fconfigure file glob load ls open pwd socket source} 20} else { 21 set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source} 22} 23 24foreach i [interp slaves] { 25 interp delete $i 26} 27 28proc equiv {x} {return $x} 29 30# Part 0: Check out options for interp command 31test interp-1.1 {options for interp command} { 32 list [catch {interp} msg] $msg 33} {1 {wrong # args: should be "interp cmd ?arg ...?"}} 34test interp-1.2 {options for interp command} { 35 list [catch {interp frobox} msg] $msg 36} {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}} 37test interp-1.3 {options for interp command} { 38 interp delete 39} "" 40test interp-1.4 {options for interp command} { 41 list [catch {interp delete foo bar} msg] $msg 42} {1 {could not find interpreter "foo"}} 43test interp-1.5 {options for interp command} { 44 list [catch {interp exists foo bar} msg] $msg 45} {1 {wrong # args: should be "interp exists ?path?"}} 46# 47# test interp-0.6 was removed 48# 49test interp-1.6 {options for interp command} { 50 list [catch {interp slaves foo bar zop} msg] $msg 51} {1 {wrong # args: should be "interp slaves ?path?"}} 52test interp-1.7 {options for interp command} { 53 list [catch {interp hello} msg] $msg 54} {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}} 55test interp-1.8 {options for interp command} { 56 list [catch {interp -froboz} msg] $msg 57} {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}} 58test interp-1.9 {options for interp command} { 59 list [catch {interp -froboz -safe} msg] $msg 60} {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}} 61test interp-1.10 {options for interp command} { 62 list [catch {interp target} msg] $msg 63} {1 {wrong # args: should be "interp target path alias"}} 64 65# Part 1: Basic interpreter creation tests: 66test interp-2.1 {basic interpreter creation} { 67 interp create a 68} a 69test interp-2.2 {basic interpreter creation} { 70 catch {interp create} 71} 0 72test interp-2.3 {basic interpreter creation} { 73 catch {interp create -safe} 74} 0 75test interp-2.4 {basic interpreter creation} { 76 list [catch {interp create a} msg] $msg 77} {1 {interpreter named "a" already exists, cannot create}} 78test interp-2.5 {basic interpreter creation} { 79 interp create b -safe 80} b 81test interp-2.6 {basic interpreter creation} { 82 interp create d -safe 83} d 84test interp-2.7 {basic interpreter creation} { 85 list [catch {interp create -froboz} msg] $msg 86} {1 {bad option "-froboz": must be -safe or --}} 87test interp-2.8 {basic interpreter creation} { 88 interp create -- -froboz 89} -froboz 90test interp-2.9 {basic interpreter creation} { 91 interp create -safe -- -froboz1 92} -froboz1 93test interp-2.10 {basic interpreter creation} { 94 interp create {a x1} 95 interp create {a x2} 96 interp create {a x3} -safe 97} {a x3} 98test interp-2.11 {anonymous interps vs existing procs} { 99 set x [interp create] 100 regexp {interp([0-9]+)} $x dummy thenum 101 interp delete $x 102 incr thenum 103 proc interp$thenum {} {} 104 set x [interp create] 105 regexp {interp([0-9]+)} $x dummy anothernum 106 if {$thenum == $anothernum} { 107 set result 0 108 } else { 109 set result 1 110 } 111} 1 112test interp-2.12 {anonymous interps vs existing procs} { 113 set x [interp create -safe] 114 regexp {interp([0-9]+)} $x dummy thenum 115 interp delete $x 116 incr thenum 117 proc interp$thenum {} {} 118 set x [interp create -safe] 119 regexp {interp([0-9]+)} $x dummy anothernum 120 if {$thenum == $anothernum} { 121 set result 0 122 } else { 123 set result 1 124 } 125} 1 126 127foreach i [interp slaves] { 128 interp delete $i 129} 130 131# Part 2: Testing "interp slaves" and "interp exists" 132test interp-3.1 {testing interp exists and interp slaves} { 133 interp slaves 134} "" 135test interp-3.2 {testing interp exists and interp slaves} { 136 interp create a 137 interp exists a 138} 1 139test interp-3.3 {testing interp exists and interp slaves} { 140 interp exists nonexistent 141} 0 142test interp-3.4 {testing interp exists and interp slaves} { 143 list [catch {interp slaves a b c} msg] $msg 144} {1 {wrong # args: should be "interp slaves ?path?"}} 145test interp-3.5 {testing interp exists and interp slaves} { 146 list [catch {interp exists a b c} msg] $msg 147} {1 {wrong # args: should be "interp exists ?path?"}} 148test interp-3.6 {testing interp exists and interp slaves} { 149 interp exists 150} 1 151test interp-3.7 {testing interp exists and interp slaves} { 152 interp slaves 153} a 154test interp-3.8 {testing interp exists and interp slaves} { 155 list [catch {interp slaves a b c} msg] $msg 156} {1 {wrong # args: should be "interp slaves ?path?"}} 157test interp-3.9 {testing interp exists and interp slaves} { 158 interp create {a a2} -safe 159 interp slaves a 160} {a2} 161test interp-3.10 {testing interp exists and interp slaves} { 162 interp exists {a a2} 163} 1 164 165# Part 3: Testing "interp delete" 166test interp-3.11 {testing interp delete} { 167 interp delete 168} "" 169test interp-4.1 {testing interp delete} { 170 catch {interp create a} 171 interp delete a 172} "" 173test interp-4.2 {testing interp delete} { 174 list [catch {interp delete nonexistent} msg] $msg 175} {1 {could not find interpreter "nonexistent"}} 176test interp-4.3 {testing interp delete} { 177 list [catch {interp delete x y z} msg] $msg 178} {1 {could not find interpreter "x"}} 179test interp-4.4 {testing interp delete} { 180 interp delete 181} "" 182test interp-4.5 {testing interp delete} { 183 interp create a 184 interp create {a x1} 185 interp delete {a x1} 186 interp slaves a 187} "" 188test interp-4.6 {testing interp delete} { 189 interp create c1 190 interp create c2 191 interp create c3 192 interp delete c1 c2 c3 193} "" 194test interp-4.7 {testing interp delete} { 195 interp create c1 196 interp create c2 197 list [catch {interp delete c1 c2 c3} msg] $msg 198} {1 {could not find interpreter "c3"}} 199 200foreach i [interp slaves] { 201 interp delete $i 202} 203 204# Part 4: Consistency checking - all nondeleted interpreters should be 205# there: 206test interp-5.1 {testing consistency} { 207 interp slaves 208} "" 209test interp-5.2 {testing consistency} { 210 interp exists a 211} 0 212test interp-5.3 {testing consistency} { 213 interp exists nonexistent 214} 0 215 216# Recreate interpreter "a" 217interp create a 218 219# Part 5: Testing eval in interpreter object command and with interp command 220test interp-6.1 {testing eval} { 221 a eval expr 3 + 5 222} 8 223test interp-6.2 {testing eval} { 224 list [catch {a eval foo} msg] $msg 225} {1 {invalid command name "foo"}} 226test interp-6.3 {testing eval} { 227 a eval {proc foo {} {expr 3 + 5}} 228 a eval foo 229} 8 230test interp-6.4 {testing eval} { 231 interp eval a foo 232} 8 233 234test interp-6.5 {testing eval} { 235 interp create {a x2} 236 interp eval {a x2} {proc frob {} {expr 4 * 9}} 237 interp eval {a x2} frob 238} 36 239test interp-6.6 {testing eval} { 240 list [catch {interp eval {a x2} foo} msg] $msg 241} {1 {invalid command name "foo"}} 242 243# UTILITY PROCEDURE RUNNING IN MASTER INTERPRETER: 244proc in_master {args} { 245 return [list seen in master: $args] 246} 247 248# Part 6: Testing basic alias creation 249test interp-7.1 {testing basic alias creation} { 250 a alias foo in_master 251} foo 252test interp-7.2 {testing basic alias creation} { 253 a alias bar in_master a1 a2 a3 254} bar 255# Test 6.3 has been deleted. 256test interp-7.3 {testing basic alias creation} { 257 a alias foo 258} in_master 259test interp-7.4 {testing basic alias creation} { 260 a alias bar 261} {in_master a1 a2 a3} 262test interp-7.5 {testing basic alias creation} { 263 a aliases 264} {foo bar} 265 266# Part 7: testing basic alias invocation 267test interp-8.1 {testing basic alias invocation} { 268 catch {interp create a} 269 a alias foo in_master 270 a eval foo s1 s2 s3 271} {seen in master: {s1 s2 s3}} 272test interp-8.2 {testing basic alias invocation} { 273 catch {interp create a} 274 a alias bar in_master a1 a2 a3 275 a eval bar s1 s2 s3 276} {seen in master: {a1 a2 a3 s1 s2 s3}} 277 278# Part 8: Testing aliases for non-existent targets 279test interp-9.1 {testing aliases for non-existent targets} { 280 catch {interp create a} 281 a alias zop nonexistent-command-in-master 282 list [catch {a eval zop} msg] $msg 283} {1 {invalid command name "nonexistent-command-in-master"}} 284test interp-9.2 {testing aliases for non-existent targets} { 285 catch {interp create a} 286 a alias zop nonexistent-command-in-master 287 proc nonexistent-command-in-master {} {return i_exist!} 288 a eval zop 289} i_exist! 290 291if {[info command nonexistent-command-in-master] != ""} { 292 rename nonexistent-command-in-master {} 293} 294 295# Part 9: Aliasing between interpreters 296test interp-10.1 {testing aliasing between interpreters} { 297 catch {interp delete a} 298 catch {interp delete b} 299 interp create a 300 interp create b 301 interp alias a a_alias b b_alias 1 2 3 302} a_alias 303test interp-10.2 {testing aliasing between interpreters} { 304 catch {interp delete a} 305 catch {interp delete b} 306 interp create a 307 interp create b 308 b eval {proc b_alias {args} {return [list got $args]}} 309 interp alias a a_alias b b_alias 1 2 3 310 a eval a_alias a b c 311} {got {1 2 3 a b c}} 312test interp-10.3 {testing aliasing between interpreters} { 313 catch {interp delete a} 314 catch {interp delete b} 315 interp create a 316 interp create b 317 interp alias a a_alias b b_alias 1 2 3 318 list [catch {a eval a_alias a b c} msg] $msg 319} {1 {invalid command name "b_alias"}} 320test interp-10.4 {testing aliasing between interpreters} { 321 catch {interp delete a} 322 interp create a 323 a alias a_alias puts 324 a aliases 325} a_alias 326test interp-10.5 {testing aliasing between interpreters} { 327 catch {interp delete a} 328 catch {interp delete b} 329 interp create a 330 interp create b 331 a alias a_alias puts 332 interp alias a a_del b b_del 333 interp delete b 334 a aliases 335} a_alias 336test interp-10.6 {testing aliasing between interpreters} { 337 catch {interp delete a} 338 catch {interp delete b} 339 interp create a 340 interp create b 341 interp alias a a_command b b_command a1 a2 a3 342 b alias b_command in_master b1 b2 b3 343 a eval a_command m1 m2 m3 344} {seen in master: {b1 b2 b3 a1 a2 a3 m1 m2 m3}} 345test interp-10.7 {testing aliases between interpreters} { 346 catch {interp delete a} 347 interp create a 348 interp alias "" foo a zoppo 349 a eval {proc zoppo {x} {list $x $x $x}} 350 set x [foo 33] 351 a eval {rename zoppo {}} 352 interp alias "" foo a {} 353 equiv $x 354} {33 33 33} 355 356# Part 10: Testing "interp target" 357test interp-11.1 {testing interp target} { 358 list [catch {interp target} msg] $msg 359} {1 {wrong # args: should be "interp target path alias"}} 360test interp-11.2 {testing interp target} { 361 list [catch {interp target nosuchinterpreter foo} msg] $msg 362} {1 {could not find interpreter "nosuchinterpreter"}} 363test interp-11.3 {testing interp target} { 364 catch {interp delete a} 365 interp create a 366 a alias boo no_command 367 interp target a boo 368} "" 369test interp-11.4 {testing interp target} { 370 catch {interp delete x1} 371 interp create x1 372 x1 eval interp create x2 373 x1 eval x2 eval interp create x3 374 catch {interp delete y1} 375 interp create y1 376 y1 eval interp create y2 377 y1 eval y2 eval interp create y3 378 interp alias {x1 x2 x3} xcommand {y1 y2 y3} ycommand 379 interp target {x1 x2 x3} xcommand 380} {y1 y2 y3} 381test interp-11.5 {testing interp target} { 382 catch {interp delete x1} 383 interp create x1 384 interp create {x1 x2} 385 interp create {x1 x2 x3} 386 catch {interp delete y1} 387 interp create y1 388 interp create {y1 y2} 389 interp create {y1 y2 y3} 390 interp alias {x1 x2 x3} xcommand {y1 y2 y3} ycommand 391 list [catch {x1 eval {interp target {x2 x3} xcommand}} msg] $msg 392} {1 {target interpreter for alias "xcommand" in path "x2 x3" is not my descendant}} 393test interp-11.6 {testing interp target} { 394 foreach a [interp aliases] { 395 rename $a {} 396 } 397 list [catch {interp target {} foo} msg] $msg 398} {1 {alias "foo" in path "" not found}} 399test interp-11.7 {testing interp target} { 400 catch {interp delete a} 401 interp create a 402 list [catch {interp target a foo} msg] $msg 403} {1 {alias "foo" in path "a" not found}} 404 405# Part 11: testing "interp issafe" 406test interp-12.1 {testing interp issafe} { 407 interp issafe 408} 0 409test interp-12.2 {testing interp issafe} { 410 catch {interp delete a} 411 interp create a 412 interp issafe a 413} 0 414test interp-12.3 {testing interp issafe} { 415 catch {interp delete a} 416 interp create a 417 interp create {a x3} -safe 418 interp issafe {a x3} 419} 1 420test interp-12.4 {testing interp issafe} { 421 catch {interp delete a} 422 interp create a 423 interp create {a x3} -safe 424 interp create {a x3 foo} 425 interp issafe {a x3 foo} 426} 1 427 428# Part 12: testing interpreter object command "issafe" sub-command 429test interp-13.1 {testing foo issafe} { 430 catch {interp delete a} 431 interp create a 432 a issafe 433} 0 434test interp-13.2 {testing foo issafe} { 435 catch {interp delete a} 436 interp create a 437 interp create {a x3} -safe 438 a eval x3 issafe 439} 1 440test interp-13.3 {testing foo issafe} { 441 catch {interp delete a} 442 interp create a 443 interp create {a x3} -safe 444 interp create {a x3 foo} 445 a eval x3 eval foo issafe 446} 1 447 448# part 14: testing interp aliases 449test interp-14.1 {testing interp aliases} { 450 interp aliases 451} "" 452test interp-14.2 {testing interp aliases} { 453 catch {interp delete a} 454 interp create a 455 a alias a1 puts 456 a alias a2 puts 457 a alias a3 puts 458 lsort [interp aliases a] 459} {a1 a2 a3} 460test interp-14.3 {testing interp aliases} { 461 catch {interp delete a} 462 interp create a 463 interp create {a x3} 464 interp alias {a x3} froboz "" puts 465 interp aliases {a x3} 466} froboz 467 468# part 15: testing file sharing 469test interp-15.1 {testing file sharing} { 470 catch {interp delete z} 471 interp create z 472 z eval close stdout 473 list [catch {z eval puts hello} msg] $msg 474} {1 {can not find channel named "stdout"}} 475catch {removeFile file-15.2} 476test interp-15.2 {testing file sharing} { 477 catch {interp delete z} 478 interp create z 479 set f [open file-15.2 w] 480 interp share "" $f z 481 z eval puts $f hello 482 z eval close $f 483 close $f 484} "" 485catch {removeFile file-15.2} 486test interp-15.3 {testing file sharing} { 487 catch {interp delete xsafe} 488 interp create xsafe -safe 489 list [catch {xsafe eval puts hello} msg] $msg 490} {1 {can not find channel named "stdout"}} 491catch {removeFile file-15.4} 492test interp-15.4 {testing file sharing} { 493 catch {interp delete xsafe} 494 interp create xsafe -safe 495 set f [open file-15.4 w] 496 interp share "" $f xsafe 497 xsafe eval puts $f hello 498 xsafe eval close $f 499 close $f 500} "" 501catch {removeFile file-15.4} 502test interp-15.5 {testing file sharing} { 503 catch {interp delete xsafe} 504 interp create xsafe -safe 505 interp share "" stdout xsafe 506 list [catch {xsafe eval gets stdout} msg] $msg 507} {1 {channel "stdout" wasn't opened for reading}} 508catch {removeFile file-15.6} 509test interp-15.6 {testing file sharing} { 510 catch {interp delete xsafe} 511 interp create xsafe -safe 512 set f [open file-15.6 w] 513 interp share "" $f xsafe 514 set x [list [catch [list xsafe eval gets $f] msg] $msg] 515 xsafe eval close $f 516 close $f 517 string compare [string tolower $x] \ 518 [list 1 [format "channel \"%s\" wasn't opened for reading" $f]] 519} 0 520catch {removeFile file-15.6} 521catch {removeFile file-15.7} 522test interp-15.7 {testing file transferring} { 523 catch {interp delete xsafe} 524 interp create xsafe -safe 525 set f [open file-15.7 w] 526 interp transfer "" $f xsafe 527 xsafe eval puts $f hello 528 xsafe eval close $f 529} "" 530catch {removeFile file-15.7} 531catch {removeFile file-15.8} 532test interp-15.8 {testing file transferring} { 533 catch {interp delete xsafe} 534 interp create xsafe -safe 535 set f [open file-15.8 w] 536 interp transfer "" $f xsafe 537 xsafe eval close $f 538 set x [list [catch {close $f} msg] $msg] 539 string compare [string tolower $x] \ 540 [list 1 [format "can not find channel named \"%s\"" $f]] 541} 0 542catch {removeFile file-15.8} 543 544# 545# Torture tests for interpreter deletion order 546# 547proc kill {} {interp delete xxx} 548 549test interp-15.9 {testing deletion order} { 550 catch {interp delete xxx} 551 interp create xxx 552 xxx alias kill kill 553 list [catch {xxx eval kill} msg] $msg 554} {0 {}} 555test interp-16.1 {testing deletion order} { 556 catch {interp delete xxx} 557 interp create xxx 558 interp create {xxx yyy} 559 interp alias {xxx yyy} kill "" kill 560 list [catch {interp eval {xxx yyy} kill} msg] $msg 561} {0 {}} 562test interp-16.2 {testing deletion order} { 563 catch {interp delete xxx} 564 interp create xxx 565 interp create {xxx yyy} 566 interp alias {xxx yyy} kill "" kill 567 list [catch {xxx eval yyy eval kill} msg] $msg 568} {0 {}} 569test interp-16.3 {testing deletion order} { 570 catch {interp delete xxx} 571 interp create xxx 572 interp create ddd 573 xxx alias kill kill 574 interp alias ddd kill xxx kill 575 set x [ddd eval kill] 576 interp delete ddd 577 set x 578} "" 579test interp-16.4 {testing deletion order} { 580 catch {interp delete xxx} 581 interp create xxx 582 interp create {xxx yyy} 583 interp alias {xxx yyy} kill "" kill 584 interp create ddd 585 interp alias ddd kill {xxx yyy} kill 586 set x [ddd eval kill] 587 interp delete ddd 588 set x 589} "" 590test interp-16.5 {testing deletion order, bgerror} { 591 catch {interp delete xxx} 592 interp create xxx 593 xxx eval {proc bgerror {args} {exit}} 594 xxx alias exit kill xxx 595 proc kill {i} {interp delete $i} 596 xxx eval after 100 expr a + b 597 after 200 598 update 599 interp exists xxx 600} 0 601 602# 603# Alias loop prevention testing. 604# 605 606test interp-17.1 {alias loop prevention} { 607 list [catch {interp alias {} a {} a} msg] $msg 608} {1 {cannot define or rename alias "a": would create a loop}} 609test interp-17.2 {alias loop prevention} { 610 catch {interp delete x} 611 interp create x 612 x alias a loop 613 list [catch {interp alias {} loop x a} msg] $msg 614} {1 {cannot define or rename alias "loop": would create a loop}} 615test interp-17.3 {alias loop prevention} { 616 catch {interp delete x} 617 interp create x 618 interp alias x a x b 619 list [catch {interp alias x b x a} msg] $msg 620} {1 {cannot define or rename alias "b": would create a loop}} 621test interp-17.4 {alias loop prevention} { 622 catch {interp delete x} 623 interp create x 624 interp alias x b x a 625 list [catch {x eval rename b a} msg] $msg 626} {1 {cannot define or rename alias "b": would create a loop}} 627test interp-17.5 {alias loop prevention} { 628 catch {interp delete x} 629 interp create x 630 x alias z l1 631 interp alias {} l2 x z 632 list [catch {rename l2 l1} msg] $msg 633} {1 {cannot define or rename alias "l2": would create a loop}} 634 635# 636# Test robustness of Tcl_DeleteInterp when applied to a slave interpreter. 637# If there are bugs in the implementation these tests are likely to expose 638# the bugs as a core dump. 639# 640 641if {[info commands testinterpdelete] != ""} { 642 test interp-18.1 {testing Tcl_DeleteInterp vs slaves} { 643 list [catch {testinterpdelete} msg] $msg 644 } {1 {wrong # args: should be "testinterpdelete path"}} 645 test interp-18.2 {testing Tcl_DeleteInterp vs slaves} { 646 catch {interp delete a} 647 interp create a 648 testinterpdelete a 649 } "" 650 test interp-18.3 {testing Tcl_DeleteInterp vs slaves} { 651 catch {interp delete a} 652 interp create a 653 interp create {a b} 654 testinterpdelete {a b} 655 } "" 656 test interp-18.4 {testing Tcl_DeleteInterp vs slaves} { 657 catch {interp delete a} 658 interp create a 659 interp create {a b} 660 testinterpdelete a 661 } "" 662 test interp-18.5 {testing Tcl_DeleteInterp vs slaves} { 663 catch {interp delete a} 664 interp create a 665 interp create {a b} 666 interp alias {a b} dodel {} dodel 667 proc dodel {x} {testinterpdelete $x} 668 list [catch {interp eval {a b} {dodel {a b}}} msg] $msg 669 } {0 {}} 670 test interp-18.6 {testing Tcl_DeleteInterp vs slaves} { 671 catch {interp delete a} 672 interp create a 673 interp create {a b} 674 interp alias {a b} dodel {} dodel 675 proc dodel {x} {testinterpdelete $x} 676 list [catch {interp eval {a b} {dodel a}} msg] $msg 677 } {0 {}} 678 test interp-18.7 {eval in deleted interp} { 679 catch {interp delete a} 680 interp create a 681 a eval { 682 proc dodel {} { 683 delme 684 dosomething else 685 } 686 proc dosomething args { 687 puts "I should not have been called!!" 688 } 689 } 690 a alias delme dela 691 proc dela {} {interp delete a} 692 list [catch {a eval dodel} msg] $msg 693 } {1 {attempt to call eval in deleted interpreter}} 694 test interp-18.8 {eval in deleted interp} { 695 catch {interp delete a} 696 interp create a 697 a eval { 698 interp create b 699 b eval { 700 proc dodel {} { 701 dela 702 } 703 } 704 proc foo {} { 705 b eval dela 706 dosomething else 707 } 708 proc dosomething args { 709 puts "I should not have been called!!" 710 } 711 } 712 interp alias {a b} dela {} dela 713 proc dela {} {interp delete a} 714 list [catch {a eval foo} msg] $msg 715 } {1 {attempt to call eval in deleted interpreter}} 716} 717 718# Test alias deletion 719 720test interp-19.1 {alias deletion} { 721 catch {interp delete a} 722 interp create a 723 interp alias a foo a bar 724 set s [interp alias a foo {}] 725 interp delete a 726 set s 727} {} 728test interp-19.2 {alias deletion} { 729 catch {interp delete a} 730 interp create a 731 catch {interp alias a foo {}} msg 732 interp delete a 733 set msg 734} {alias "foo" not found} 735test interp-19.3 {alias deletion} { 736 catch {interp delete a} 737 interp create a 738 interp alias a foo a bar 739 interp eval a {rename foo zop} 740 interp alias a foo a zop 741 catch {interp eval a foo} msg 742 interp delete a 743 set msg 744} {invalid command name "zop"} 745test interp-19.4 {alias deletion} { 746 catch {interp delete a} 747 interp create a 748 interp alias a foo a bar 749 interp eval a {rename foo zop} 750 catch {interp eval a foo} msg 751 interp delete a 752 set msg 753} {invalid command name "foo"} 754test interp-19.5 {alias deletion} { 755 catch {interp delete a} 756 interp create a 757 interp eval a {proc bar {} {return 1}} 758 interp alias a foo a bar 759 interp eval a {rename foo zop} 760 catch {interp eval a zop} msg 761 interp delete a 762 set msg 763} 1 764test interp-19.6 {alias deletion} { 765 catch {interp delete a} 766 interp create a 767 interp alias a foo a bar 768 interp eval a {rename foo zop} 769 interp alias a foo a zop 770 set s [interp aliases a] 771 interp delete a 772 set s 773} foo 774test interp-19.7 {alias deletion, renaming} { 775 catch {interp delete a} 776 interp create a 777 interp alias a foo a bar 778 interp eval a rename foo blotz 779 interp alias a foo {} 780 set s [interp aliases a] 781 interp delete a 782 set s 783} {} 784test interp-19.8 {alias deletion, renaming} { 785 catch {interp delete a} 786 interp create a 787 interp alias a foo a bar 788 interp eval a rename foo blotz 789 set l "" 790 lappend l [interp aliases a] 791 interp alias a foo {} 792 lappend l [interp aliases a] 793 interp delete a 794 set l 795} {foo {}} 796test interp-19.9 {alias deletion, renaming} { 797 catch {interp delete a} 798 interp create a 799 interp alias a foo a bar 800 interp eval a rename foo blotz 801 interp eval a {proc foo {} {expr 34 * 34}} 802 interp alias a foo {} 803 set l [interp eval a foo] 804 interp delete a 805 set l 806} 1156 807 808test interp-20.1 {interp hide, interp expose and interp invokehidden} { 809 catch {interp delete a} 810 interp create a 811 a eval {proc unknown {x args} {error "invalid command name \"$x\""}} 812 a eval {proc foo {} {}} 813 a hide foo 814 catch {a eval foo something} msg 815 interp delete a 816 set msg 817} {invalid command name "foo"} 818test interp-20.2 {interp hide, interp expose and interp invokehidden} { 819 catch {interp delete a} 820 interp create a 821 a eval {proc unknown {x args} {error "invalid command name \"$x\""}} 822 a hide list 823 set l "" 824 lappend l [catch {a eval {list 1 2 3}} msg] 825 lappend l $msg 826 a expose list 827 lappend l [catch {a eval {list 1 2 3}} msg] 828 lappend l $msg 829 interp delete a 830 set l 831} {1 {invalid command name "list"} 0 {1 2 3}} 832test interp-20.3 {interp hide, interp expose and interp invokehidden} { 833 catch {interp delete a} 834 interp create a 835 a eval {proc unknown {x args} {error "invalid command name \"$x\""}} 836 a hide list 837 set l "" 838 lappend l [catch {a eval {list 1 2 3}} msg] 839 lappend l $msg 840 lappend l [catch {a invokehidden list 1 2 3} msg] 841 lappend l $msg 842 a expose list 843 lappend l [catch {a eval {list 1 2 3}} msg] 844 lappend l $msg 845 interp delete a 846 set l 847} {1 {invalid command name "list"} 0 {1 2 3} 0 {1 2 3}} 848test interp-20.4 {interp hide, interp expose and interp invokehidden -- passing {}} { 849 catch {interp delete a} 850 interp create a 851 a eval {proc unknown {x args} {error "invalid command name \"$x\""}} 852 a hide list 853 set l "" 854 lappend l [catch {a eval {list 1 2 3}} msg] 855 lappend l $msg 856 lappend l [catch {a invokehidden list {"" 1 2 3}} msg] 857 lappend l $msg 858 a expose list 859 lappend l [catch {a eval {list 1 2 3}} msg] 860 lappend l $msg 861 interp delete a 862 set l 863} {1 {invalid command name "list"} 0 {{"" 1 2 3}} 0 {1 2 3}} 864test interp-20.5 {interp hide, interp expose and interp invokehidden -- passing {}} { 865 catch {interp delete a} 866 interp create a 867 a eval {proc unknown {x args} {error "invalid command name \"$x\""}} 868 a hide list 869 set l "" 870 lappend l [catch {a eval {list 1 2 3}} msg] 871 lappend l $msg 872 lappend l [catch {a invokehidden list {{} 1 2 3}} msg] 873 lappend l $msg 874 a expose list 875 lappend l [catch {a eval {list 1 2 3}} msg] 876 lappend l $msg 877 interp delete a 878 set l 879} {1 {invalid command name "list"} 0 {{{} 1 2 3}} 0 {1 2 3}} 880test interp-20.6 {interp invokehidden -- eval args} { 881 catch {interp delete a} 882 interp create a 883 a hide list 884 set l "" 885 set z 45 886 lappend l [catch {a invokehidden list $z 1 2 3} msg] 887 lappend l $msg 888 a expose list 889 lappend l [catch {a eval list $z 1 2 3} msg] 890 lappend l $msg 891 interp delete a 892 set l 893} {0 {45 1 2 3} 0 {45 1 2 3}} 894test interp-20.7 {interp invokehidden vs variable eval} { 895 catch {interp delete a} 896 interp create a 897 a hide list 898 set z 45 899 set l "" 900 lappend l [catch {a invokehidden list {$z a b c}} msg] 901 lappend l $msg 902 interp delete a 903 set l 904} {0 {{$z a b c}}} 905test interp-20.8 {interp invokehidden vs variable eval} { 906 catch {interp delete a} 907 interp create a 908 a hide list 909 a eval set z 89 910 set z 45 911 set l "" 912 lappend l [catch {a invokehidden list {$z a b c}} msg] 913 lappend l $msg 914 interp delete a 915 set l 916} {0 {{$z a b c}}} 917test interp-20.9 {interp invokehidden vs variable eval} { 918 catch {interp delete a} 919 interp create a 920 a hide list 921 a eval set z 89 922 set z 45 923 set l "" 924 lappend l [catch {a invokehidden list $z {$z a b c}} msg] 925 lappend l $msg 926 interp delete a 927 set l 928} {0 {45 {$z a b c}}} 929test interp-20.10 {interp hide, interp expose and interp invokehidden} { 930 catch {interp delete a} 931 interp create a 932 a eval {proc unknown {x args} {error "invalid command name \"$x\""}} 933 a eval {proc foo {} {}} 934 interp hide a foo 935 catch {interp eval a foo something} msg 936 interp delete a 937 set msg 938} {invalid command name "foo"} 939test interp-20.11 {interp hide, interp expose and interp invokehidden} { 940 catch {interp delete a} 941 interp create a 942 a eval {proc unknown {x args} {error "invalid command name \"$x\""}} 943 interp hide a list 944 set l "" 945 lappend l [catch {interp eval a {list 1 2 3}} msg] 946 lappend l $msg 947 interp expose a list 948 lappend l [catch {interp eval a {list 1 2 3}} msg] 949 lappend l $msg 950 interp delete a 951 set l 952} {1 {invalid command name "list"} 0 {1 2 3}} 953test interp-20.12 {interp hide, interp expose and interp invokehidden} { 954 catch {interp delete a} 955 interp create a 956 a eval {proc unknown {x args} {error "invalid command name \"$x\""}} 957 interp hide a list 958 set l "" 959 lappend l [catch {interp eval a {list 1 2 3}} msg] 960 lappend l $msg 961 lappend l [catch {interp invokehidden a list 1 2 3} msg] 962 lappend l $msg 963 interp expose a list 964 lappend l [catch {interp eval a {list 1 2 3}} msg] 965 lappend l $msg 966 interp delete a 967 set l 968} {1 {invalid command name "list"} 0 {1 2 3} 0 {1 2 3}} 969test interp-20.13 {interp hide, interp expose, interp invokehidden -- passing {}} { 970 catch {interp delete a} 971 interp create a 972 a eval {proc unknown {x args} {error "invalid command name \"$x\""}} 973 interp hide a list 974 set l "" 975 lappend l [catch {interp eval a {list 1 2 3}} msg] 976 lappend l $msg 977 lappend l [catch {interp invokehidden a list {"" 1 2 3}} msg] 978 lappend l $msg 979 interp expose a list 980 lappend l [catch {interp eval a {list 1 2 3}} msg] 981 lappend l $msg 982 interp delete a 983 set l 984} {1 {invalid command name "list"} 0 {{"" 1 2 3}} 0 {1 2 3}} 985test interp-20.14 {interp hide, interp expose, interp invokehidden -- passing {}} { 986 catch {interp delete a} 987 interp create a 988 a eval {proc unknown {x args} {error "invalid command name \"$x\""}} 989 interp hide a list 990 set l "" 991 lappend l [catch {interp eval a {list 1 2 3}} msg] 992 lappend l $msg 993 lappend l [catch {interp invokehidden a list {{} 1 2 3}} msg] 994 lappend l $msg 995 interp expose a list 996 lappend l [catch {a eval {list 1 2 3}} msg] 997 lappend l $msg 998 interp delete a 999 set l 1000} {1 {invalid command name "list"} 0 {{{} 1 2 3}} 0 {1 2 3}} 1001test interp-20.15 {interp invokehidden -- eval args} { 1002 catch {interp delete a} 1003 interp create a 1004 interp hide a list 1005 set l "" 1006 set z 45 1007 lappend l [catch {interp invokehidden a list $z 1 2 3} msg] 1008 lappend l $msg 1009 a expose list 1010 lappend l [catch {interp eval a list $z 1 2 3} msg] 1011 lappend l $msg 1012 interp delete a 1013 set l 1014} {0 {45 1 2 3} 0 {45 1 2 3}} 1015test interp-20.16 {interp invokehidden vs variable eval} { 1016 catch {interp delete a} 1017 interp create a 1018 interp hide a list 1019 set z 45 1020 set l "" 1021 lappend l [catch {interp invokehidden a list {$z a b c}} msg] 1022 lappend l $msg 1023 interp delete a 1024 set l 1025} {0 {{$z a b c}}} 1026test interp-20.17 {interp invokehidden vs variable eval} { 1027 catch {interp delete a} 1028 interp create a 1029 interp hide a list 1030 a eval set z 89 1031 set z 45 1032 set l "" 1033 lappend l [catch {interp invokehidden a list {$z a b c}} msg] 1034 lappend l $msg 1035 interp delete a 1036 set l 1037} {0 {{$z a b c}}} 1038test interp-20.18 {interp invokehidden vs variable eval} { 1039 catch {interp delete a} 1040 interp create a 1041 interp hide a list 1042 a eval set z 89 1043 set z 45 1044 set l "" 1045 lappend l [catch {interp invokehidden a list $z {$z a b c}} msg] 1046 lappend l $msg 1047 interp delete a 1048 set l 1049} {0 {45 {$z a b c}}} 1050test interp-20.19 {interp invokehidden vs nested commands} { 1051 catch {interp delete a} 1052 interp create a 1053 a hide list 1054 set l [a invokehidden list {[list x y z] f g h} z] 1055 interp delete a 1056 set l 1057} {{[list x y z] f g h} z} 1058test interp-20.20 {interp invokehidden vs nested commands} { 1059 catch {interp delete a} 1060 interp create a 1061 a hide list 1062 set l [interp invokehidden a list {[list x y z] f g h} z] 1063 interp delete a 1064 set l 1065} {{[list x y z] f g h} z} 1066test interp-20.21 {interp hide vs safety} { 1067 catch {interp delete a} 1068 interp create a -safe 1069 set l "" 1070 lappend l [catch {a hide list} msg] 1071 lappend l $msg 1072 interp delete a 1073 set l 1074} {0 {}} 1075test interp-20.22 {interp hide vs safety} { 1076 catch {interp delete a} 1077 interp create a -safe 1078 set l "" 1079 lappend l [catch {interp hide a list} msg] 1080 lappend l $msg 1081 interp delete a 1082 set l 1083} {0 {}} 1084test interp-20.23 {interp hide vs safety} { 1085 catch {interp delete a} 1086 interp create a -safe 1087 set l "" 1088 lappend l [catch {a eval {interp hide {} list}} msg] 1089 lappend l $msg 1090 interp delete a 1091 set l 1092} {1 {permission denied: safe interpreter cannot hide commands}} 1093test interp-20.24 {interp hide vs safety} { 1094 catch {interp delete a} 1095 interp create a -safe 1096 interp create {a b} 1097 set l "" 1098 lappend l [catch {a eval {interp hide b list}} msg] 1099 lappend l $msg 1100 interp delete a 1101 set l 1102} {1 {permission denied: safe interpreter cannot hide commands}} 1103test interp-20.25 {interp hide vs safety} { 1104 catch {interp delete a} 1105 interp create a -safe 1106 interp create {a b} 1107 set l "" 1108 lappend l [catch {interp hide {a b} list} msg] 1109 lappend l $msg 1110 interp delete a 1111 set l 1112} {0 {}} 1113test interp-20.26 {interp expoose vs safety} { 1114 catch {interp delete a} 1115 interp create a -safe 1116 set l "" 1117 lappend l [catch {a hide list} msg] 1118 lappend l $msg 1119 lappend l [catch {a expose list} msg] 1120 lappend l $msg 1121 interp delete a 1122 set l 1123} {0 {} 0 {}} 1124test interp-20.27 {interp expose vs safety} { 1125 catch {interp delete a} 1126 interp create a -safe 1127 set l "" 1128 lappend l [catch {interp hide a list} msg] 1129 lappend l $msg 1130 lappend l [catch {interp expose a list} msg] 1131 lappend l $msg 1132 interp delete a 1133 set l 1134} {0 {} 0 {}} 1135test interp-20.28 {interp expose vs safety} { 1136 catch {interp delete a} 1137 interp create a -safe 1138 set l "" 1139 lappend l [catch {a hide list} msg] 1140 lappend l $msg 1141 lappend l [catch {a eval {interp expose {} list}} msg] 1142 lappend l $msg 1143 interp delete a 1144 set l 1145} {0 {} 1 {permission denied: safe interpreter cannot expose commands}} 1146test interp-20.29 {interp expose vs safety} { 1147 catch {interp delete a} 1148 interp create a -safe 1149 set l "" 1150 lappend l [catch {interp hide a list} msg] 1151 lappend l $msg 1152 lappend l [catch {a eval {interp expose {} list}} msg] 1153 lappend l $msg 1154 interp delete a 1155 set l 1156} {0 {} 1 {permission denied: safe interpreter cannot expose commands}} 1157test interp-20.30 {interp expose vs safety} { 1158 catch {interp delete a} 1159 interp create a -safe 1160 interp create {a b} 1161 set l "" 1162 lappend l [catch {interp hide {a b} list} msg] 1163 lappend l $msg 1164 lappend l [catch {a eval {interp expose b list}} msg] 1165 lappend l $msg 1166 interp delete a 1167 set l 1168} {0 {} 1 {permission denied: safe interpreter cannot expose commands}} 1169test interp-20.31 {interp expose vs safety} { 1170 catch {interp delete a} 1171 interp create a -safe 1172 interp create {a b} 1173 set l "" 1174 lappend l [catch {interp hide {a b} list} msg] 1175 lappend l $msg 1176 lappend l [catch {interp expose {a b} list} msg] 1177 lappend l $msg 1178 interp delete a 1179 set l 1180} {0 {} 0 {}} 1181test interp-20.32 {interp invokehidden vs safety} { 1182 catch {interp delete a} 1183 interp create a -safe 1184 interp hide a list 1185 set l "" 1186 lappend l [catch {a eval {interp invokehidden {} list a b c}} msg] 1187 lappend l $msg 1188 interp delete a 1189 set l 1190} {1 {not allowed to invoke hidden commands from safe interpreter}} 1191test interp-20.33 {interp invokehidden vs safety} { 1192 catch {interp delete a} 1193 interp create a -safe 1194 interp hide a list 1195 set l "" 1196 lappend l [catch {a eval {interp invokehidden {} list a b c}} msg] 1197 lappend l $msg 1198 lappend l [catch {a invokehidden list a b c} msg] 1199 lappend l $msg 1200 interp delete a 1201 set l 1202} {1 {not allowed to invoke hidden commands from safe interpreter}\ 12030 {a b c}} 1204test interp-20.34 {interp invokehidden vs safety} { 1205 catch {interp delete a} 1206 interp create a -safe 1207 interp create {a b} 1208 interp hide {a b} list 1209 set l "" 1210 lappend l [catch {a eval {interp invokehidden b list a b c}} msg] 1211 lappend l $msg 1212 lappend l [catch {interp invokehidden {a b} list a b c} msg] 1213 lappend l $msg 1214 interp delete a 1215 set l 1216} {1 {not allowed to invoke hidden commands from safe interpreter}\ 12170 {a b c}} 1218test interp-20.35 {invokehidden at local level} { 1219 catch {interp delete a} 1220 interp create a 1221 a eval { 1222 proc p1 {} { 1223 set z 90 1224 a1 1225 set z 1226 } 1227 proc h1 {} { 1228 upvar z z 1229 set z 91 1230 } 1231 } 1232 a hide h1 1233 a alias a1 a1 1234 proc a1 {} { 1235 interp invokehidden a h1 1236 } 1237 set r [interp eval a p1] 1238 interp delete a 1239 set r 1240} 91 1241test interp-20.36 {invokehidden at local level} { 1242 catch {interp delete a} 1243 interp create a 1244 a eval { 1245 set z 90 1246 proc p1 {} { 1247 global z 1248 a1 1249 set z 1250 } 1251 proc h1 {} { 1252 upvar z z 1253 set z 91 1254 } 1255 } 1256 a hide h1 1257 a alias a1 a1 1258 proc a1 {} { 1259 interp invokehidden a h1 1260 } 1261 set r [interp eval a p1] 1262 interp delete a 1263 set r 1264} 91 1265test interp-20.37 {invokehidden at local level} { 1266 catch {interp delete a} 1267 interp create a 1268 a eval { 1269 proc p1 {} { 1270 a1 1271 set z 1272 } 1273 proc h1 {} { 1274 upvar z z 1275 set z 91 1276 } 1277 } 1278 a hide h1 1279 a alias a1 a1 1280 proc a1 {} { 1281 interp invokehidden a h1 1282 } 1283 set r [interp eval a p1] 1284 interp delete a 1285 set r 1286} 91 1287test interp-20.38 {invokehidden at global level} { 1288 catch {interp delete a} 1289 interp create a 1290 a eval { 1291 proc p1 {} { 1292 a1 1293 set z 1294 } 1295 proc h1 {} { 1296 upvar z z 1297 set z 91 1298 } 1299 } 1300 a hide h1 1301 a alias a1 a1 1302 proc a1 {} { 1303 interp invokehidden a -global h1 1304 } 1305 set r [catch {interp eval a p1} msg] 1306 interp delete a 1307 list $r $msg 1308} {1 {can't read "z": no such variable}} 1309test interp-20.39 {invokehidden at global level} { 1310 catch {interp delete a} 1311 interp create a 1312 a eval { 1313 proc p1 {} { 1314 global z 1315 a1 1316 set z 1317 } 1318 proc h1 {} { 1319 upvar z z 1320 set z 91 1321 } 1322 } 1323 a hide h1 1324 a alias a1 a1 1325 proc a1 {} { 1326 interp invokehidden a -global h1 1327 } 1328 set r [catch {interp eval a p1} msg] 1329 interp delete a 1330 list $r $msg 1331} {0 91} 1332test interp-20.40 {safe, invokehidden at local level} { 1333 catch {interp delete a} 1334 interp create a -safe 1335 a eval { 1336 proc p1 {} { 1337 set z 90 1338 a1 1339 set z 1340 } 1341 proc h1 {} { 1342 upvar z z 1343 set z 91 1344 } 1345 } 1346 a hide h1 1347 a alias a1 a1 1348 proc a1 {} { 1349 interp invokehidden a h1 1350 } 1351 set r [interp eval a p1] 1352 interp delete a 1353 set r 1354} 91 1355test interp-20.41 {safe, invokehidden at local level} { 1356 catch {interp delete a} 1357 interp create a -safe 1358 a eval { 1359 set z 90 1360 proc p1 {} { 1361 global z 1362 a1 1363 set z 1364 } 1365 proc h1 {} { 1366 upvar z z 1367 set z 91 1368 } 1369 } 1370 a hide h1 1371 a alias a1 a1 1372 proc a1 {} { 1373 interp invokehidden a h1 1374 } 1375 set r [interp eval a p1] 1376 interp delete a 1377 set r 1378} 91 1379test interp-20.42 {safe, invokehidden at local level} { 1380 catch {interp delete a} 1381 interp create a -safe 1382 a eval { 1383 proc p1 {} { 1384 a1 1385 set z 1386 } 1387 proc h1 {} { 1388 upvar z z 1389 set z 91 1390 } 1391 } 1392 a hide h1 1393 a alias a1 a1 1394 proc a1 {} { 1395 interp invokehidden a h1 1396 } 1397 set r [interp eval a p1] 1398 interp delete a 1399 set r 1400} 91 1401test interp-20.43 {invokehidden at global level} { 1402 catch {interp delete a} 1403 interp create a 1404 a eval { 1405 proc p1 {} { 1406 a1 1407 set z 1408 } 1409 proc h1 {} { 1410 upvar z z 1411 set z 91 1412 } 1413 } 1414 a hide h1 1415 a alias a1 a1 1416 proc a1 {} { 1417 interp invokehidden a -global h1 1418 } 1419 set r [catch {interp eval a p1} msg] 1420 interp delete a 1421 list $r $msg 1422} {1 {can't read "z": no such variable}} 1423test interp-20.44 {invokehidden at global level} { 1424 catch {interp delete a} 1425 interp create a 1426 a eval { 1427 proc p1 {} { 1428 global z 1429 a1 1430 set z 1431 } 1432 proc h1 {} { 1433 upvar z z 1434 set z 91 1435 } 1436 } 1437 a hide h1 1438 a alias a1 a1 1439 proc a1 {} { 1440 interp invokehidden a -global h1 1441 } 1442 set r [catch {interp eval a p1} msg] 1443 interp delete a 1444 list $r $msg 1445} {0 91} 1446test interp-20.45 {interp hide vs namespaces} { 1447 catch {interp delete a} 1448 interp create a 1449 a eval { 1450 namespace eval foo {} 1451 proc foo::x {} {} 1452 } 1453 set l [list [catch {interp hide a foo::x} msg] $msg] 1454 interp delete a 1455 set l 1456} {1 {cannot use namespace qualifiers in hidden command token (rename)}} 1457test interp-20.46 {interp hide vs namespaces} { 1458 catch {interp delete a} 1459 interp create a 1460 a eval { 1461 namespace eval foo {} 1462 proc foo::x {} {} 1463 } 1464 set l [list [catch {interp hide a foo::x x} msg] $msg] 1465 interp delete a 1466 set l 1467} {1 {can only hide global namespace commands (use rename then hide)}} 1468test interp-20.47 {interp hide vs namespaces} { 1469 catch {interp delete a} 1470 interp create a 1471 a eval { 1472 proc x {} {} 1473 } 1474 set l [list [catch {interp hide a x foo::x} msg] $msg] 1475 interp delete a 1476 set l 1477} {1 {cannot use namespace qualifiers in hidden command token (rename)}} 1478test interp-20.48 {interp hide vs namespaces} { 1479 catch {interp delete a} 1480 interp create a 1481 a eval { 1482 namespace eval foo {} 1483 proc foo::x {} {} 1484 } 1485 set l [list [catch {interp hide a foo::x bar::x} msg] $msg] 1486 interp delete a 1487 set l 1488} {1 {cannot use namespace qualifiers in hidden command token (rename)}} 1489 1490test interp-21.1 {interp hidden} { 1491 interp hidden {} 1492} "" 1493test interp-21.2 {interp hidden} { 1494 interp hidden 1495} "" 1496test interp-21.3 {interp hidden vs interp hide, interp expose} { 1497 set l "" 1498 lappend l [interp hidden] 1499 interp hide {} pwd 1500 lappend l [interp hidden] 1501 interp expose {} pwd 1502 lappend l [interp hidden] 1503 set l 1504} {{} pwd {}} 1505test interp-21.4 {interp hidden} { 1506 catch {interp delete a} 1507 interp create a 1508 set l [interp hidden a] 1509 interp delete a 1510 set l 1511} "" 1512test interp-21.5 {interp hidden} { 1513 catch {interp delete a} 1514 interp create -safe a 1515 set l [lsort [interp hidden a]] 1516 interp delete a 1517 set l 1518} $hidden_cmds 1519test interp-21.6 {interp hidden vs interp hide, interp expose} { 1520 catch {interp delete a} 1521 interp create a 1522 set l "" 1523 lappend l [interp hidden a] 1524 interp hide a pwd 1525 lappend l [interp hidden a] 1526 interp expose a pwd 1527 lappend l [interp hidden a] 1528 interp delete a 1529 set l 1530} {{} pwd {}} 1531test interp-21.7 {interp hidden} { 1532 catch {interp delete a} 1533 interp create a 1534 set l [a hidden] 1535 interp delete a 1536 set l 1537} "" 1538test interp-21.8 {interp hidden} { 1539 catch {interp delete a} 1540 interp create a -safe 1541 set l [lsort [a hidden]] 1542 interp delete a 1543 set l 1544} $hidden_cmds 1545test interp-21.9 {interp hidden vs interp hide, interp expose} { 1546 catch {interp delete a} 1547 interp create a 1548 set l "" 1549 lappend l [a hidden] 1550 a hide pwd 1551 lappend l [a hidden] 1552 a expose pwd 1553 lappend l [a hidden] 1554 interp delete a 1555 set l 1556} {{} pwd {}} 1557 1558test interp-22.1 {testing interp marktrusted} { 1559 catch {interp delete a} 1560 interp create a 1561 set l "" 1562 lappend l [a issafe] 1563 lappend l [a marktrusted] 1564 lappend l [a issafe] 1565 interp delete a 1566 set l 1567} {0 {} 0} 1568test interp-22.2 {testing interp marktrusted} { 1569 catch {interp delete a} 1570 interp create a 1571 set l "" 1572 lappend l [interp issafe a] 1573 lappend l [interp marktrusted a] 1574 lappend l [interp issafe a] 1575 interp delete a 1576 set l 1577} {0 {} 0} 1578test interp-22.3 {testing interp marktrusted} { 1579 catch {interp delete a} 1580 interp create a -safe 1581 set l "" 1582 lappend l [a issafe] 1583 lappend l [a marktrusted] 1584 lappend l [a issafe] 1585 interp delete a 1586 set l 1587} {1 {} 0} 1588test interp-22.4 {testing interp marktrusted} { 1589 catch {interp delete a} 1590 interp create a -safe 1591 set l "" 1592 lappend l [interp issafe a] 1593 lappend l [interp marktrusted a] 1594 lappend l [interp issafe a] 1595 interp delete a 1596 set l 1597} {1 {} 0} 1598test interp-22.5 {testing interp marktrusted} { 1599 catch {interp delete a} 1600 interp create a -safe 1601 interp create {a b} 1602 catch {a eval {interp marktrusted b}} msg 1603 interp delete a 1604 set msg 1605} {permission denied: safe interpreter cannot mark trusted} 1606test interp-22.6 {testing interp marktrusted} { 1607 catch {interp delete a} 1608 interp create a -safe 1609 interp create {a b} 1610 catch {a eval {b marktrusted}} msg 1611 interp delete a 1612 set msg 1613} {permission denied: safe interpreter cannot mark trusted} 1614test interp-22.7 {testing interp marktrusted} { 1615 catch {interp delete a} 1616 interp create a -safe 1617 set l "" 1618 lappend l [interp issafe a] 1619 interp marktrusted a 1620 interp create {a b} 1621 lappend l [interp issafe a] 1622 lappend l [interp issafe {a b}] 1623 interp delete a 1624 set l 1625} {1 0 0} 1626test interp-22.8 {testing interp marktrusted} { 1627 catch {interp delete a} 1628 interp create a -safe 1629 set l "" 1630 lappend l [interp issafe a] 1631 interp create {a b} 1632 lappend l [interp issafe {a b}] 1633 interp marktrusted a 1634 interp create {a c} 1635 lappend l [interp issafe a] 1636 lappend l [interp issafe {a c}] 1637 interp delete a 1638 set l 1639} {1 1 0 0} 1640test interp-22.9 {testing interp marktrusted} { 1641 catch {interp delete a} 1642 interp create a -safe 1643 set l "" 1644 lappend l [interp issafe a] 1645 interp create {a b} 1646 lappend l [interp issafe {a b}] 1647 interp marktrusted {a b} 1648 lappend l [interp issafe a] 1649 lappend l [interp issafe {a b}] 1650 interp create {a b c} 1651 lappend l [interp issafe {a b c}] 1652 interp delete a 1653 set l 1654} {1 1 1 0 0} 1655 1656test interp-23.1 {testing hiding vs aliases} { 1657 catch {interp delete a} 1658 interp create a 1659 set l "" 1660 lappend l [interp hidden a] 1661 a alias bar bar 1662 lappend l [interp aliases a] 1663 lappend l [interp hidden a] 1664 a hide bar 1665 lappend l [interp aliases a] 1666 lappend l [interp hidden a] 1667 a alias bar {} 1668 lappend l [interp aliases a] 1669 lappend l [interp hidden a] 1670 interp delete a 1671 set l 1672} {{} bar {} bar bar {} {}} 1673test interp-23.2 {testing hiding vs aliases} {pc || unix} { 1674 catch {interp delete a} 1675 interp create a -safe 1676 set l "" 1677 lappend l [lsort [interp hidden a]] 1678 a alias bar bar 1679 lappend l [interp aliases a] 1680 lappend l [lsort [interp hidden a]] 1681 a hide bar 1682 lappend l [interp aliases a] 1683 lappend l [lsort [interp hidden a]] 1684 a alias bar {} 1685 lappend l [interp aliases a] 1686 lappend l [lsort [interp hidden a]] 1687 interp delete a 1688 set l 1689} {{cd encoding exec exit fconfigure file glob load open pwd socket source} bar {cd encoding exec exit fconfigure file glob load open pwd socket source} bar {bar cd encoding exec exit fconfigure file glob load open pwd socket source} {} {cd encoding exec exit fconfigure file glob load open pwd socket source}} 1690 1691test interp-23.3 {testing hiding vs aliases} {macOnly} { 1692 catch {interp delete a} 1693 interp create a -safe 1694 set l "" 1695 lappend l [lsort [interp hidden a]] 1696 a alias bar bar 1697 lappend l [interp aliases a] 1698 lappend l [lsort [interp hidden a]] 1699 a hide bar 1700 lappend l [interp aliases a] 1701 lappend l [lsort [interp hidden a]] 1702 a alias bar {} 1703 lappend l [interp aliases a] 1704 lappend l [lsort [interp hidden a]] 1705 interp delete a 1706 set l 1707} {{beep cd echo encoding exit fconfigure file glob load ls open pwd socket source} bar {beep cd echo encoding exit fconfigure file glob load ls open pwd socket source} bar {bar beep cd echo encoding exit fconfigure file glob load ls open pwd socket source} {} {beep cd echo encoding exit fconfigure file glob load ls open pwd socket source}} 1708 1709test interp-24.1 {result resetting on error} { 1710 catch {interp delete a} 1711 interp create a 1712 proc foo args {error $args} 1713 interp alias a foo {} foo 1714 set l [interp eval a { 1715 set l {} 1716 lappend l [catch {foo 1 2 3} msg] 1717 lappend l $msg 1718 lappend l [catch {foo 3 4 5} msg] 1719 lappend l $msg 1720 set l 1721 }] 1722 interp delete a 1723 set l 1724} {1 {1 2 3} 1 {3 4 5}} 1725test interp-24.2 {result resetting on error} { 1726 catch {interp delete a} 1727 interp create a -safe 1728 proc foo args {error $args} 1729 interp alias a foo {} foo 1730 set l [interp eval a { 1731 set l {} 1732 lappend l [catch {foo 1 2 3} msg] 1733 lappend l $msg 1734 lappend l [catch {foo 3 4 5} msg] 1735 lappend l $msg 1736 set l 1737 }] 1738 interp delete a 1739 set l 1740} {1 {1 2 3} 1 {3 4 5}} 1741test interp-24.3 {result resetting on error} { 1742 catch {interp delete a} 1743 interp create a 1744 interp create {a b} 1745 interp eval a { 1746 proc foo args {error $args} 1747 } 1748 interp alias {a b} foo a foo 1749 set l [interp eval {a b} { 1750 set l {} 1751 lappend l [catch {foo 1 2 3} msg] 1752 lappend l $msg 1753 lappend l [catch {foo 3 4 5} msg] 1754 lappend l $msg 1755 set l 1756 }] 1757 interp delete a 1758 set l 1759} {1 {1 2 3} 1 {3 4 5}} 1760test interp-24.4 {result resetting on error} { 1761 catch {interp delete a} 1762 interp create a -safe 1763 interp create {a b} 1764 interp eval a { 1765 proc foo args {error $args} 1766 } 1767 interp alias {a b} foo a foo 1768 set l [interp eval {a b} { 1769 set l {} 1770 lappend l [catch {foo 1 2 3} msg] 1771 lappend l $msg 1772 lappend l [catch {foo 3 4 5} msg] 1773 lappend l $msg 1774 set l 1775 }] 1776 interp delete a 1777 set l 1778} {1 {1 2 3} 1 {3 4 5}} 1779test interp-24.5 {result resetting on error} { 1780 catch {interp delete a} 1781 catch {interp delete b} 1782 interp create a 1783 interp create b 1784 interp eval a { 1785 proc foo args {error $args} 1786 } 1787 interp alias b foo a foo 1788 set l [interp eval b { 1789 set l {} 1790 lappend l [catch {foo 1 2 3} msg] 1791 lappend l $msg 1792 lappend l [catch {foo 3 4 5} msg] 1793 lappend l $msg 1794 set l 1795 }] 1796 interp delete a 1797 set l 1798} {1 {1 2 3} 1 {3 4 5}} 1799test interp-24.6 {result resetting on error} { 1800 catch {interp delete a} 1801 catch {interp delete b} 1802 interp create a -safe 1803 interp create b -safe 1804 interp eval a { 1805 proc foo args {error $args} 1806 } 1807 interp alias b foo a foo 1808 set l [interp eval b { 1809 set l {} 1810 lappend l [catch {foo 1 2 3} msg] 1811 lappend l $msg 1812 lappend l [catch {foo 3 4 5} msg] 1813 lappend l $msg 1814 set l 1815 }] 1816 interp delete a 1817 set l 1818} {1 {1 2 3} 1 {3 4 5}} 1819test interp-24.7 {result resetting on error} { 1820 catch {interp delete a} 1821 interp create a 1822 interp eval a { 1823 proc foo args {error $args} 1824 } 1825 set l {} 1826 lappend l [catch {interp eval a foo 1 2 3} msg] 1827 lappend l $msg 1828 lappend l [catch {interp eval a foo 3 4 5} msg] 1829 lappend l $msg 1830 interp delete a 1831 set l 1832} {1 {1 2 3} 1 {3 4 5}} 1833test interp-24.8 {result resetting on error} { 1834 catch {interp delete a} 1835 interp create a -safe 1836 interp eval a { 1837 proc foo args {error $args} 1838 } 1839 set l {} 1840 lappend l [catch {interp eval a foo 1 2 3} msg] 1841 lappend l $msg 1842 lappend l [catch {interp eval a foo 3 4 5} msg] 1843 lappend l $msg 1844 interp delete a 1845 set l 1846} {1 {1 2 3} 1 {3 4 5}} 1847test interp-24.9 {result resetting on error} { 1848 catch {interp delete a} 1849 interp create a 1850 interp create {a b} 1851 interp eval {a b} { 1852 proc foo args {error $args} 1853 } 1854 interp eval a { 1855 proc foo args { 1856 eval interp eval b foo $args 1857 } 1858 } 1859 set l {} 1860 lappend l [catch {interp eval a foo 1 2 3} msg] 1861 lappend l $msg 1862 lappend l [catch {interp eval a foo 3 4 5} msg] 1863 lappend l $msg 1864 interp delete a 1865 set l 1866} {1 {1 2 3} 1 {3 4 5}} 1867test interp-24.10 {result resetting on error} { 1868 catch {interp delete a} 1869 interp create a -safe 1870 interp create {a b} 1871 interp eval {a b} { 1872 proc foo args {error $args} 1873 } 1874 interp eval a { 1875 proc foo args { 1876 eval interp eval b foo $args 1877 } 1878 } 1879 set l {} 1880 lappend l [catch {interp eval a foo 1 2 3} msg] 1881 lappend l $msg 1882 lappend l [catch {interp eval a foo 3 4 5} msg] 1883 lappend l $msg 1884 interp delete a 1885 set l 1886} {1 {1 2 3} 1 {3 4 5}} 1887test interp-24.11 {result resetting on error} { 1888 catch {interp delete a} 1889 interp create a 1890 interp create {a b} 1891 interp eval {a b} { 1892 proc foo args {error $args} 1893 } 1894 interp eval a { 1895 proc foo args { 1896 set l {} 1897 lappend l [catch {eval interp eval b foo $args} msg] 1898 lappend l $msg 1899 lappend l [catch {eval interp eval b foo $args} msg] 1900 lappend l $msg 1901 set l 1902 } 1903 } 1904 set l [interp eval a foo 1 2 3] 1905 interp delete a 1906 set l 1907} {1 {1 2 3} 1 {1 2 3}} 1908test interp-24.12 {result resetting on error} { 1909 catch {interp delete a} 1910 interp create a -safe 1911 interp create {a b} 1912 interp eval {a b} { 1913 proc foo args {error $args} 1914 } 1915 interp eval a { 1916 proc foo args { 1917 set l {} 1918 lappend l [catch {eval interp eval b foo $args} msg] 1919 lappend l $msg 1920 lappend l [catch {eval interp eval b foo $args} msg] 1921 lappend l $msg 1922 set l 1923 } 1924 } 1925 set l [interp eval a foo 1 2 3] 1926 interp delete a 1927 set l 1928} {1 {1 2 3} 1 {1 2 3}} 1929 1930unset hidden_cmds 1931 1932test interp-25.1 {testing aliasing of string commands} { 1933 catch {interp delete a} 1934 interp create a 1935 a alias exec foo ;# Relies on exec being a string command! 1936 interp delete a 1937} "" 1938 1939 1940# Interps result transmission 1941test interp-26.1 {result code transmission 1} {knownBug} { 1942 # This test currently fails ! (only ok/error are passed, not the other 1943 # codes). Fixing the code is thus needed... -- dl 1944 # (the only other acceptable result list would be 1945 # {-1 0 1 0 3 4 5} because of the way return -code return(=2) works) 1946 # test that all the possibles error codes from Tcl get passed 1947 catch {interp delete a} 1948 interp create a 1949 interp eval a {proc ret {code} {return -code $code $code}} 1950 set res {} 1951 # use a for so if a return -code break 'escapes' we would notice 1952 for {set code -1} {$code<=5} {incr code} { 1953 lappend res [catch {interp eval a ret $code} msg] 1954 } 1955 interp delete a 1956 set res 1957} {-1 0 1 2 3 4 5} 1958 1959test interp-26.2 {result code transmission 2} {knownBug} { 1960 # This test currently fails ! (error is cleared) 1961 # Code fixing is needed... -- dl 1962 # (the only other acceptable result list would be 1963 # {-1 0 1 0 3 4 5} because of the way return -code return(=2) works) 1964 # test that all the possibles error codes from Tcl get passed 1965 set interp [interp create]; 1966 proc MyTestAlias {interp args} { 1967 global aliasTrace; 1968 lappend aliasTrace $args; 1969 eval interp invokehidden [list $interp] $args 1970 } 1971 foreach c {return} { 1972 interp hide $interp $c; 1973 interp alias $interp $c {} MyTestAlias $interp $c; 1974 } 1975 interp eval $interp {proc ret {code} {return -code $code $code}} 1976 set res {} 1977 set aliasTrace {} 1978 for {set code -1} {$code<=5} {incr code} { 1979 lappend res [catch {interp eval $interp ret $code} msg] 1980 } 1981 interp delete $interp; 1982 list $res 1983} {-1 0 1 2 3 4 5} 1984 1985test interp-26.3 {errorInfo transmission : regular interps} { 1986 set interp [interp create]; 1987 proc MyError {secret} { 1988 return -code error "msg" 1989 } 1990 proc MyTestAlias {interp args} { 1991 MyError "some secret" 1992 } 1993 interp alias $interp test {} MyTestAlias $interp; 1994 set res [interp eval $interp {catch test;set errorInfo}] 1995 interp delete $interp; 1996 set res 1997} {msg 1998 while executing 1999"MyError "some secret"" 2000 (procedure "MyTestAlias" line 2) 2001 invoked from within 2002"test"} 2003 2004test interp-26.4 {errorInfo transmission : safe interps} {knownBug} { 2005 # this test fails because the errorInfo is fully transmitted 2006 # whether the interp is safe or not. this is maybe a feature 2007 # and not a bug. 2008 set interp [interp create -safe]; 2009 proc MyError {secret} { 2010 return -code error "msg" 2011 } 2012 proc MyTestAlias {interp args} { 2013 MyError "some secret" 2014 } 2015 interp alias $interp test {} MyTestAlias $interp; 2016 set res [interp eval $interp {catch test;set errorInfo}] 2017 interp delete $interp; 2018 set res 2019} {msg 2020 while executing 2021"catch test"} 2022 2023# Interps & Namespaces 2024test interp-27.1 {interp aliases & namespaces} { 2025 set i [interp create]; 2026 set aliasTrace {}; 2027 proc tstAlias {args} { 2028 global aliasTrace; 2029 lappend aliasTrace [list [namespace current] $args]; 2030 } 2031 $i alias foo::bar tstAlias foo::bar; 2032 $i eval foo::bar test 2033 interp delete $i 2034 set aliasTrace; 2035} {{:: {foo::bar test}}} 2036 2037test interp-27.2 {interp aliases & namespaces} { 2038 set i [interp create]; 2039 set aliasTrace {}; 2040 proc tstAlias {args} { 2041 global aliasTrace; 2042 lappend aliasTrace [list [namespace current] $args]; 2043 } 2044 $i alias foo::bar tstAlias foo::bar; 2045 $i eval namespace eval foo {bar test} 2046 interp delete $i 2047 set aliasTrace; 2048} {{:: {foo::bar test}}} 2049 2050test interp-27.3 {interp aliases & namespaces} { 2051 set i [interp create]; 2052 set aliasTrace {}; 2053 proc tstAlias {args} { 2054 global aliasTrace; 2055 lappend aliasTrace [list [namespace current] $args]; 2056 } 2057 interp eval $i {namespace eval foo {proc bar {} {error "bar called"}}} 2058 interp alias $i foo::bar {} tstAlias foo::bar; 2059 interp eval $i {namespace eval foo {bar test}} 2060 interp delete $i 2061 set aliasTrace; 2062} {{:: {foo::bar test}}} 2063 2064test interp-27.4 {interp aliases & namespaces} { 2065 set i [interp create]; 2066 namespace eval foo2 { 2067 variable aliasTrace {}; 2068 proc bar {args} { 2069 variable aliasTrace; 2070 lappend aliasTrace [list [namespace current] $args]; 2071 } 2072 } 2073 $i alias foo::bar foo2::bar foo::bar; 2074 $i eval namespace eval foo {bar test} 2075 set r $foo2::aliasTrace; 2076 namespace delete foo2; 2077 set r 2078} {{::foo2 {foo::bar test}}} 2079 2080# the following tests are commented out while we don't support 2081# hiding in namespaces 2082 2083# test interp-27.5 {interp hidden & namespaces} { 2084# set i [interp create]; 2085# interp eval $i { 2086# namespace eval foo { 2087# proc bar {args} { 2088# return "bar called ([namespace current]) ($args)" 2089# } 2090# } 2091# } 2092# set res [list [interp eval $i {namespace eval foo {bar test1}}]] 2093# interp hide $i foo::bar; 2094# lappend res [list [catch {interp eval $i {namespace eval foo {bar test2}}} msg] $msg] 2095# interp delete $i; 2096# set res; 2097#} {{bar called (::foo) (test1)} {1 {invalid command name "bar"}}} 2098 2099# test interp-27.6 {interp hidden & aliases & namespaces} { 2100# set i [interp create]; 2101# set v root-master; 2102# namespace eval foo { 2103# variable v foo-master; 2104# proc bar {interp args} { 2105# variable v; 2106# list "master bar called ($v) ([namespace current]) ($args)"\ 2107# [interp invokehidden $interp foo::bar $args]; 2108# } 2109# } 2110# interp eval $i { 2111# namespace eval foo { 2112# namespace export * 2113# variable v foo-slave; 2114# proc bar {args} { 2115# variable v; 2116# return "slave bar called ($v) ([namespace current]) ($args)" 2117# } 2118# } 2119# } 2120# set res [list [interp eval $i {namespace eval foo {bar test1}}]] 2121# $i hide foo::bar; 2122# $i alias foo::bar foo::bar $i; 2123# set res [concat $res [interp eval $i { 2124# set v root-slave; 2125# namespace eval test { 2126# variable v foo-test; 2127# namespace import ::foo::*; 2128# bar test2 2129# } 2130# }]] 2131# namespace delete foo; 2132# interp delete $i; 2133# set res 2134# } {{slave bar called (foo-slave) (::foo) (test1)} {master bar called (foo-master) (::foo) (test2)} {slave bar called (foo-slave) (::foo) (test2)}} 2135 2136 2137# test interp-27.7 {interp hidden & aliases & imports & namespaces} { 2138# set i [interp create]; 2139# set v root-master; 2140# namespace eval mfoo { 2141# variable v foo-master; 2142# proc bar {interp args} { 2143# variable v; 2144# list "master bar called ($v) ([namespace current]) ($args)"\ 2145# [interp invokehidden $interp test::bar $args]; 2146# } 2147# } 2148# interp eval $i { 2149# namespace eval foo { 2150# namespace export * 2151# variable v foo-slave; 2152# proc bar {args} { 2153# variable v; 2154# return "slave bar called ($v) ([info level 0]) ([uplevel namespace current]) ([namespace current]) ($args)" 2155# } 2156# } 2157# set v root-slave; 2158# namespace eval test { 2159# variable v foo-test; 2160# namespace import ::foo::*; 2161# } 2162# } 2163# set res [list [interp eval $i {namespace eval test {bar test1}}]] 2164# $i hide test::bar; 2165# $i alias test::bar mfoo::bar $i; 2166# set res [concat $res [interp eval $i {test::bar test2}]]; 2167# namespace delete mfoo; 2168# interp delete $i; 2169# set res 2170# } {{slave bar called (foo-slave) (bar test1) (::test) (::foo) (test1)} {master bar called (foo-master) (::mfoo) (test2)} {slave bar called (foo-slave) (test::bar test2) (::) (::foo) (test2)}} 2171 2172#test interp-27.8 {hiding, namespaces and integrity} { 2173# namespace eval foo { 2174# variable v 3; 2175# proc bar {} {variable v; set v} 2176# # next command would currently generate an unknown command "bar" error. 2177# interp hide {} bar; 2178# } 2179# namespace delete foo; 2180# list [catch {interp invokehidden {} foo} msg] $msg; 2181#} {1 {invalid hidden command name "foo"}} 2182 2183 2184test interp-28.1 {getting fooled by slave's namespace ?} { 2185 set i [interp create -safe]; 2186 proc master {interp args} {interp hide $interp list} 2187 $i alias master master $i; 2188 set r [interp eval $i { 2189 namespace eval foo { 2190 proc list {args} { 2191 return "dummy foo::list"; 2192 } 2193 master; 2194 } 2195 info commands list 2196 }] 2197 interp delete $i; 2198 set r 2199} {} 2200 2201# Tests of recursionlimit 2202# We need testsetrecursionlimit so we need Tcltest package 2203if {[catch {package require Tcltest} msg]} { 2204 puts "This application hasn't been compiled with Tcltest" 2205 puts "skipping remining interp tests that relies on it." 2206} else { 2207 # 2208test interp-29.1 {recursion limit} { 2209 set i [interp create] 2210 load {} Tcltest $i 2211 set r [interp eval $i { 2212 testsetrecursionlimit 50 2213 proc p {} {incr ::i; p} 2214 set i 0 2215 catch p 2216 set i 2217 }] 2218 interp delete $i 2219 set r 2220} 49 2221 2222test interp-29.2 {recursion limit inheritance} { 2223 set i [interp create] 2224 load {} Tcltest $i 2225 set ii [interp eval $i { 2226 testsetrecursionlimit 50 2227 interp create 2228 }] 2229 set r [interp eval [list $i $ii] { 2230 proc p {} {incr ::i; p} 2231 set i 0 2232 catch p 2233 set i 2234 }] 2235 interp delete $i 2236 set r 2237} 49 2238 2239# # Deep recursion (into interps when the regular one fails): 2240# # still crashes... 2241# proc p {} { 2242# if {[catch p ret]} { 2243# catch { 2244# set i [interp create] 2245# interp eval $i [list proc p {} [info body p]] 2246# interp eval $i p 2247# } 2248# interp delete $i 2249# return ok 2250# } 2251# return $ret 2252# } 2253# p 2254 2255# more tests needed... 2256 2257# Interp & stack 2258#test interp-29.1 {interp and stack (info level)} { 2259#} {} 2260 2261} 2262 2263 2264foreach i [interp slaves] { 2265 interp delete $i 2266} 2267