interp.test
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:79k
源码类别:

通讯编程

开发平台:

Visual C++

  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.19.2.6 2004/10/28 00:01:07 dgp Exp $
  14. if {[lsearch [namespace children] ::tcltest] == -1} {
  15.     package require tcltest 2.1
  16.     namespace import -force ::tcltest::*
  17. }
  18. # The set of hidden commands is platform dependent:
  19. if {"$tcl_platform(platform)" == "macintosh"} {
  20.     set hidden_cmds {beep cd echo encoding exit fconfigure file glob load ls open pwd socket source}
  21. } else {
  22.     set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source}
  23. }
  24. foreach i [interp slaves] {
  25.   interp delete $i
  26. }
  27. proc equiv {x} {return $x}
  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, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, 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, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, 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, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, 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, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, 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. # Part 1: Basic interpreter creation tests:
  63. test interp-2.1 {basic interpreter creation} {
  64.     interp create a
  65. } a
  66. test interp-2.2 {basic interpreter creation} {
  67.     catch {interp create}
  68. } 0
  69. test interp-2.3 {basic interpreter creation} {
  70.     catch {interp create -safe}
  71. } 0 
  72. test interp-2.4 {basic interpreter creation} {
  73.     list [catch {interp create a} msg] $msg
  74. } {1 {interpreter named "a" already exists, cannot create}}
  75. test interp-2.5 {basic interpreter creation} {
  76.     interp create b -safe
  77. } b
  78. test interp-2.6 {basic interpreter creation} {
  79.     interp create d -safe
  80. } d
  81. test interp-2.7 {basic interpreter creation} {
  82.     list [catch {interp create -froboz} msg] $msg
  83. } {1 {bad option "-froboz": must be -safe or --}}
  84. test interp-2.8 {basic interpreter creation} {
  85.     interp create -- -froboz
  86. } -froboz
  87. test interp-2.9 {basic interpreter creation} {
  88.     interp create -safe -- -froboz1
  89. } -froboz1
  90. test interp-2.10 {basic interpreter creation} {
  91.     interp create {a x1}
  92.     interp create {a x2}
  93.     interp create {a x3} -safe
  94. } {a x3}
  95. test interp-2.11 {anonymous interps vs existing procs} {
  96.     set x [interp create]
  97.     regexp "interp([0-9]+)" $x dummy thenum
  98.     interp delete $x
  99.     proc interp$thenum {} {}
  100.     set x [interp create]
  101.     regexp "interp([0-9]+)" $x dummy anothernum
  102.     expr $anothernum > $thenum
  103. } 1    
  104. test interp-2.12 {anonymous interps vs existing procs} {
  105.     set x [interp create -safe]
  106.     regexp "interp([0-9]+)" $x dummy thenum
  107.     interp delete $x
  108.     proc interp$thenum {} {}
  109.     set x [interp create -safe]
  110.     regexp "interp([0-9]+)" $x dummy anothernum
  111.     expr $anothernum - $thenum
  112. } 1    
  113. test interp-2.13 {correct default when no $path arg is given} -body {
  114.     interp create --
  115. } -match regexp -result {interp[0-9]+}
  116.     
  117. foreach i [interp slaves] {
  118.     interp delete $i
  119. }
  120. # Part 2: Testing "interp slaves" and "interp exists"
  121. test interp-3.1 {testing interp exists and interp slaves} {
  122.     interp slaves
  123. } ""
  124. test interp-3.2 {testing interp exists and interp slaves} {
  125.     interp create a
  126.     interp exists a
  127. } 1
  128. test interp-3.3 {testing interp exists and interp slaves} {
  129.     interp exists nonexistent
  130. } 0
  131. test interp-3.4 {testing interp exists and interp slaves} {
  132.     list [catch {interp slaves a b c} msg] $msg
  133. } {1 {wrong # args: should be "interp slaves ?path?"}}
  134. test interp-3.5 {testing interp exists and interp slaves} {
  135.     list [catch {interp exists a b c} msg] $msg
  136. } {1 {wrong # args: should be "interp exists ?path?"}}
  137. test interp-3.6 {testing interp exists and interp slaves} {
  138.     interp exists
  139. } 1
  140. test interp-3.7 {testing interp exists and interp slaves} {
  141.     interp slaves
  142. } a
  143. test interp-3.8 {testing interp exists and interp slaves} {
  144.     list [catch {interp slaves a b c} msg] $msg
  145. } {1 {wrong # args: should be "interp slaves ?path?"}}
  146. test interp-3.9 {testing interp exists and interp slaves} {
  147.     interp create {a a2} -safe
  148.     expr {[lsearch [interp slaves a] a2] >= 0}
  149. } 1
  150. test interp-3.10 {testing interp exists and interp slaves} {
  151.     interp exists {a a2}
  152. } 1
  153. # Part 3: Testing "interp delete"
  154. test interp-3.11 {testing interp delete} {
  155.     interp delete
  156. } ""
  157. test interp-4.1 {testing interp delete} {
  158.     catch {interp create a}
  159.     interp delete a
  160. } ""
  161. test interp-4.2 {testing interp delete} {
  162.     list [catch {interp delete nonexistent} msg] $msg
  163. } {1 {could not find interpreter "nonexistent"}}
  164. test interp-4.3 {testing interp delete} {
  165.     list [catch {interp delete x y z} msg] $msg
  166. } {1 {could not find interpreter "x"}}
  167. test interp-4.4 {testing interp delete} {
  168.     interp delete
  169. } ""
  170. test interp-4.5 {testing interp delete} {
  171.     interp create a
  172.     interp create {a x1}
  173.     interp delete {a x1}
  174.     expr {[lsearch [interp slaves a] x1] >= 0}
  175. } 0
  176. test interp-4.6 {testing interp delete} {
  177.     interp create c1
  178.     interp create c2
  179.     interp create c3
  180.     interp delete c1 c2 c3
  181. } ""
  182. test interp-4.7 {testing interp delete} {
  183.     interp create c1
  184.     interp create c2
  185.     list [catch {interp delete c1 c2 c3} msg] $msg
  186. } {1 {could not find interpreter "c3"}}
  187. test interp-4.8 {testing interp delete} {
  188.     list [catch {interp delete {}} msg] $msg
  189. } {1 {cannot delete the current interpreter}}
  190. foreach i [interp slaves] {
  191.     interp delete $i
  192. }
  193. # Part 4: Consistency checking - all nondeleted interpreters should be
  194. # there:
  195. test interp-5.1 {testing consistency} {
  196.     interp slaves
  197. } ""
  198. test interp-5.2 {testing consistency} {
  199.     interp exists a
  200. } 0
  201. test interp-5.3 {testing consistency} {
  202.     interp exists nonexistent
  203. } 0
  204. # Recreate interpreter "a"
  205. interp create a
  206. # Part 5: Testing eval in interpreter object command and with interp command
  207. test interp-6.1 {testing eval} {
  208.     a eval expr 3 + 5
  209. } 8
  210. test interp-6.2 {testing eval} {
  211.     list [catch {a eval foo} msg] $msg
  212. } {1 {invalid command name "foo"}}
  213. test interp-6.3 {testing eval} {
  214.     a eval {proc foo {} {expr 3 + 5}}
  215.     a eval foo
  216. } 8
  217. test interp-6.4 {testing eval} {
  218.     interp eval a foo
  219. } 8
  220. test interp-6.5 {testing eval} {
  221.     interp create {a x2}
  222.     interp eval {a x2} {proc frob {} {expr 4 * 9}}
  223.     interp eval {a x2} frob
  224. } 36
  225. test interp-6.6 {testing eval} {
  226.     list [catch {interp eval {a x2} foo} msg] $msg
  227. } {1 {invalid command name "foo"}}
  228. # UTILITY PROCEDURE RUNNING IN MASTER INTERPRETER:
  229. proc in_master {args} {
  230.      return [list seen in master: $args]
  231. }
  232. # Part 6: Testing basic alias creation
  233. test interp-7.1 {testing basic alias creation} {
  234.     a alias foo in_master
  235. } foo
  236. test interp-7.2 {testing basic alias creation} {
  237.     a alias bar in_master a1 a2 a3
  238. } bar
  239. # Test 6.3 has been deleted.
  240. test interp-7.3 {testing basic alias creation} {
  241.     a alias foo
  242. } in_master
  243. test interp-7.4 {testing basic alias creation} {
  244.     a alias bar
  245. } {in_master a1 a2 a3}
  246. test interp-7.5 {testing basic alias creation} {
  247.     lsort [a aliases]
  248. } {bar foo}
  249. test interp-7.6 {testing basic aliases arg checking} {
  250.     list [catch {a aliases too many args} msg] $msg
  251. } {1 {wrong # args: should be "a aliases"}}
  252. # Part 7: testing basic alias invocation
  253. test interp-8.1 {testing basic alias invocation} {
  254.     catch {interp create a}
  255.     a alias foo in_master
  256.     a eval foo s1 s2 s3
  257. } {seen in master: {s1 s2 s3}}
  258. test interp-8.2 {testing basic alias invocation} {
  259.     catch {interp create a}
  260.     a alias bar in_master a1 a2 a3
  261.     a eval bar s1 s2 s3
  262. } {seen in master: {a1 a2 a3 s1 s2 s3}}
  263. test interp-8.3 {testing basic alias invocation} {
  264.    catch {interp create a}
  265.    list [catch {a alias} msg] $msg
  266. } {1 {wrong # args: should be "a alias aliasName ?targetName? ?args..?"}}
  267. # Part 8: Testing aliases for non-existent or hidden targets
  268. test interp-9.1 {testing aliases for non-existent targets} {
  269.     catch {interp create a}
  270.     a alias zop nonexistent-command-in-master
  271.     list [catch {a eval zop} msg] $msg
  272. } {1 {invalid command name "nonexistent-command-in-master"}}
  273. test interp-9.2 {testing aliases for non-existent targets} {
  274.     catch {interp create a}
  275.     a alias zop nonexistent-command-in-master
  276.     proc nonexistent-command-in-master {} {return i_exist!}
  277.     a eval zop
  278. } i_exist!
  279. test interp-9.3 {testing aliases for hidden commands} {
  280.     catch {interp create a}
  281.     a eval {proc p {} {return ENTER_A}}
  282.     interp alias {} p a p
  283.     set res {}
  284.     lappend res [list [catch p msg] $msg]
  285.     interp hide a p
  286.     lappend res [list [catch p msg] $msg]
  287.     rename p {}
  288.     interp delete a
  289.     set res
  290.  } {{0 ENTER_A} {1 {invalid command name "p"}}}
  291. test interp-9.4 {testing aliases and namespace commands} {
  292.     proc p {} {return GLOBAL}
  293.     namespace eval tst {
  294. proc p {} {return NAMESPACE}
  295.     }
  296.     interp alias {} a {} p
  297.     set res [a]
  298.     lappend res [namespace eval tst a]
  299.     rename p {}
  300.     rename a {}
  301.     namespace delete tst
  302.     set res
  303.  } {GLOBAL GLOBAL}
  304. if {[info command nonexistent-command-in-master] != ""} {
  305.     rename nonexistent-command-in-master {}
  306. }
  307. # Part 9: Aliasing between interpreters
  308. test interp-10.1 {testing aliasing between interpreters} {
  309.     catch {interp delete a}
  310.     catch {interp delete b}
  311.     interp create a
  312.     interp create b
  313.     interp alias a a_alias b b_alias 1 2 3
  314. } a_alias
  315. test interp-10.2 {testing aliasing between interpreters} {
  316.     catch {interp delete a}
  317.     catch {interp delete b}
  318.     interp create a
  319.     interp create b
  320.     b eval {proc b_alias {args} {return [list got $args]}}
  321.     interp alias a a_alias b b_alias 1 2 3
  322.     a eval a_alias a b c
  323. } {got {1 2 3 a b c}}
  324. test interp-10.3 {testing aliasing between interpreters} {
  325.     catch {interp delete a}
  326.     catch {interp delete b}
  327.     interp create a
  328.     interp create b
  329.     interp alias a a_alias b b_alias 1 2 3
  330.     list [catch {a eval a_alias a b c} msg] $msg
  331. } {1 {invalid command name "b_alias"}}
  332. test interp-10.4 {testing aliasing between interpreters} {
  333.     catch {interp delete a}
  334.     interp create a
  335.     a alias a_alias puts
  336.     a aliases
  337. } a_alias
  338. test interp-10.5 {testing aliasing between interpreters} {
  339.     catch {interp delete a}
  340.     catch {interp delete b}
  341.     interp create a
  342.     interp create b
  343.     a alias a_alias puts
  344.     interp alias a a_del b b_del
  345.     interp delete b
  346.     a aliases
  347. } a_alias
  348. test interp-10.6 {testing aliasing between interpreters} {
  349.     catch {interp delete a}
  350.     catch {interp delete b}
  351.     interp create a
  352.     interp create b
  353.     interp alias a a_command b b_command a1 a2 a3
  354.     b alias b_command in_master b1 b2 b3
  355.     a eval a_command m1 m2 m3
  356. } {seen in master: {b1 b2 b3 a1 a2 a3 m1 m2 m3}}
  357. test interp-10.7 {testing aliases between interpreters} {
  358.     catch {interp delete a}
  359.     interp create a
  360.     interp alias "" foo a zoppo
  361.     a eval {proc zoppo {x} {list $x $x $x}}
  362.     set x [foo 33]
  363.     a eval {rename zoppo {}}
  364.     interp alias "" foo a {}
  365.     equiv $x
  366. } {33 33 33}
  367. # Part 10: Testing "interp target"
  368. test interp-11.1 {testing interp target} {
  369.     list [catch {interp target} msg] $msg
  370. } {1 {wrong # args: should be "interp target path alias"}}
  371. test interp-11.2 {testing interp target} {
  372.     list [catch {interp target nosuchinterpreter foo} msg] $msg
  373. } {1 {could not find interpreter "nosuchinterpreter"}}
  374. test interp-11.3 {testing interp target} {
  375.     catch {interp delete a}
  376.     interp create a
  377.     a alias boo no_command
  378.     interp target a boo
  379. } ""
  380. test interp-11.4 {testing interp target} {
  381.     catch {interp delete x1}
  382.     interp create x1
  383.     x1 eval interp create x2
  384.     x1 eval x2 eval interp create x3
  385.     catch {interp delete y1}
  386.     interp create y1
  387.     y1 eval interp create y2
  388.     y1 eval y2 eval interp create y3
  389.     interp alias {x1 x2 x3} xcommand {y1 y2 y3} ycommand
  390.     interp target {x1 x2 x3} xcommand
  391. } {y1 y2 y3}
  392. test interp-11.5 {testing interp target} {
  393.     catch {interp delete x1}
  394.     interp create x1
  395.     interp create {x1 x2}
  396.     interp create {x1 x2 x3}
  397.     catch {interp delete y1}
  398.     interp create y1
  399.     interp create {y1 y2}
  400.     interp create {y1 y2 y3}
  401.     interp alias {x1 x2 x3} xcommand {y1 y2 y3} ycommand
  402.     list [catch {x1 eval {interp target {x2 x3} xcommand}} msg] $msg
  403. } {1 {target interpreter for alias "xcommand" in path "x2 x3" is not my descendant}}
  404. test interp-11.6 {testing interp target} {
  405.     foreach a [interp aliases] {
  406. rename $a {}
  407.     }
  408.     list [catch {interp target {} foo} msg] $msg
  409. } {1 {alias "foo" in path "" not found}}
  410. test interp-11.7 {testing interp target} {
  411.     catch {interp delete a}
  412.     interp create a
  413.     list [catch {interp target a foo} msg] $msg
  414. } {1 {alias "foo" in path "a" not found}}
  415. # Part 11: testing "interp issafe"
  416. test interp-12.1 {testing interp issafe} {
  417.     interp issafe
  418. } 0
  419. test interp-12.2 {testing interp issafe} {
  420.     catch {interp delete a}
  421.     interp create a
  422.     interp issafe a
  423. } 0
  424. test interp-12.3 {testing interp issafe} {
  425.     catch {interp delete a}
  426.     interp create a
  427.     interp create {a x3} -safe
  428.     interp issafe {a x3}
  429. } 1
  430. test interp-12.4 {testing interp issafe} {
  431.     catch {interp delete a}
  432.     interp create a
  433.     interp create {a x3} -safe
  434.     interp create {a x3 foo}
  435.     interp issafe {a x3 foo}
  436. } 1
  437. # Part 12: testing interpreter object command "issafe" sub-command
  438. test interp-13.1 {testing foo issafe} {
  439.     catch {interp delete a}
  440.     interp create a
  441.     a issafe
  442. } 0
  443. test interp-13.2 {testing foo issafe} {
  444.     catch {interp delete a}
  445.     interp create a
  446.     interp create {a x3} -safe
  447.     a eval x3 issafe
  448. } 1
  449. test interp-13.3 {testing foo issafe} {
  450.     catch {interp delete a}
  451.     interp create a
  452.     interp create {a x3} -safe
  453.     interp create {a x3 foo}
  454.     a eval x3 eval foo issafe
  455. } 1
  456. test interp-13.4 {testing issafe arg checking} {
  457.     catch {interp create a}
  458.     list [catch {a issafe too many args} msg] $msg
  459. } {1 {wrong # args: should be "a issafe"}}
  460. # part 14: testing interp aliases
  461. test interp-14.1 {testing interp aliases} {
  462.     interp aliases
  463. } ""
  464. test interp-14.2 {testing interp aliases} {
  465.     catch {interp delete a}
  466.     interp create a
  467.     a alias a1 puts
  468.     a alias a2 puts
  469.     a alias a3 puts
  470.     lsort [interp aliases a]
  471. } {a1 a2 a3}
  472. test interp-14.3 {testing interp aliases} {
  473.     catch {interp delete a}
  474.     interp create a
  475.     interp create {a x3}
  476.     interp alias {a x3} froboz "" puts
  477.     interp aliases {a x3}
  478. } froboz
  479. test interp-14.4 {testing interp alias - alias over master} {
  480.     # SF Bug 641195
  481.     catch {interp delete a}
  482.     interp create a
  483.     list [catch {interp alias "" a a eval} msg] $msg [info commands a]
  484. } {1 {cannot define or rename alias "a": interpreter deleted} {}}
  485. # part 15: testing file sharing
  486. test interp-15.1 {testing file sharing} {
  487.     catch {interp delete z}
  488.     interp create z
  489.     z eval close stdout
  490.     list [catch {z eval puts hello} msg] $msg
  491. } {1 {can not find channel named "stdout"}}
  492. test interp-15.2 {testing file sharing} -body {
  493.     catch {interp delete z}
  494.     interp create z
  495.     set f [open [makeFile {} file-15.2] w]
  496.     interp share "" $f z
  497.     z eval puts $f hello
  498.     z eval close $f
  499.     close $f
  500. } -cleanup {
  501.     removeFile file-15.2
  502. } -result ""
  503. test interp-15.3 {testing file sharing} {
  504.     catch {interp delete xsafe}
  505.     interp create xsafe -safe
  506.     list [catch {xsafe eval puts hello} msg] $msg
  507. } {1 {can not find channel named "stdout"}}
  508. test interp-15.4 {testing file sharing} -body {
  509.     catch {interp delete xsafe}
  510.     interp create xsafe -safe
  511.     set f [open [makeFile {} file-15.4] w]
  512.     interp share "" $f xsafe
  513.     xsafe eval puts $f hello
  514.     xsafe eval close $f
  515.     close $f
  516. } -cleanup {
  517.     removeFile file-15.4
  518. } -result ""
  519. test interp-15.5 {testing file sharing} {
  520.     catch {interp delete xsafe}
  521.     interp create xsafe -safe
  522.     interp share "" stdout xsafe
  523.     list [catch {xsafe eval gets stdout} msg] $msg
  524. } {1 {channel "stdout" wasn't opened for reading}}
  525. test interp-15.6 {testing file sharing} -body {
  526.     catch {interp delete xsafe}
  527.     interp create xsafe -safe
  528.     set f [open [makeFile {} file-15.6] w]
  529.     interp share "" $f xsafe
  530.     set x [list [catch [list xsafe eval gets $f] msg] $msg]
  531.     xsafe eval close $f
  532.     close $f
  533.     string compare [string tolower $x] 
  534. [list 1 [format "channel "%s" wasn't opened for reading" $f]]
  535. } -cleanup {
  536.     removeFile file-15.6
  537. } -result 0
  538. test interp-15.7 {testing file transferring} -body {
  539.     catch {interp delete xsafe}
  540.     interp create xsafe -safe
  541.     set f [open [makeFile {} file-15.7] w]
  542.     interp transfer "" $f xsafe
  543.     xsafe eval puts $f hello
  544.     xsafe eval close $f
  545. } -cleanup {
  546.     removeFile file-15.7
  547. } -result ""
  548. test interp-15.8 {testing file transferring} -body {
  549.     catch {interp delete xsafe}
  550.     interp create xsafe -safe
  551.     set f [open [makeFile {} file-15.8] w]
  552.     interp transfer "" $f xsafe
  553.     xsafe eval close $f
  554.     set x [list [catch {close $f} msg] $msg]
  555.     string compare [string tolower $x] 
  556. [list 1 [format "can not find channel named "%s"" $f]]
  557. } -cleanup {
  558.     removeFile file-15.8
  559. } -result 0
  560. #
  561. # Torture tests for interpreter deletion order
  562. #
  563. proc kill {} {interp delete xxx}
  564. test interp-15.9 {testing deletion order} {
  565.     catch {interp delete xxx}
  566.     interp create xxx
  567.     xxx alias kill kill
  568.     list [catch {xxx eval kill} msg] $msg
  569. } {0 {}}
  570. test interp-16.1 {testing deletion order} {
  571.     catch {interp delete xxx}
  572.     interp create xxx
  573.     interp create {xxx yyy}
  574.     interp alias {xxx yyy} kill "" kill
  575.     list [catch {interp eval {xxx yyy} kill} msg] $msg
  576. } {0 {}}
  577. test interp-16.2 {testing deletion order} {
  578.     catch {interp delete xxx}
  579.     interp create xxx
  580.     interp create {xxx yyy}
  581.     interp alias {xxx yyy} kill "" kill
  582.     list [catch {xxx eval yyy eval kill} msg] $msg
  583. } {0 {}}
  584. test interp-16.3 {testing deletion order} {
  585.     catch {interp delete xxx}
  586.     interp create xxx
  587.     interp create ddd
  588.     xxx alias kill kill
  589.     interp alias ddd kill xxx kill
  590.     set x [ddd eval kill]
  591.     interp delete ddd
  592.     set x
  593. } ""
  594. test interp-16.4 {testing deletion order} {
  595.     catch {interp delete xxx}
  596.     interp create xxx
  597.     interp create {xxx yyy}
  598.     interp alias {xxx yyy} kill "" kill
  599.     interp create ddd
  600.     interp alias ddd kill {xxx yyy} kill
  601.     set x [ddd eval kill]
  602.     interp delete ddd
  603.     set x
  604. } ""
  605. test interp-16.5 {testing deletion order, bgerror} {
  606.     catch {interp delete xxx}
  607.     interp create xxx
  608.     xxx eval {proc bgerror {args} {exit}}
  609.     xxx alias exit kill xxx
  610.     proc kill {i} {interp delete $i}
  611.     xxx eval after 100 expr a + b
  612.     after 200
  613.     update
  614.     interp exists xxx
  615. } 0
  616. #
  617. # Alias loop prevention testing.
  618. #
  619. test interp-17.1 {alias loop prevention} {
  620.     list [catch {interp alias {} a {} a} msg] $msg
  621. } {1 {cannot define or rename alias "a": would create a loop}}
  622. test interp-17.2 {alias loop prevention} {
  623.     catch {interp delete x}
  624.     interp create x
  625.     x alias a loop
  626.     list [catch {interp alias {} loop x a} msg] $msg
  627. } {1 {cannot define or rename alias "loop": would create a loop}}
  628. test interp-17.3 {alias loop prevention} {
  629.     catch {interp delete x}
  630.     interp create x
  631.     interp alias x a x b
  632.     list [catch {interp alias x b x a} msg] $msg
  633. } {1 {cannot define or rename alias "b": would create a loop}}
  634. test interp-17.4 {alias loop prevention} {
  635.     catch {interp delete x}
  636.     interp create x
  637.     interp alias x b x a
  638.     list [catch {x eval rename b a} msg] $msg
  639. } {1 {cannot define or rename alias "b": would create a loop}}
  640. test interp-17.5 {alias loop prevention} {
  641.     catch {interp delete x}
  642.     interp create x
  643.     x alias z l1
  644.     interp alias {} l2 x z
  645.     list [catch {rename l2 l1} msg] $msg
  646. } {1 {cannot define or rename alias "l2": would create a loop}}
  647. #
  648. # Test robustness of Tcl_DeleteInterp when applied to a slave interpreter.
  649. # If there are bugs in the implementation these tests are likely to expose
  650. # the bugs as a core dump.
  651. #
  652. if {[info commands testinterpdelete] == ""} {
  653.     puts "This application hasn't been compiled with the "testinterpdelete""
  654.     puts "command, so I can't test slave delete calls"
  655. } else {
  656.     test interp-18.1 {testing Tcl_DeleteInterp vs slaves} {
  657. list [catch {testinterpdelete} msg] $msg
  658.     } {1 {wrong # args: should be "testinterpdelete path"}}
  659.     test interp-18.2 {testing Tcl_DeleteInterp vs slaves} {
  660. catch {interp delete a}
  661. interp create a
  662. testinterpdelete a
  663.     } ""
  664.     test interp-18.3 {testing Tcl_DeleteInterp vs slaves} {
  665. catch {interp delete a}
  666. interp create a
  667. interp create {a b}
  668. testinterpdelete {a b}
  669.     } ""
  670.     test interp-18.4 {testing Tcl_DeleteInterp vs slaves} {
  671. catch {interp delete a}
  672. interp create a
  673. interp create {a b}
  674. testinterpdelete a
  675.     } ""
  676.     test interp-18.5 {testing Tcl_DeleteInterp vs slaves} {
  677. catch {interp delete a}
  678. interp create a
  679. interp create {a b}
  680. interp alias {a b} dodel {} dodel
  681. proc dodel {x} {testinterpdelete $x}
  682. list [catch {interp eval {a b} {dodel {a b}}} msg] $msg
  683.     } {0 {}}
  684.     test interp-18.6 {testing Tcl_DeleteInterp vs slaves} {
  685. catch {interp delete a}
  686. interp create a
  687. interp create {a b}
  688. interp alias {a b} dodel {} dodel
  689. proc dodel {x} {testinterpdelete $x}
  690. list [catch {interp eval {a b} {dodel a}} msg] $msg
  691.     } {0 {}}
  692.     test interp-18.7 {eval in deleted interp} {
  693. catch {interp delete a}
  694. interp create a
  695. a eval {
  696.     proc dodel {} {
  697. delme
  698. dosomething else
  699.     }
  700.     proc dosomething args {
  701. puts "I should not have been called!!"
  702.     }
  703. }
  704. a alias delme dela
  705. proc dela {} {interp delete a}
  706. list [catch {a eval dodel} msg] $msg
  707.     } {1 {attempt to call eval in deleted interpreter}}
  708.     test interp-18.8 {eval in deleted interp} {
  709. catch {interp delete a}
  710. interp create a
  711. a eval {
  712.     interp create b
  713.     b eval {
  714. proc dodel {} {
  715.     dela
  716. }
  717.     }
  718.     proc foo {} {
  719. b eval dela
  720. dosomething else
  721.     }
  722.     proc dosomething args {
  723. puts "I should not have been called!!"
  724.     }
  725. }
  726. interp alias {a b} dela {} dela
  727. proc dela {} {interp delete a}
  728. list [catch {a eval foo} msg] $msg
  729.     } {1 {attempt to call eval in deleted interpreter}}
  730. }
  731. test interp-18.9 {eval in deleted interp, bug 495830} {knownBug} {
  732.     interp create tst
  733.     interp alias tst suicide {} interp delete tst
  734.     list [catch {tst eval {suicide; set a 5}} msg] $msg
  735. } {1 {attempt to call eval in deleted interpreter}}     
  736. test interp-18.10 {eval in deleted interp, bug 495830} {
  737.     interp create tst
  738.     interp alias tst suicide {} interp delete tst
  739.     list [catch {tst eval {set set set; suicide; $set a 5}} msg] $msg
  740. } {1 {attempt to call eval in deleted interpreter}}     
  741. # Test alias deletion
  742. test interp-19.1 {alias deletion} {
  743.     catch {interp delete a}
  744.     interp create a
  745.     interp alias a foo a bar
  746.     set s [interp alias a foo {}]
  747.     interp delete a
  748.     set s
  749. } {}
  750. test interp-19.2 {alias deletion} {
  751.     catch {interp delete a}
  752.     interp create a
  753.     catch {interp alias a foo {}} msg
  754.     interp delete a
  755.     set msg
  756. } {alias "foo" not found}
  757. test interp-19.3 {alias deletion} {
  758.     catch {interp delete a}
  759.     interp create a
  760.     interp alias a foo a bar
  761.     interp eval a {rename foo zop}
  762.     interp alias a foo a zop
  763.     catch {interp eval a foo} msg
  764.     interp delete a
  765.     set msg
  766. } {invalid command name "zop"}
  767. test interp-19.4 {alias deletion} {
  768.     catch {interp delete a}
  769.     interp create a
  770.     interp alias a foo a bar
  771.     interp eval a {rename foo zop}
  772.     catch {interp eval a foo} msg
  773.     interp delete a
  774.     set msg
  775. } {invalid command name "foo"}
  776. test interp-19.5 {alias deletion} {
  777.     catch {interp delete a}
  778.     interp create a
  779.     interp eval a {proc bar {} {return 1}}
  780.     interp alias a foo a bar
  781.     interp eval a {rename foo zop}
  782.     catch {interp eval a zop} msg
  783.     interp delete a
  784.     set msg
  785. } 1
  786. test interp-19.6 {alias deletion} {
  787.     catch {interp delete a}
  788.     interp create a
  789.     interp alias a foo a bar
  790.     interp eval a {rename foo zop}
  791.     interp alias a foo a zop
  792.     set s [interp aliases a]
  793.     interp delete a
  794.     set s
  795. } foo
  796. test interp-19.7 {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 alias a foo {}
  802.     set s [interp aliases a]
  803.     interp delete a
  804.     set s
  805. } {}
  806. test interp-19.8 {alias deletion, renaming} {
  807.     catch {interp delete a}
  808.     interp create a
  809.     interp alias a foo a bar
  810.     interp eval a rename foo blotz
  811.     set l ""
  812.     lappend l [interp aliases a]
  813.     interp alias a foo {}
  814.     lappend l [interp aliases a]
  815.     interp delete a
  816.     set l
  817. } {foo {}}
  818. test interp-19.9 {alias deletion, renaming} {
  819.     catch {interp delete a}
  820.     interp create a
  821.     interp alias a foo a bar
  822.     interp eval a rename foo blotz
  823.     interp eval a {proc foo {} {expr 34 * 34}}
  824.     interp alias a foo {}
  825.     set l [interp eval a foo]
  826.     interp delete a
  827.     set l
  828. } 1156    
  829. test interp-20.1 {interp hide, interp expose and interp invokehidden} {
  830.     catch {interp delete a}
  831.     interp create a
  832.     a eval {proc unknown {x args} {error "invalid command name "$x""}}
  833.     a eval {proc foo {} {}}
  834.     a hide foo
  835.     catch {a eval foo something} msg
  836.     interp delete a
  837.     set msg
  838. } {invalid command name "foo"}
  839. test interp-20.2 {interp hide, interp expose and interp invokehidden} {
  840.     catch {interp delete a}
  841.     interp create a
  842.     a eval {proc unknown {x args} {error "invalid command name "$x""}}
  843.     a hide list
  844.     set l ""
  845.     lappend l [catch {a eval {list 1 2 3}} msg]
  846.     lappend l $msg
  847.     a expose list
  848.     lappend l [catch {a eval {list 1 2 3}} msg]
  849.     lappend l $msg
  850.     interp delete a
  851.     set l
  852. } {1 {invalid command name "list"} 0 {1 2 3}}
  853. test interp-20.3 {interp hide, interp expose and interp invokehidden} {
  854.     catch {interp delete a}
  855.     interp create a
  856.     a eval {proc unknown {x args} {error "invalid command name "$x""}}
  857.     a hide list
  858.     set l ""
  859.     lappend l [catch {a eval {list 1 2 3}} msg]
  860.     lappend l $msg
  861.     lappend l [catch {a invokehidden list 1 2 3} msg]
  862.     lappend l $msg
  863.     a expose list
  864.     lappend l [catch {a eval {list 1 2 3}} msg]
  865.     lappend l $msg
  866.     interp delete a
  867.     set l
  868. } {1 {invalid command name "list"} 0 {1 2 3} 0 {1 2 3}}
  869. test interp-20.4 {interp hide, interp expose and interp invokehidden -- passing {}} {
  870.     catch {interp delete a}
  871.     interp create a
  872.     a eval {proc unknown {x args} {error "invalid command name "$x""}}
  873.     a hide list
  874.     set l ""
  875.     lappend l [catch {a eval {list 1 2 3}} msg]
  876.     lappend l $msg
  877.     lappend l [catch {a invokehidden list {"" 1 2 3}} msg]
  878.     lappend l $msg
  879.     a expose list
  880.     lappend l [catch {a eval {list 1 2 3}} msg]
  881.     lappend l $msg
  882.     interp delete a
  883.     set l
  884. } {1 {invalid command name "list"} 0 {{"" 1 2 3}} 0 {1 2 3}}
  885. test interp-20.5 {interp hide, interp expose and interp invokehidden -- passing {}} {
  886.     catch {interp delete a}
  887.     interp create a
  888.     a eval {proc unknown {x args} {error "invalid command name "$x""}}
  889.     a hide list
  890.     set l ""
  891.     lappend l [catch {a eval {list 1 2 3}} msg]
  892.     lappend l $msg
  893.     lappend l [catch {a invokehidden list {{} 1 2 3}} msg]
  894.     lappend l $msg
  895.     a expose list
  896.     lappend l [catch {a eval {list 1 2 3}} msg]
  897.     lappend l $msg
  898.     interp delete a
  899.     set l
  900. } {1 {invalid command name "list"} 0 {{{} 1 2 3}} 0 {1 2 3}}
  901. test interp-20.6 {interp invokehidden -- eval args} {
  902.     catch {interp delete a}
  903.     interp create a
  904.     a hide list
  905.     set l ""
  906.     set z 45
  907.     lappend l [catch {a invokehidden list $z 1 2 3} msg]
  908.     lappend l $msg
  909.     a expose list
  910.     lappend l [catch {a eval list $z 1 2 3} msg]
  911.     lappend l $msg
  912.     interp delete a
  913.     set l
  914. } {0 {45 1 2 3} 0 {45 1 2 3}}
  915. test interp-20.7 {interp invokehidden vs variable eval} {
  916.     catch {interp delete a}
  917.     interp create a
  918.     a hide list
  919.     set z 45
  920.     set l ""
  921.     lappend l [catch {a invokehidden list {$z a b c}} msg]
  922.     lappend l $msg
  923.     interp delete a
  924.     set l
  925. } {0 {{$z a b c}}}
  926. test interp-20.8 {interp invokehidden vs variable eval} {
  927.     catch {interp delete a}
  928.     interp create a
  929.     a hide list
  930.     a eval set z 89
  931.     set z 45
  932.     set l ""
  933.     lappend l [catch {a invokehidden list {$z a b c}} msg]
  934.     lappend l $msg
  935.     interp delete a
  936.     set l
  937. } {0 {{$z a b c}}}
  938. test interp-20.9 {interp invokehidden vs variable eval} {
  939.     catch {interp delete a}
  940.     interp create a
  941.     a hide list
  942.     a eval set z 89
  943.     set z 45
  944.     set l ""
  945.     lappend l [catch {a invokehidden list $z {$z a b c}} msg]
  946.     lappend l $msg
  947.     interp delete a
  948.     set l
  949. } {0 {45 {$z a b c}}}
  950. test interp-20.10 {interp hide, interp expose and interp invokehidden} {
  951.     catch {interp delete a}
  952.     interp create a
  953.     a eval {proc unknown {x args} {error "invalid command name "$x""}}
  954.     a eval {proc foo {} {}}
  955.     interp hide a foo
  956.     catch {interp eval a foo something} msg
  957.     interp delete a
  958.     set msg
  959. } {invalid command name "foo"}
  960. test interp-20.11 {interp hide, interp expose and interp invokehidden} {
  961.     catch {interp delete a}
  962.     interp create a
  963.     a eval {proc unknown {x args} {error "invalid command name "$x""}}
  964.     interp hide a list
  965.     set l ""
  966.     lappend l [catch {interp eval a {list 1 2 3}} msg]
  967.     lappend l $msg
  968.     interp expose a list
  969.     lappend l [catch {interp eval a {list 1 2 3}} msg]
  970.     lappend l $msg
  971.     interp delete a
  972.     set l
  973. } {1 {invalid command name "list"} 0 {1 2 3}}
  974. test interp-20.12 {interp hide, interp expose and interp invokehidden} {
  975.     catch {interp delete a}
  976.     interp create a
  977.     a eval {proc unknown {x args} {error "invalid command name "$x""}}
  978.     interp hide a list
  979.     set l ""
  980.     lappend l [catch {interp eval a {list 1 2 3}} msg]
  981.     lappend l $msg
  982.     lappend l [catch {interp invokehidden a list 1 2 3} msg]
  983.     lappend l $msg
  984.     interp expose a list
  985.     lappend l [catch {interp eval a {list 1 2 3}} msg]
  986.     lappend l $msg
  987.     interp delete a
  988.     set l
  989. } {1 {invalid command name "list"} 0 {1 2 3} 0 {1 2 3}}
  990. test interp-20.13 {interp hide, interp expose, interp invokehidden -- passing {}} {
  991.     catch {interp delete a}
  992.     interp create a
  993.     a eval {proc unknown {x args} {error "invalid command name "$x""}}
  994.     interp hide a list
  995.     set l ""
  996.     lappend l [catch {interp eval a {list 1 2 3}} msg]
  997.     lappend l $msg
  998.     lappend l [catch {interp invokehidden a list {"" 1 2 3}} msg]
  999.     lappend l $msg
  1000.     interp expose a list
  1001.     lappend l [catch {interp eval a {list 1 2 3}} msg]
  1002.     lappend l $msg
  1003.     interp delete a
  1004.     set l
  1005. } {1 {invalid command name "list"} 0 {{"" 1 2 3}} 0 {1 2 3}}
  1006. test interp-20.14 {interp hide, interp expose, interp invokehidden -- passing {}} {
  1007.     catch {interp delete a}
  1008.     interp create a
  1009.     a eval {proc unknown {x args} {error "invalid command name "$x""}}
  1010.     interp hide a list
  1011.     set l ""
  1012.     lappend l [catch {interp eval a {list 1 2 3}} msg]
  1013.     lappend l $msg
  1014.     lappend l [catch {interp invokehidden a list {{} 1 2 3}} msg]
  1015.     lappend l $msg
  1016.     interp expose a list
  1017.     lappend l [catch {a eval {list 1 2 3}} msg]
  1018.     lappend l $msg
  1019.     interp delete a
  1020.     set l
  1021. } {1 {invalid command name "list"} 0 {{{} 1 2 3}} 0 {1 2 3}}
  1022. test interp-20.15 {interp invokehidden -- eval args} {
  1023.     catch {interp delete a}
  1024.     interp create a
  1025.     interp hide a list
  1026.     set l ""
  1027.     set z 45
  1028.     lappend l [catch {interp invokehidden a list $z 1 2 3} msg]
  1029.     lappend l $msg
  1030.     a expose list
  1031.     lappend l [catch {interp eval a list $z 1 2 3} msg]
  1032.     lappend l $msg
  1033.     interp delete a
  1034.     set l
  1035. } {0 {45 1 2 3} 0 {45 1 2 3}}
  1036. test interp-20.16 {interp invokehidden vs variable eval} {
  1037.     catch {interp delete a}
  1038.     interp create a
  1039.     interp hide a list
  1040.     set z 45
  1041.     set l ""
  1042.     lappend l [catch {interp invokehidden a list {$z a b c}} msg]
  1043.     lappend l $msg
  1044.     interp delete a
  1045.     set l
  1046. } {0 {{$z a b c}}}
  1047. test interp-20.17 {interp invokehidden vs variable eval} {
  1048.     catch {interp delete a}
  1049.     interp create a
  1050.     interp hide a list
  1051.     a eval set z 89
  1052.     set z 45
  1053.     set l ""
  1054.     lappend l [catch {interp invokehidden a list {$z a b c}} msg]
  1055.     lappend l $msg
  1056.     interp delete a
  1057.     set l
  1058. } {0 {{$z a b c}}}
  1059. test interp-20.18 {interp invokehidden vs variable eval} {
  1060.     catch {interp delete a}
  1061.     interp create a
  1062.     interp hide a list
  1063.     a eval set z 89
  1064.     set z 45
  1065.     set l ""
  1066.     lappend l [catch {interp invokehidden a list $z {$z a b c}} msg]
  1067.     lappend l $msg
  1068.     interp delete a
  1069.     set l
  1070. } {0 {45 {$z a b c}}}
  1071. test interp-20.19 {interp invokehidden vs nested commands} {
  1072.     catch {interp delete a}
  1073.     interp create a
  1074.     a hide list
  1075.     set l [a invokehidden list {[list x y z] f g h} z]
  1076.     interp delete a
  1077.     set l
  1078. } {{[list x y z] f g h} z}
  1079. test interp-20.20 {interp invokehidden vs nested commands} {
  1080.     catch {interp delete a}
  1081.     interp create a
  1082.     a hide list
  1083.     set l [interp invokehidden a list {[list x y z] f g h} z]
  1084.     interp delete a
  1085.     set l
  1086. } {{[list x y z] f g h} z}
  1087. test interp-20.21 {interp hide vs safety} {
  1088.     catch {interp delete a}
  1089.     interp create a -safe
  1090.     set l ""
  1091.     lappend l [catch {a hide list} msg]    
  1092.     lappend l $msg
  1093.     interp delete a
  1094.     set l
  1095. } {0 {}}
  1096. test interp-20.22 {interp hide vs safety} {
  1097.     catch {interp delete a}
  1098.     interp create a -safe
  1099.     set l ""
  1100.     lappend l [catch {interp hide a list} msg]    
  1101.     lappend l $msg
  1102.     interp delete a
  1103.     set l
  1104. } {0 {}}
  1105. test interp-20.23 {interp hide vs safety} {
  1106.     catch {interp delete a}
  1107.     interp create a -safe
  1108.     set l ""
  1109.     lappend l [catch {a eval {interp hide {} list}} msg]    
  1110.     lappend l $msg
  1111.     interp delete a
  1112.     set l
  1113. } {1 {permission denied: safe interpreter cannot hide commands}}
  1114. test interp-20.24 {interp hide vs safety} {
  1115.     catch {interp delete a}
  1116.     interp create a -safe
  1117.     interp create {a b}
  1118.     set l ""
  1119.     lappend l [catch {a eval {interp hide b list}} msg]    
  1120.     lappend l $msg
  1121.     interp delete a
  1122.     set l
  1123. } {1 {permission denied: safe interpreter cannot hide commands}}
  1124. test interp-20.25 {interp hide vs safety} {
  1125.     catch {interp delete a}
  1126.     interp create a -safe
  1127.     interp create {a b}
  1128.     set l ""
  1129.     lappend l [catch {interp hide {a b} list} msg]
  1130.     lappend l $msg
  1131.     interp delete a
  1132.     set l
  1133. } {0 {}}
  1134. test interp-20.26 {interp expoose vs safety} {
  1135.     catch {interp delete a}
  1136.     interp create a -safe
  1137.     set l ""
  1138.     lappend l [catch {a hide list} msg]    
  1139.     lappend l $msg
  1140.     lappend l [catch {a expose list} msg]
  1141.     lappend l $msg
  1142.     interp delete a
  1143.     set l
  1144. } {0 {} 0 {}}
  1145. test interp-20.27 {interp expose vs safety} {
  1146.     catch {interp delete a}
  1147.     interp create a -safe
  1148.     set l ""
  1149.     lappend l [catch {interp hide a list} msg]    
  1150.     lappend l $msg
  1151.     lappend l [catch {interp expose a list} msg]    
  1152.     lappend l $msg
  1153.     interp delete a
  1154.     set l
  1155. } {0 {} 0 {}}
  1156. test interp-20.28 {interp expose vs safety} {
  1157.     catch {interp delete a}
  1158.     interp create a -safe
  1159.     set l ""
  1160.     lappend l [catch {a hide list} msg]    
  1161.     lappend l $msg
  1162.     lappend l [catch {a eval {interp expose {} list}} msg]
  1163.     lappend l $msg
  1164.     interp delete a
  1165.     set l
  1166. } {0 {} 1 {permission denied: safe interpreter cannot expose commands}}
  1167. test interp-20.29 {interp expose vs safety} {
  1168.     catch {interp delete a}
  1169.     interp create a -safe
  1170.     set l ""
  1171.     lappend l [catch {interp hide a list} msg]    
  1172.     lappend l $msg
  1173.     lappend l [catch {a eval {interp expose {} list}} msg]    
  1174.     lappend l $msg
  1175.     interp delete a
  1176.     set l
  1177. } {0 {} 1 {permission denied: safe interpreter cannot expose commands}}
  1178. test interp-20.30 {interp expose vs safety} {
  1179.     catch {interp delete a}
  1180.     interp create a -safe
  1181.     interp create {a b}
  1182.     set l ""
  1183.     lappend l [catch {interp hide {a b} list} msg]    
  1184.     lappend l $msg
  1185.     lappend l [catch {a eval {interp expose b list}} msg]    
  1186.     lappend l $msg
  1187.     interp delete a
  1188.     set l
  1189. } {0 {} 1 {permission denied: safe interpreter cannot expose commands}}
  1190. test interp-20.31 {interp expose vs safety} {
  1191.     catch {interp delete a}
  1192.     interp create a -safe
  1193.     interp create {a b}
  1194.     set l ""
  1195.     lappend l [catch {interp hide {a b} list} msg]    
  1196.     lappend l $msg
  1197.     lappend l [catch {interp expose {a b} list} msg]
  1198.     lappend l $msg
  1199.     interp delete a
  1200.     set l
  1201. } {0 {} 0 {}}
  1202. test interp-20.32 {interp invokehidden vs safety} {
  1203.     catch {interp delete a}
  1204.     interp create a -safe
  1205.     interp hide a list
  1206.     set l ""
  1207.     lappend l [catch {a eval {interp invokehidden {} list a b c}} msg]
  1208.     lappend l $msg
  1209.     interp delete a
  1210.     set l
  1211. } {1 {not allowed to invoke hidden commands from safe interpreter}}
  1212. test interp-20.33 {interp invokehidden vs safety} {
  1213.     catch {interp delete a}
  1214.     interp create a -safe
  1215.     interp hide a list
  1216.     set l ""
  1217.     lappend l [catch {a eval {interp invokehidden {} list a b c}} msg]
  1218.     lappend l $msg
  1219.     lappend l [catch {a invokehidden list a b c} msg]
  1220.     lappend l $msg
  1221.     interp delete a
  1222.     set l
  1223. } {1 {not allowed to invoke hidden commands from safe interpreter}
  1224. 0 {a b c}}
  1225. test interp-20.34 {interp invokehidden vs safety} {
  1226.     catch {interp delete a}
  1227.     interp create a -safe
  1228.     interp create {a b}
  1229.     interp hide {a b} list
  1230.     set l ""
  1231.     lappend l [catch {a eval {interp invokehidden b list a b c}} msg]
  1232.     lappend l $msg
  1233.     lappend l [catch {interp invokehidden {a b} list a b c} msg]
  1234.     lappend l $msg
  1235.     interp delete a
  1236.     set l
  1237. } {1 {not allowed to invoke hidden commands from safe interpreter}
  1238. 0 {a b c}}
  1239. test interp-20.35 {invokehidden at local level} {
  1240.     catch {interp delete a}
  1241.     interp create a
  1242.     a eval {
  1243. proc p1 {} {
  1244.     set z 90
  1245.     a1
  1246.     set z
  1247. }
  1248. proc h1 {} {
  1249.     upvar z z
  1250.     set z 91
  1251. }
  1252.     }
  1253.     a hide h1
  1254.     a alias a1 a1
  1255.     proc a1 {} {
  1256. interp invokehidden a h1
  1257.     }
  1258.     set r [interp eval a p1]
  1259.     interp delete a
  1260.     set r
  1261. } 91
  1262. test interp-20.36 {invokehidden at local level} {
  1263.     catch {interp delete a}
  1264.     interp create a
  1265.     a eval {
  1266. set z 90
  1267. proc p1 {} {
  1268.     global z
  1269.     a1
  1270.     set z
  1271. }
  1272. proc h1 {} {
  1273.     upvar z z
  1274.     set z 91
  1275. }
  1276.     }
  1277.     a hide h1
  1278.     a alias a1 a1
  1279.     proc a1 {} {
  1280. interp invokehidden a h1
  1281.     }
  1282.     set r [interp eval a p1]
  1283.     interp delete a
  1284.     set r
  1285. } 91
  1286. test interp-20.37 {invokehidden at local level} {
  1287.     catch {interp delete a}
  1288.     interp create a
  1289.     a eval {
  1290. proc p1 {} {
  1291.     a1
  1292.     set z
  1293. }
  1294. proc h1 {} {
  1295.     upvar z z
  1296.     set z 91
  1297. }
  1298.     }
  1299.     a hide h1
  1300.     a alias a1 a1
  1301.     proc a1 {} {
  1302. interp invokehidden a h1
  1303.     }
  1304.     set r [interp eval a p1]
  1305.     interp delete a
  1306.     set r
  1307. } 91
  1308. test interp-20.38 {invokehidden at global level} {
  1309.     catch {interp delete a}
  1310.     interp create a
  1311.     a eval {
  1312. proc p1 {} {
  1313.     a1
  1314.     set z
  1315. }
  1316. proc h1 {} {
  1317.     upvar z z
  1318.     set z 91
  1319. }
  1320.     }
  1321.     a hide h1
  1322.     a alias a1 a1
  1323.     proc a1 {} {
  1324. interp invokehidden a -global h1
  1325.     }
  1326.     set r [catch {interp eval a p1} msg]
  1327.     interp delete a
  1328.     list $r $msg
  1329. } {1 {can't read "z": no such variable}}
  1330. test interp-20.39 {invokehidden at global level} {
  1331.     catch {interp delete a}
  1332.     interp create a
  1333.     a eval {
  1334. proc p1 {} {
  1335.     global z
  1336.     a1
  1337.     set z
  1338. }
  1339. proc h1 {} {
  1340.     upvar z z
  1341.     set z 91
  1342. }
  1343.     }
  1344.     a hide h1
  1345.     a alias a1 a1
  1346.     proc a1 {} {
  1347. interp invokehidden a -global h1
  1348.     }
  1349.     set r [catch {interp eval a p1} msg]
  1350.     interp delete a
  1351.     list $r $msg
  1352. } {0 91}
  1353. test interp-20.40 {safe, invokehidden at local level} {
  1354.     catch {interp delete a}
  1355.     interp create a -safe
  1356.     a eval {
  1357. proc p1 {} {
  1358.     set z 90
  1359.     a1
  1360.     set z
  1361. }
  1362. proc h1 {} {
  1363.     upvar z z
  1364.     set z 91
  1365. }
  1366.     }
  1367.     a hide h1
  1368.     a alias a1 a1
  1369.     proc a1 {} {
  1370. interp invokehidden a h1
  1371.     }
  1372.     set r [interp eval a p1]
  1373.     interp delete a
  1374.     set r
  1375. } 91
  1376. test interp-20.41 {safe, invokehidden at local level} {
  1377.     catch {interp delete a}
  1378.     interp create a -safe
  1379.     a eval {
  1380. set z 90
  1381. proc p1 {} {
  1382.     global z
  1383.     a1
  1384.     set z
  1385. }
  1386. proc h1 {} {
  1387.     upvar z z
  1388.     set z 91
  1389. }
  1390.     }
  1391.     a hide h1
  1392.     a alias a1 a1
  1393.     proc a1 {} {
  1394. interp invokehidden a h1
  1395.     }
  1396.     set r [interp eval a p1]
  1397.     interp delete a
  1398.     set r
  1399. } 91
  1400. test interp-20.42 {safe, invokehidden at local level} {
  1401.     catch {interp delete a}
  1402.     interp create a -safe
  1403.     a eval {
  1404. proc p1 {} {
  1405.     a1
  1406.     set z
  1407. }
  1408. proc h1 {} {
  1409.     upvar z z
  1410.     set z 91
  1411. }
  1412.     }
  1413.     a hide h1
  1414.     a alias a1 a1
  1415.     proc a1 {} {
  1416. interp invokehidden a h1
  1417.     }
  1418.     set r [interp eval a p1]
  1419.     interp delete a
  1420.     set r
  1421. } 91
  1422. test interp-20.43 {invokehidden at global level} {
  1423.     catch {interp delete a}
  1424.     interp create a
  1425.     a eval {
  1426. proc p1 {} {
  1427.     a1
  1428.     set z
  1429. }
  1430. proc h1 {} {
  1431.     upvar z z
  1432.     set z 91
  1433. }
  1434.     }
  1435.     a hide h1
  1436.     a alias a1 a1
  1437.     proc a1 {} {
  1438. interp invokehidden a -global h1
  1439.     }
  1440.     set r [catch {interp eval a p1} msg]
  1441.     interp delete a
  1442.     list $r $msg
  1443. } {1 {can't read "z": no such variable}}
  1444. test interp-20.44 {invokehidden at global level} {
  1445.     catch {interp delete a}
  1446.     interp create a
  1447.     a eval {
  1448. proc p1 {} {
  1449.     global z
  1450.     a1
  1451.     set z
  1452. }
  1453. proc h1 {} {
  1454.     upvar z z
  1455.     set z 91
  1456. }
  1457.     }
  1458.     a hide h1
  1459.     a alias a1 a1
  1460.     proc a1 {} {
  1461. interp invokehidden a -global h1
  1462.     }
  1463.     set r [catch {interp eval a p1} msg]
  1464.     interp delete a
  1465.     list $r $msg
  1466. } {0 91}
  1467. test interp-20.45 {interp hide vs namespaces} {
  1468.     catch {interp delete a}
  1469.     interp create a
  1470.     a eval {
  1471.         namespace eval foo {}
  1472. proc foo::x {} {}
  1473.     }
  1474.     set l [list [catch {interp hide a foo::x} msg] $msg]
  1475.     interp delete a
  1476.     set l
  1477. } {1 {cannot use namespace qualifiers in hidden command token (rename)}}
  1478. test interp-20.46 {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 x} msg] $msg]
  1486.     interp delete a
  1487.     set l
  1488. } {1 {can only hide global namespace commands (use rename then hide)}}
  1489. test interp-20.47 {interp hide vs namespaces} {
  1490.     catch {interp delete a}
  1491.     interp create a
  1492.     a eval {
  1493. proc x {} {}
  1494.     }
  1495.     set l [list [catch {interp hide a x foo::x} msg] $msg]
  1496.     interp delete a
  1497.     set l
  1498. } {1 {cannot use namespace qualifiers in hidden command token (rename)}}
  1499. test interp-20.48 {interp hide vs namespaces} {
  1500.     catch {interp delete a}
  1501.     interp create a
  1502.     a eval {
  1503.         namespace eval foo {}
  1504. proc foo::x {} {}
  1505.     }
  1506.     set l [list [catch {interp hide a foo::x bar::x} msg] $msg]
  1507.     interp delete a
  1508.     set l
  1509. } {1 {cannot use namespace qualifiers in hidden command token (rename)}}
  1510. test interp-21.1 {interp hidden} {
  1511.     interp hidden {}
  1512. } ""
  1513. test interp-21.2 {interp hidden} {
  1514.     interp hidden
  1515. } ""
  1516. test interp-21.3 {interp hidden vs interp hide, interp expose} {
  1517.     set l ""
  1518.     lappend l [interp hidden]
  1519.     interp hide {} pwd
  1520.     lappend l [interp hidden]
  1521.     interp expose {} pwd
  1522.     lappend l [interp hidden]
  1523.     set l
  1524. } {{} pwd {}}
  1525. test interp-21.4 {interp hidden} {
  1526.     catch {interp delete a}
  1527.     interp create a
  1528.     set l [interp hidden a]
  1529.     interp delete a
  1530.     set l
  1531. } ""
  1532. test interp-21.5 {interp hidden} {
  1533.     catch {interp delete a}
  1534.     interp create -safe a
  1535.     set l [lsort [interp hidden a]]
  1536.     interp delete a
  1537.     set l
  1538. } $hidden_cmds 
  1539. test interp-21.6 {interp hidden vs interp hide, interp expose} {
  1540.     catch {interp delete a}
  1541.     interp create a
  1542.     set l ""
  1543.     lappend l [interp hidden a]
  1544.     interp hide a pwd
  1545.     lappend l [interp hidden a]
  1546.     interp expose a pwd
  1547.     lappend l [interp hidden a]
  1548.     interp delete a
  1549.     set l
  1550. } {{} pwd {}}
  1551. test interp-21.7 {interp hidden} {
  1552.     catch {interp delete a}
  1553.     interp create a
  1554.     set l [a hidden]
  1555.     interp delete a
  1556.     set l
  1557. } ""
  1558. test interp-21.8 {interp hidden} {
  1559.     catch {interp delete a}
  1560.     interp create a -safe
  1561.     set l [lsort [a hidden]]
  1562.     interp delete a
  1563.     set l
  1564. } $hidden_cmds
  1565. test interp-21.9 {interp hidden vs interp hide, interp expose} {
  1566.     catch {interp delete a}
  1567.     interp create a
  1568.     set l ""
  1569.     lappend l [a hidden]
  1570.     a hide pwd
  1571.     lappend l [a hidden]
  1572.     a expose pwd
  1573.     lappend l [a hidden]
  1574.     interp delete a
  1575.     set l
  1576. } {{} pwd {}}
  1577. test interp-22.1 {testing interp marktrusted} {
  1578.     catch {interp delete a}
  1579.     interp create a
  1580.     set l ""
  1581.     lappend l [a issafe]
  1582.     lappend l [a marktrusted]
  1583.     lappend l [a issafe]
  1584.     interp delete a
  1585.     set l
  1586. } {0 {} 0}
  1587. test interp-22.2 {testing interp marktrusted} {
  1588.     catch {interp delete a}
  1589.     interp create a
  1590.     set l ""
  1591.     lappend l [interp issafe a]
  1592.     lappend l [interp marktrusted a]
  1593.     lappend l [interp issafe a]
  1594.     interp delete a
  1595.     set l
  1596. } {0 {} 0}
  1597. test interp-22.3 {testing interp marktrusted} {
  1598.     catch {interp delete a}
  1599.     interp create a -safe
  1600.     set l ""
  1601.     lappend l [a issafe]
  1602.     lappend l [a marktrusted]
  1603.     lappend l [a issafe]
  1604.     interp delete a
  1605.     set l
  1606. } {1 {} 0}
  1607. test interp-22.4 {testing interp marktrusted} {
  1608.     catch {interp delete a}
  1609.     interp create a -safe
  1610.     set l ""
  1611.     lappend l [interp issafe a]
  1612.     lappend l [interp marktrusted a]
  1613.     lappend l [interp issafe a]
  1614.     interp delete a
  1615.     set l
  1616. } {1 {} 0}
  1617. test interp-22.5 {testing interp marktrusted} {
  1618.     catch {interp delete a}
  1619.     interp create a -safe
  1620.     interp create {a b}
  1621.     catch {a eval {interp marktrusted b}} msg
  1622.     interp delete a
  1623.     set msg
  1624. } {permission denied: safe interpreter cannot mark trusted}
  1625. test interp-22.6 {testing interp marktrusted} {
  1626.     catch {interp delete a}
  1627.     interp create a -safe
  1628.     interp create {a b}
  1629.     catch {a eval {b marktrusted}} msg
  1630.     interp delete a
  1631.     set msg
  1632. } {permission denied: safe interpreter cannot mark trusted}
  1633. test interp-22.7 {testing interp marktrusted} {
  1634.     catch {interp delete a}
  1635.     interp create a -safe
  1636.     set l ""
  1637.     lappend l [interp issafe a]
  1638.     interp marktrusted a
  1639.     interp create {a b}
  1640.     lappend l [interp issafe a]
  1641.     lappend l [interp issafe {a b}]
  1642.     interp delete a
  1643.     set l
  1644. } {1 0 0}
  1645. test interp-22.8 {testing interp marktrusted} {
  1646.     catch {interp delete a}
  1647.     interp create a -safe
  1648.     set l ""
  1649.     lappend l [interp issafe a]
  1650.     interp create {a b}
  1651.     lappend l [interp issafe {a b}]
  1652.     interp marktrusted a
  1653.     interp create {a c}
  1654.     lappend l [interp issafe a]
  1655.     lappend l [interp issafe {a c}]
  1656.     interp delete a
  1657.     set l
  1658. } {1 1 0 0}
  1659. test interp-22.9 {testing interp marktrusted} {
  1660.     catch {interp delete a}
  1661.     interp create a -safe
  1662.     set l ""
  1663.     lappend l [interp issafe a]
  1664.     interp create {a b}
  1665.     lappend l [interp issafe {a b}]
  1666.     interp marktrusted {a b}
  1667.     lappend l [interp issafe a]
  1668.     lappend l [interp issafe {a b}]
  1669.     interp create {a b c}
  1670.     lappend l [interp issafe {a b c}]
  1671.     interp delete a
  1672.     set l
  1673. } {1 1 1 0 0}
  1674. test interp-23.1 {testing hiding vs aliases} {
  1675.     catch {interp delete a}
  1676.     interp create a
  1677.     set l ""
  1678.     lappend l [interp hidden a]
  1679.     a alias bar bar
  1680.     lappend l [interp aliases a]
  1681.     lappend l [interp hidden a]
  1682.     a hide bar
  1683.     lappend l [interp aliases a]
  1684.     lappend l [interp hidden a]
  1685.     a alias bar {}
  1686.     lappend l [interp aliases a]
  1687.     lappend l [interp hidden a]
  1688.     interp delete a
  1689.     set l
  1690. } {{} bar {} bar bar {} {}}
  1691. test interp-23.2 {testing hiding vs aliases} {unixOrPc} {
  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. } {{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}} 
  1708. test interp-23.3 {testing hiding vs aliases} {macOnly} {
  1709.     catch {interp delete a}
  1710.     interp create a -safe
  1711.     set l ""
  1712.     lappend l [lsort [interp hidden a]]
  1713.     a alias bar bar
  1714.     lappend l [interp aliases a]
  1715.     lappend l [lsort [interp hidden a]]
  1716.     a hide bar
  1717.     lappend l [interp aliases a]
  1718.     lappend l [lsort [interp hidden a]]
  1719.     a alias bar {}
  1720.     lappend l [interp aliases a]
  1721.     lappend l [lsort [interp hidden a]]
  1722.     interp delete a
  1723.     set l
  1724. } {{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}} 
  1725. test interp-24.1 {result resetting on error} {
  1726.     catch {interp delete a}
  1727.     interp create a
  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}}
  1741. test interp-24.2 {result resetting on error} {
  1742.     catch {interp delete a}
  1743.     interp create a -safe
  1744.     proc foo args {error $args}
  1745.     interp alias a foo {} foo
  1746.     set l [interp eval a {
  1747. set l {}
  1748. lappend l [catch {foo 1 2 3} msg]
  1749. lappend l $msg
  1750. lappend l [catch {foo 3 4 5} msg]
  1751. lappend l $msg
  1752. set l
  1753.     }]
  1754.     interp delete a
  1755.     set l
  1756. } {1 {1 2 3} 1 {3 4 5}}
  1757. test interp-24.3 {result resetting on error} {
  1758.     catch {interp delete a}
  1759.     interp create a
  1760.     interp create {a b}
  1761.     interp eval a {
  1762. proc foo args {error $args}
  1763.     }
  1764.     interp alias {a b} foo a foo
  1765.     set l [interp eval {a b} {
  1766. set l {}
  1767. lappend l [catch {foo 1 2 3} msg]
  1768. lappend l $msg
  1769. lappend l [catch {foo 3 4 5} msg]
  1770. lappend l $msg
  1771. set l
  1772.     }]
  1773.     interp delete a
  1774.     set l
  1775. } {1 {1 2 3} 1 {3 4 5}}
  1776. test interp-24.4 {result resetting on error} {
  1777.     catch {interp delete a}
  1778.     interp create a -safe
  1779.     interp create {a b}
  1780.     interp eval a {
  1781. proc foo args {error $args}
  1782.     }
  1783.     interp alias {a b} foo a foo
  1784.     set l [interp eval {a b} {
  1785. set l {}
  1786. lappend l [catch {foo 1 2 3} msg]
  1787. lappend l $msg
  1788. lappend l [catch {foo 3 4 5} msg]
  1789. lappend l $msg
  1790. set l
  1791.     }]
  1792.     interp delete a
  1793.     set l
  1794. } {1 {1 2 3} 1 {3 4 5}}
  1795. test interp-24.5 {result resetting on error} {
  1796.     catch {interp delete a}
  1797.     catch {interp delete b}
  1798.     interp create a
  1799.     interp create b
  1800.     interp eval a {
  1801. proc foo args {error $args}
  1802.     }
  1803.     interp alias b foo a foo
  1804.     set l [interp eval b {
  1805. set l {}
  1806. lappend l [catch {foo 1 2 3} msg]
  1807. lappend l $msg
  1808. lappend l [catch {foo 3 4 5} msg]
  1809. lappend l $msg
  1810. set l
  1811.     }]
  1812.     interp delete a
  1813.     set l
  1814. } {1 {1 2 3} 1 {3 4 5}}
  1815. test interp-24.6 {result resetting on error} {
  1816.     catch {interp delete a}
  1817.     catch {interp delete b}
  1818.     interp create a -safe
  1819.     interp create b -safe
  1820.     interp eval a {
  1821. proc foo args {error $args}
  1822.     }
  1823.     interp alias b foo a foo
  1824.     set l [interp eval b {
  1825. set l {}
  1826. lappend l [catch {foo 1 2 3} msg]
  1827. lappend l $msg
  1828. lappend l [catch {foo 3 4 5} msg]
  1829. lappend l $msg
  1830. set l
  1831.     }]
  1832.     interp delete a
  1833.     set l
  1834. } {1 {1 2 3} 1 {3 4 5}}
  1835. test interp-24.7 {result resetting on error} {
  1836.     catch {interp delete a}
  1837.     interp create a
  1838.     interp eval a {
  1839. proc foo args {error $args}
  1840.     }
  1841.     set l {}
  1842.     lappend l [catch {interp eval a foo 1 2 3} msg]
  1843.     lappend l $msg
  1844.     lappend l [catch {interp eval a foo 3 4 5} msg]
  1845.     lappend l $msg
  1846.     interp delete a
  1847.     set l
  1848. } {1 {1 2 3} 1 {3 4 5}}
  1849. test interp-24.8 {result resetting on error} {
  1850.     catch {interp delete a}
  1851.     interp create a -safe
  1852.     interp eval a {
  1853. proc foo args {error $args}
  1854.     }
  1855.     set l {}
  1856.     lappend l [catch {interp eval a foo 1 2 3} msg]
  1857.     lappend l $msg
  1858.     lappend l [catch {interp eval a foo 3 4 5} msg]
  1859.     lappend l $msg
  1860.     interp delete a
  1861.     set l
  1862. } {1 {1 2 3} 1 {3 4 5}}
  1863. test interp-24.9 {result resetting on error} {
  1864.     catch {interp delete a}
  1865.     interp create a
  1866.     interp create {a b}
  1867.     interp eval {a b} {
  1868. proc foo args {error $args}
  1869.     }
  1870.     interp eval a {
  1871. proc foo args {
  1872.     eval interp eval b foo $args
  1873. }
  1874.     }
  1875.     set l {}
  1876.     lappend l [catch {interp eval a foo 1 2 3} msg]
  1877.     lappend l $msg
  1878.     lappend l [catch {interp eval a foo 3 4 5} msg]
  1879.     lappend l $msg
  1880.     interp delete a
  1881.     set l
  1882. } {1 {1 2 3} 1 {3 4 5}}
  1883. test interp-24.10 {result resetting on error} {
  1884.     catch {interp delete a}
  1885.     interp create a -safe
  1886.     interp create {a b}
  1887.     interp eval {a b} {
  1888. proc foo args {error $args}
  1889.     }
  1890.     interp eval a {
  1891. proc foo args {
  1892.     eval interp eval b foo $args
  1893. }
  1894.     }
  1895.     set l {}
  1896.     lappend l [catch {interp eval a foo 1 2 3} msg]
  1897.     lappend l $msg
  1898.     lappend l [catch {interp eval a foo 3 4 5} msg]
  1899.     lappend l $msg
  1900.     interp delete a
  1901.     set l
  1902. } {1 {1 2 3} 1 {3 4 5}}
  1903. test interp-24.11 {result resetting on error} {
  1904.     catch {interp delete a}
  1905.     interp create a
  1906.     interp create {a b}
  1907.     interp eval {a b} {
  1908. proc foo args {error $args}
  1909.     }
  1910.     interp eval a {
  1911. proc foo args {
  1912.     set l {}
  1913.     lappend l [catch {eval interp eval b foo $args} msg]
  1914.     lappend l $msg
  1915.     lappend l [catch {eval interp eval b foo $args} msg]
  1916.     lappend l $msg
  1917.     set l
  1918. }
  1919.     }
  1920.     set l [interp eval a foo 1 2 3]
  1921.     interp delete a
  1922.     set l
  1923. } {1 {1 2 3} 1 {1 2 3}}
  1924. test interp-24.12 {result resetting on error} {
  1925.     catch {interp delete a}
  1926.     interp create a -safe
  1927.     interp create {a b}
  1928.     interp eval {a b} {
  1929. proc foo args {error $args}
  1930.     }
  1931.     interp eval a {
  1932. proc foo args {
  1933.     set l {}
  1934.     lappend l [catch {eval interp eval b foo $args} msg]
  1935.     lappend l $msg
  1936.     lappend l [catch {eval interp eval b foo $args} msg]
  1937.     lappend l $msg
  1938.     set l
  1939. }
  1940.     }
  1941.     set l [interp eval a foo 1 2 3]
  1942.     interp delete a
  1943.     set l
  1944. } {1 {1 2 3} 1 {1 2 3}}
  1945. unset hidden_cmds
  1946. test interp-25.1 {testing aliasing of string commands} {
  1947.     catch {interp delete a}
  1948.     interp create a
  1949.     a alias exec foo ;# Relies on exec being a string command!
  1950.     interp delete a
  1951. } ""
  1952. #
  1953. # Interps result transmission
  1954. #
  1955. test interp-26.1 {result code transmission : interp eval direct} {
  1956.     # Test that all the possibles error codes from Tcl get passed up
  1957.     # from the slave interp's context to the master, even though the
  1958.     # slave nominally thinks the command is running at the root level.
  1959.     
  1960.     catch {interp delete a}
  1961.     interp create a
  1962.     set res {}
  1963.     # use a for so if a return -code break 'escapes' we would notice
  1964.     for {set code -1} {$code<=5} {incr code} {
  1965. lappend res [catch {interp eval a return -code $code} msg]
  1966.     }
  1967.     interp delete a
  1968.     set res
  1969. } {-1 0 1 2 3 4 5}
  1970. test interp-26.2 {result code transmission : interp eval indirect} {
  1971.     # retcode == 2 == return is special
  1972.     catch {interp delete a}
  1973.     interp create a
  1974.     interp eval a {proc retcode {code} {return -code $code ret$code}}
  1975.     set res {}
  1976.     # use a for so if a return -code break 'escapes' we would notice
  1977.     for {set code -1} {$code<=5} {incr code} {
  1978. lappend res [catch {interp eval a retcode $code} msg] $msg
  1979.     }
  1980.     interp delete a
  1981.     set res
  1982. } {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5}
  1983. test interp-26.3 {result code transmission : aliases} {
  1984.     # Test that all the possibles error codes from Tcl get passed up
  1985.     # from the slave interp's context to the master, even though the
  1986.     # slave nominally thinks the command is running at the root level.
  1987.     
  1988.     catch {interp delete a}
  1989.     interp create a
  1990.     set res {}
  1991.     proc MyTestAlias {code} {
  1992. return -code $code ret$code
  1993.     }
  1994.     interp alias a Test {} MyTestAlias
  1995.     for {set code -1} {$code<=5} {incr code} {
  1996. lappend res [interp eval a [list catch [list Test $code] msg]]
  1997.     }
  1998.     interp delete a
  1999.     set res
  2000. } {-1 0 1 2 3 4 5}
  2001. test interp-26.4 {result code transmission: invoke hidden direct--bug 1637} 
  2002. {knownBug} {
  2003.     # The known bug is that code 2 is returned, not the -code argument
  2004.     catch {interp delete a}
  2005.     interp create a
  2006.     set res {}
  2007.     interp hide a return
  2008.     for {set code -1} {$code<=5} {incr code} {
  2009. lappend res [catch {interp invokehidden a return -code $code ret$code}]
  2010.     }
  2011.     interp delete a
  2012.     set res
  2013. } {-1 0 1 2 3 4 5}
  2014. test interp-26.5 {result code transmission: invoke hidden indirect--bug 1637} 
  2015. {knownBug} {
  2016.     # The known bug is that the break and continue should raise errors
  2017.     # that they are used outside a loop.
  2018.     catch {interp delete a}
  2019.     interp create a
  2020.     set res {}
  2021.     interp eval a {proc retcode {code} {return -code $code ret$code}}
  2022.     interp hide a retcode
  2023.     for {set code -1} {$code<=5} {incr code} {
  2024. lappend res [catch {interp invokehidden a retcode $code} msg] $msg
  2025.     }
  2026.     interp delete a
  2027.     set res
  2028. } {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5}
  2029. test interp-26.6 {result code transmission: all combined--bug 1637} 
  2030. {knownBug} {
  2031.     # Test that all the possibles error codes from Tcl get passed
  2032.     # In both directions.  This doesn't work.
  2033.     set interp [interp create];
  2034.     proc MyTestAlias {interp args} {
  2035. global aliasTrace;
  2036. lappend aliasTrace $args;
  2037. eval interp invokehidden [list $interp] $args
  2038.     }
  2039.     foreach c {return} {
  2040. interp hide $interp  $c;
  2041.         interp alias $interp $c {} MyTestAlias $interp $c;
  2042.     }
  2043.     interp eval $interp {proc ret {code} {return -code $code ret$code}}
  2044.     set res {}
  2045.     set aliasTrace {}
  2046.     for {set code -1} {$code<=5} {incr code} {
  2047. lappend res [catch {interp eval $interp ret $code} msg] $msg
  2048.     }
  2049.     interp delete $interp;
  2050.     set res
  2051. } {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5}
  2052. # Some tests might need to be added to check for difference between
  2053. # toplevel and non toplevel evals.
  2054. # End of return code transmission section
  2055. test interp-26.7 {errorInfo transmission: regular interps} {
  2056.     set interp [interp create];
  2057.     proc MyError {secret} {
  2058. return -code error "msg"
  2059.     }
  2060.     proc MyTestAlias {interp args} {
  2061. MyError "some secret"
  2062.     }
  2063.     interp alias $interp test {} MyTestAlias $interp;
  2064.     set res [interp eval $interp {catch test;set errorInfo}]
  2065.     interp delete $interp;
  2066.     set res
  2067. } {msg
  2068.     while executing
  2069. "MyError "some secret""
  2070.     (procedure "MyTestAlias" line 2)
  2071.     invoked from within
  2072. "test"}
  2073. test interp-26.8 {errorInfo transmission: safe interps--bug 1637} {knownBug} {
  2074.     # this test fails because the errorInfo is fully transmitted
  2075.     # whether the interp is safe or not.  The errorInfo should never
  2076.     # report data from the master interpreter because it could
  2077.     # contain sensitive information.
  2078.     set interp [interp create -safe];
  2079.     proc MyError {secret} {
  2080. return -code error "msg"
  2081.     }
  2082.     proc MyTestAlias {interp args} {
  2083. MyError "some secret"
  2084.     }
  2085.     interp alias $interp test {} MyTestAlias $interp;
  2086.     set res [interp eval $interp {catch test;set errorInfo}]
  2087.     interp delete $interp;
  2088.     set res
  2089. } {msg
  2090.     while executing
  2091. "test"}
  2092. # Interps & Namespaces
  2093. test interp-27.1 {interp aliases & namespaces} {
  2094.     set i [interp create];
  2095.     set aliasTrace {};
  2096.     proc tstAlias {args} { 
  2097. global aliasTrace;
  2098. lappend aliasTrace [list [namespace current] $args];
  2099.     }
  2100.     $i alias foo::bar tstAlias foo::bar;
  2101.     $i eval foo::bar test
  2102.     interp delete $i
  2103.     set aliasTrace;
  2104. } {{:: {foo::bar test}}}
  2105. test interp-27.2 {interp aliases & namespaces} {
  2106.     set i [interp create];
  2107.     set aliasTrace {};
  2108.     proc tstAlias {args} { 
  2109. global aliasTrace;
  2110. lappend aliasTrace [list [namespace current] $args];
  2111.     }
  2112.     $i alias foo::bar tstAlias foo::bar;
  2113.     $i eval namespace eval foo {bar test}
  2114.     interp delete $i
  2115.     set aliasTrace;
  2116. } {{:: {foo::bar test}}}
  2117. test interp-27.3 {interp aliases & namespaces} {
  2118.     set i [interp create];
  2119.     set aliasTrace {};
  2120.     proc tstAlias {args} { 
  2121. global aliasTrace;
  2122. lappend aliasTrace [list [namespace current] $args];
  2123.     }
  2124.     interp eval $i {namespace eval foo {proc bar {} {error "bar called"}}}
  2125.     interp alias $i foo::bar {} tstAlias foo::bar;
  2126.     interp eval $i {namespace eval foo {bar test}}
  2127.     interp delete $i
  2128.     set aliasTrace;
  2129. } {{:: {foo::bar test}}}
  2130. test interp-27.4 {interp aliases & namespaces} {
  2131.     set i [interp create];
  2132.     namespace eval foo2 {
  2133. variable aliasTrace {};
  2134. proc bar {args} { 
  2135.     variable aliasTrace;
  2136.     lappend aliasTrace [list [namespace current] $args];
  2137. }
  2138.     }
  2139.     $i alias foo::bar foo2::bar foo::bar;
  2140.     $i eval namespace eval foo {bar test}
  2141.     set r $foo2::aliasTrace;
  2142.     namespace delete foo2;
  2143.     set r
  2144. } {{::foo2 {foo::bar test}}}
  2145. # the following tests are commented out while we don't support
  2146. # hiding in namespaces
  2147. # test interp-27.5 {interp hidden & namespaces} {
  2148. #    set i [interp create];
  2149. #    interp eval $i {
  2150. #        namespace eval foo {
  2151. #     proc bar {args} {
  2152. # return "bar called ([namespace current]) ($args)"
  2153. #     }
  2154. # }
  2155. #    }
  2156. #    set res [list [interp eval $i {namespace eval foo {bar test1}}]]
  2157. #    interp hide $i foo::bar;
  2158. #    lappend res [list [catch {interp eval $i {namespace eval foo {bar test2}}} msg] $msg]
  2159. #    interp delete $i;
  2160. #    set res;
  2161. #} {{bar called (::foo) (test1)} {1 {invalid command name "bar"}}}
  2162. # test interp-27.6 {interp hidden & aliases & namespaces} {
  2163. #     set i [interp create];
  2164. #     set v root-master;
  2165. #     namespace eval foo {
  2166. #  variable v foo-master;
  2167. #  proc bar {interp args} {
  2168. #      variable v;
  2169. #      list "master bar called ($v) ([namespace current]) ($args)"
  2170. #      [interp invokehidden $interp foo::bar $args];
  2171. #  }
  2172. #     }
  2173. #     interp eval $i {
  2174. #        namespace eval foo {
  2175. #      namespace export *
  2176. #      variable v foo-slave;
  2177. #      proc bar {args} {
  2178. #  variable v;
  2179. #  return "slave bar called ($v) ([namespace current]) ($args)"
  2180. #      }
  2181. #  }
  2182. #     }
  2183. #     set res [list [interp eval $i {namespace eval foo {bar test1}}]]
  2184. #     $i hide foo::bar;
  2185. #     $i alias foo::bar foo::bar $i;
  2186. #     set res [concat $res [interp eval $i {
  2187. #  set v root-slave;
  2188. #         namespace eval test {
  2189. #      variable v foo-test;
  2190. #      namespace import ::foo::*;
  2191. #      bar test2
  2192. #         }
  2193. #     }]]
  2194. #     namespace delete foo;
  2195. #     interp delete $i;
  2196. #     set res
  2197. # } {{slave bar called (foo-slave) (::foo) (test1)} {master bar called (foo-master) (::foo) (test2)} {slave bar called (foo-slave) (::foo) (test2)}}
  2198. # test interp-27.7 {interp hidden & aliases & imports & namespaces} {
  2199. #     set i [interp create];
  2200. #     set v root-master;
  2201. #     namespace eval mfoo {
  2202. #  variable v foo-master;
  2203. #  proc bar {interp args} {
  2204. #      variable v;
  2205. #      list "master bar called ($v) ([namespace current]) ($args)"
  2206. #      [interp invokehidden $interp test::bar $args];
  2207. #  }
  2208. #     }
  2209. #     interp eval $i {
  2210. #       namespace eval foo {
  2211. #      namespace export *
  2212. #      variable v foo-slave;
  2213. #      proc bar {args} {
  2214. #  variable v;
  2215. #  return "slave bar called ($v) ([info level 0]) ([uplevel namespace current]) ([namespace current]) ($args)"
  2216. #      }
  2217. #  }
  2218. #  set v root-slave;
  2219. #       namespace eval test {
  2220. #      variable v foo-test;
  2221. #      namespace import ::foo::*;
  2222. #         }
  2223. #     }
  2224. #     set res [list [interp eval $i {namespace eval test {bar test1}}]]
  2225. #     $i hide test::bar;
  2226. #     $i alias test::bar mfoo::bar $i;
  2227. #     set res [concat $res [interp eval $i {test::bar test2}]];
  2228. #     namespace delete mfoo;
  2229. #     interp delete $i;
  2230. #     set res
  2231. # } {{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)}}
  2232. #test interp-27.8 {hiding, namespaces and integrity} {
  2233. #    namespace eval foo {
  2234. # variable v 3;
  2235. # proc bar {} {variable v; set v}
  2236. # # next command would currently generate an unknown command "bar" error.
  2237. # interp hide {} bar;
  2238. #    }
  2239. #    namespace delete foo;
  2240. #    list [catch {interp invokehidden {} foo} msg] $msg;
  2241. #} {1 {invalid hidden command name "foo"}}
  2242. test interp-28.1 {getting fooled by slave's namespace ?} {
  2243.     set i [interp create -safe];
  2244.     proc master {interp args} {interp hide $interp list}
  2245.     $i alias master master $i;
  2246.     set r [interp eval $i {
  2247.         namespace eval foo {
  2248.     proc list {args} {
  2249. return "dummy foo::list";
  2250.     }
  2251.     master;
  2252. }
  2253. info commands list
  2254.     }]
  2255.     interp delete $i;
  2256.     set r
  2257. } {}
  2258. # Part 29: recursion limit
  2259. #  29.1.*  Argument checking
  2260. #  29.2.*  Reading and setting the recursion limit
  2261. #  29.3.*  Does the recursion limit work?
  2262. #  29.4.*  Recursion limit inheritance by sub-interpreters
  2263. #  29.5.*  Confirming the recursionlimit command does not affect the parent
  2264. #  29.6.*  Safe interpreter restriction
  2265. test interp-29.1.1 {interp recursionlimit argument checking} {
  2266.     list [catch {interp recursionlimit} msg] $msg
  2267. } {1 {wrong # args: should be "interp recursionlimit path ?newlimit?"}}
  2268. test interp-29.1.2 {interp recursionlimit argument checking} {
  2269.     list [catch {interp recursionlimit foo bar} msg] $msg
  2270. } {1 {could not find interpreter "foo"}}
  2271. test interp-29.1.3 {interp recursionlimit argument checking} {
  2272.     list [catch {interp recursionlimit foo bar baz} msg] $msg
  2273. } {1 {wrong # args: should be "interp recursionlimit path ?newlimit?"}}
  2274. test interp-29.1.4 {interp recursionlimit argument checking} {
  2275.     interp create moo
  2276.     set result [catch {interp recursionlimit moo bar} msg]
  2277.     interp delete moo
  2278.     list $result $msg
  2279. } {1 {expected integer but got "bar"}}
  2280. test interp-29.1.5 {interp recursionlimit argument checking} {
  2281.     interp create moo
  2282.     set result [catch {interp recursionlimit moo 0} msg]
  2283.     interp delete moo
  2284.     list $result $msg
  2285. } {1 {recursion limit must be > 0}}
  2286. test interp-29.1.6 {interp recursionlimit argument checking} {
  2287.     interp create moo
  2288.     set result [catch {interp recursionlimit moo -1} msg]
  2289.     interp delete moo
  2290.     list $result $msg
  2291. } {1 {recursion limit must be > 0}}
  2292. test interp-29.1.7 {interp recursionlimit argument checking} {
  2293.     interp create moo
  2294.     set result [catch {interp recursionlimit moo [expr {wide(1)<<32}]} msg]
  2295.     interp delete moo
  2296.     list $result [string range $msg 0 35]
  2297. } {1 {integer value too large to represent}}
  2298. test interp-29.1.8 {slave recursionlimit argument checking} {
  2299.     interp create moo
  2300.     set result [catch {moo recursionlimit foo bar} msg]
  2301.     interp delete moo
  2302.     list $result $msg
  2303. } {1 {wrong # args: should be "moo recursionlimit ?newlimit?"}}
  2304. test interp-29.1.9 {slave recursionlimit argument checking} {
  2305.     interp create moo
  2306.     set result [catch {moo recursionlimit foo} msg]
  2307.     interp delete moo
  2308.     list $result $msg
  2309. } {1 {expected integer but got "foo"}}
  2310. test interp-29.1.10 {slave recursionlimit argument checking} {
  2311.     interp create moo
  2312.     set result [catch {moo recursionlimit 0} msg]
  2313.     interp delete moo
  2314.     list $result $msg
  2315. } {1 {recursion limit must be > 0}}
  2316. test interp-29.1.11 {slave recursionlimit argument checking} {
  2317.     interp create moo
  2318.     set result [catch {moo recursionlimit -1} msg]
  2319.     interp delete moo
  2320.     list $result $msg
  2321. } {1 {recursion limit must be > 0}}
  2322. test interp-29.1.12 {slave recursionlimit argument checking} {
  2323.     interp create moo
  2324.     set result [catch {moo recursionlimit [expr {wide(1)<<32}]} msg]
  2325.     interp delete moo
  2326.     list $result [string range $msg 0 35]
  2327. } {1 {integer value too large to represent}}
  2328. test interp-29.2.1 {query recursion limit} {
  2329.     interp recursionlimit {}
  2330. } 1000
  2331. test interp-29.2.2 {query recursion limit} {
  2332.     set i [interp create]
  2333.     set n [interp recursionlimit $i]
  2334.     interp delete $i
  2335.     set n
  2336. } 1000
  2337. test interp-29.2.3 {query recursion limit} {
  2338.     set i [interp create]
  2339.     set n [$i recursionlimit]
  2340.     interp delete $i
  2341.     set n
  2342. } 1000
  2343. test interp-29.2.4 {query recursion limit} {
  2344.     set i [interp create]
  2345.     set r [$i eval {
  2346. set n1 [interp recursionlimit {} 42]
  2347. set n2 [interp recursionlimit {}]
  2348. list $n1 $n2
  2349.     }]
  2350.     interp delete $i
  2351.     set r
  2352. } {42 42}
  2353. test interp-29.2.5 {query recursion limit} {
  2354.     set i [interp create]
  2355.     set n1 [interp recursionlimit $i 42]
  2356.     set n2 [interp recursionlimit $i]
  2357.     interp delete $i
  2358.     list $n1 $n2
  2359. } {42 42}
  2360. test interp-29.2.6 {query recursion limit} {
  2361.     set i [interp create]
  2362.     set n1 [interp recursionlimit $i 42]
  2363.     set n2 [$i recursionlimit]
  2364.     interp delete $i
  2365.     list $n1 $n2
  2366. } {42 42}
  2367. test interp-29.2.7 {query recursion limit} {
  2368.     set i [interp create]
  2369.     set n1 [$i recursionlimit 42]
  2370.     set n2 [interp recursionlimit $i]
  2371.     interp delete $i
  2372.     list $n1 $n2
  2373. } {42 42}
  2374. test interp-29.2.8 {query recursion limit} {
  2375.     set i [interp create]
  2376.     set n1 [$i recursionlimit 42]
  2377.     set n2 [$i recursionlimit]
  2378.     interp delete $i
  2379.     list $n1 $n2
  2380. } {42 42}
  2381. test interp-29.3.1 {recursion limit} {
  2382.     set i [interp create]
  2383.     set r [interp eval $i {
  2384. interp recursionlimit {} 50
  2385. proc p {} {incr ::i; p}
  2386. set i 0
  2387. list [catch p msg] $msg $i
  2388.     }]
  2389.     interp delete $i
  2390.     set r
  2391. } {1 {too many nested evaluations (infinite loop?)} 48}
  2392. test interp-29.3.2 {recursion limit} {
  2393.     set i [interp create]
  2394.     interp recursionlimit $i 50
  2395.     set r [interp eval $i {
  2396. proc p {} {incr ::i; p}
  2397. set i 0
  2398. list [catch p msg] $msg $i
  2399.     }]
  2400.    interp delete $i
  2401.    set r
  2402. } {1 {too many nested evaluations (infinite loop?)} 48}
  2403. test interp-29.3.3 {recursion limit} {
  2404.     set i [interp create]
  2405.     $i recursionlimit 50
  2406.     set r [interp eval $i {
  2407. proc p {} {incr ::i; p}
  2408. set i 0
  2409. list [catch p msg] $msg $i
  2410.     }]
  2411.    interp delete $i
  2412.    set r
  2413. } {1 {too many nested evaluations (infinite loop?)} 48}
  2414. test interp-29.3.4 {recursion limit error reporting} {
  2415.     interp create slave
  2416.     set r1 [slave eval {
  2417.         catch {  # nesting level 1
  2418.     eval { # 2
  2419.         eval { # 3
  2420.     eval { # 4
  2421.         eval { # 5
  2422.      interp recursionlimit {} 5
  2423.      set x ok
  2424. }
  2425.     }
  2426. }
  2427.     }
  2428. } msg
  2429.     }]
  2430.     set r2 [slave eval { set msg }]
  2431.     interp delete slave
  2432.     list $r1 $r2
  2433. } {1 {falling back due to new recursion limit}}
  2434. test interp-29.3.5 {recursion limit error reporting} {
  2435.     interp create slave
  2436.     set r1 [slave eval {
  2437.         catch { # nesting level 1
  2438.     eval { # 2
  2439.         eval { # 3
  2440.     eval { # 4
  2441.         eval { # 5
  2442.     interp recursionlimit {} 4
  2443.     set x ok
  2444. }
  2445.     }
  2446. }
  2447.     }
  2448. } msg
  2449.     }]
  2450.     set r2 [slave eval { set msg }]
  2451.     interp delete slave
  2452.     list $r1 $r2
  2453. } {1 {falling back due to new recursion limit}}
  2454. test interp-29.3.6 {recursion limit error reporting} {
  2455.     interp create slave
  2456.     set r1 [slave eval {
  2457.         catch { # nesting level 1
  2458.     eval { # 2
  2459.         eval { # 3
  2460.     eval { # 4
  2461.         eval { # 5
  2462.     interp recursionlimit {} 6
  2463.     set x ok
  2464. }
  2465.     }
  2466. }
  2467.     }
  2468. } msg
  2469.     }]
  2470.     set r2 [slave eval { set msg }]
  2471.     interp delete slave
  2472.     list $r1 $r2
  2473. } {0 ok}
  2474. test interp-29.3.7 {recursion limit error reporting} {
  2475.     interp create slave
  2476.     after 0 {interp recursionlimit slave 5}
  2477.     set r1 [slave eval {
  2478.         catch {  # nesting level 1
  2479.     eval { # 2
  2480.         eval { # 3
  2481.     eval { # 4
  2482.         eval { # 5
  2483.      update
  2484.      set x ok
  2485. }
  2486.     }
  2487. }
  2488.     }
  2489. } msg
  2490.     }]
  2491.     set r2 [slave eval { set msg }]
  2492.     interp delete slave
  2493.     list $r1 $r2
  2494. } {1 {too many nested evaluations (infinite loop?)}}
  2495. test interp-29.3.8 {recursion limit error reporting} {
  2496.     interp create slave
  2497.     after 0 {interp recursionlimit slave 4}
  2498.     set r1 [slave eval {
  2499.         catch {  # nesting level 1
  2500.     eval { # 2
  2501.         eval { # 3
  2502.     eval { # 4
  2503.         eval { # 5
  2504.      update
  2505.      set x ok
  2506. }
  2507.     }
  2508. }
  2509.     }
  2510. } msg
  2511.     }]
  2512.     set r2 [slave eval { set msg }]
  2513.     interp delete slave
  2514.     list $r1 $r2
  2515. } {1 {too many nested evaluations (infinite loop?)}}
  2516. test interp-29.3.9 {recursion limit error reporting} {
  2517.     interp create slave
  2518.     after 0 {interp recursionlimit slave 6}
  2519.     set r1 [slave eval {
  2520.         catch {  # nesting level 1
  2521.     eval { # 2
  2522.         eval { # 3
  2523.     eval { # 4
  2524.         eval { # 5
  2525.      update
  2526.      set x ok
  2527. }
  2528.     }
  2529. }
  2530.     }
  2531. } msg
  2532.     }]
  2533.     set r2 [slave eval { set msg }]
  2534.     interp delete slave
  2535.     list $r1 $r2
  2536. } {0 ok}
  2537. test interp-29.3.10 {recursion limit error reporting} {
  2538.     interp create slave
  2539.     after 0 {slave recursionlimit 4}
  2540.     set r1 [slave eval {
  2541.         catch {  # nesting level 1
  2542.     eval { # 2
  2543.         eval { # 3
  2544.     eval { # 4
  2545.         eval { # 5
  2546.      update
  2547.      set x ok
  2548. }
  2549.     }
  2550. }
  2551.     }
  2552. } msg
  2553.     }]
  2554.     set r2 [slave eval { set msg }]
  2555.     interp delete slave
  2556.     list $r1 $r2
  2557. } {1 {too many nested evaluations (infinite loop?)}}
  2558. test interp-29.3.11 {recursion limit error reporting} {
  2559.     interp create slave
  2560.     after 0 {slave recursionlimit 5}
  2561.     set r1 [slave eval {
  2562.         catch {  # nesting level 1
  2563.     eval { # 2
  2564.         eval { # 3
  2565.     eval { # 4
  2566.         eval { # 5
  2567.      update
  2568.      set x ok
  2569. }
  2570.     }
  2571. }
  2572.     }
  2573. } msg
  2574.     }]
  2575.     set r2 [slave eval { set msg }]
  2576.     interp delete slave
  2577.     list $r1 $r2
  2578. } {1 {too many nested evaluations (infinite loop?)}}
  2579. test interp-29.3.12 {recursion limit error reporting} {
  2580.     interp create slave
  2581.     after 0 {slave recursionlimit 6}
  2582.     set r1 [slave eval {
  2583.         catch {  # nesting level 1
  2584.     eval { # 2
  2585.         eval { # 3
  2586.     eval { # 4
  2587.         eval { # 5
  2588.      update
  2589.      set x ok
  2590. }
  2591.     }
  2592. }
  2593.     }
  2594. } msg
  2595.     }]
  2596.     set r2 [slave eval { set msg }]
  2597.     interp delete slave
  2598.     list $r1 $r2
  2599. } {0 ok}
  2600. test interp-29.4.1 {recursion limit inheritance} {
  2601.     set i [interp create]
  2602.     set ii [interp eval $i {
  2603. interp recursionlimit {} 50
  2604. interp create
  2605.     }]
  2606.     set r [interp eval [list $i $ii] {
  2607. proc p {} {incr ::i; p}
  2608. set i 0
  2609. catch p
  2610. set i
  2611.     }]
  2612.    interp delete $i
  2613.    set r
  2614. } 49
  2615. test interp-29.4.2 {recursion limit inheritance} {
  2616.     set i [interp create]
  2617.     $i recursionlimit 50
  2618.     set ii [interp eval $i {interp create}]
  2619.     set r [interp eval [list $i $ii] {
  2620. proc p {} {incr ::i; p}
  2621. set i 0
  2622. catch p
  2623. set i
  2624.     }]
  2625.    interp delete $i
  2626.    set r
  2627. } 49
  2628. test interp-29.5.1 {does slave recursion limit affect master?} {
  2629.     set before [interp recursionlimit {}]
  2630.     set i [interp create]
  2631.     interp recursionlimit $i 20000
  2632.     set after [interp recursionlimit {}]
  2633.     set slavelimit [interp recursionlimit $i]
  2634.     interp delete $i
  2635.     list [expr {$before == $after}] $slavelimit
  2636. } {1 20000}
  2637. test interp-29.5.2 {does slave recursion limit affect master?} {
  2638.     set before [interp recursionlimit {}]
  2639.     set i [interp create]
  2640.     interp recursionlimit $i 20000
  2641.     set after [interp recursionlimit {}]
  2642.     set slavelimit [$i recursionlimit]
  2643.     interp delete $i
  2644.     list [expr {$before == $after}] $slavelimit
  2645. } {1 20000}
  2646. test interp-29.5.3 {does slave recursion limit affect master?} {
  2647.     set before [interp recursionlimit {}]
  2648.     set i [interp create]
  2649.     $i recursionlimit 20000
  2650.     set after [interp recursionlimit {}]
  2651.     set slavelimit [interp recursionlimit $i]
  2652.     interp delete $i
  2653.     list [expr {$before == $after}] $slavelimit
  2654. } {1 20000}
  2655. test interp-29.5.4 {does slave recursion limit affect master?} {
  2656.     set before [interp recursionlimit {}]
  2657.     set i [interp create]
  2658.     $i recursionlimit 20000
  2659.     set after [interp recursionlimit {}]
  2660.     set slavelimit [$i recursionlimit]
  2661.     interp delete $i
  2662.     list [expr {$before == $after}] $slavelimit
  2663. } {1 20000}
  2664. test interp-29.6.1 {safe interpreter recursion limit} {
  2665.     interp create slave -safe
  2666.     set n [interp recursionlimit slave]
  2667.     interp delete slave
  2668.     set n
  2669. } 1000
  2670. test interp-29.6.2 {safe interpreter recursion limit} {
  2671.     interp create slave -safe
  2672.     set n [slave recursionlimit]
  2673.     interp delete slave
  2674.     set n
  2675. } 1000
  2676. test interp-29.6.3 {safe interpreter recursion limit} {
  2677.     interp create slave -safe
  2678.     set n1 [interp recursionlimit slave 42]
  2679.     set n2 [interp recursionlimit slave]
  2680.     interp delete slave
  2681.     list $n1 $n2
  2682. } {42 42}
  2683. test interp-29.6.4 {safe interpreter recursion limit} {
  2684.     interp create slave -safe
  2685.     set n1 [slave recursionlimit 42]
  2686.     set n2 [interp recursionlimit slave]
  2687.     interp delete slave
  2688.     list $n1 $n2
  2689. } {42 42}
  2690. test interp-29.6.5 {safe interpreter recursion limit} {
  2691.     interp create slave -safe
  2692.     set n1 [interp recursionlimit slave 42]
  2693.     set n2 [slave recursionlimit]
  2694.     interp delete slave
  2695.     list $n1 $n2
  2696. } {42 42}
  2697. test interp-29.6.6 {safe interpreter recursion limit} {
  2698.     interp create slave -safe
  2699.     set n1 [slave recursionlimit 42]
  2700.     set n2 [slave recursionlimit]
  2701.     interp delete slave
  2702.     list $n1 $n2
  2703. } {42 42}
  2704. test interp-29.6.7 {safe interpreter recursion limit} {
  2705.     interp create slave -safe
  2706.     set n1 [slave recursionlimit 42]
  2707.     set n2 [slave recursionlimit]
  2708.     interp delete slave
  2709.     list $n1 $n2
  2710. } {42 42}
  2711. test interp-29.6.8 {safe interpreter recursion limit} {
  2712.     interp create slave -safe
  2713.     set n [catch {slave eval {interp recursionlimit {} 42}} msg]
  2714.     interp delete slave
  2715.     list $n $msg
  2716. } {1 {permission denied: safe interpreters cannot change recursion limit}}
  2717. test interp-29.6.9 {safe interpreter recursion limit} {
  2718.     interp create slave -safe
  2719.     set result [
  2720. slave eval {
  2721.     interp create slave2 -safe
  2722.     set n [catch {
  2723.         interp recursionlimit slave2 42
  2724.             } msg]
  2725.             list $n $msg
  2726.         }
  2727.     ]
  2728.     interp delete slave
  2729.     set result
  2730. } {1 {permission denied: safe interpreters cannot change recursion limit}}
  2731. test interp-29.6.10 {safe interpreter recursion limit} {
  2732.     interp create slave -safe
  2733.     set result [
  2734.         slave eval {
  2735.     interp create slave2 -safe
  2736.     set n [catch {
  2737.         slave2 recursionlimit 42
  2738.             } msg]
  2739.             list $n $msg
  2740.         }
  2741.     ]
  2742.     interp delete slave
  2743.     set result
  2744. } {1 {permission denied: safe interpreters cannot change recursion limit}}
  2745. #    # Deep recursion (into interps when the regular one fails):
  2746. #    # still crashes...
  2747. #    proc p {} {
  2748. # if {[catch p ret]} {
  2749. #     catch {
  2750. # set i [interp create]
  2751. # interp eval $i [list proc p {} [info body p]]
  2752. # interp eval $i p
  2753. #     }
  2754. #     interp delete $i
  2755. #     return ok
  2756. # }
  2757. # return $ret
  2758. #    }
  2759. #    p
  2760. # more tests needed...
  2761. # Interp & stack
  2762. #test interp-29.1 {interp and stack (info level)} {
  2763. #} {}
  2764. # End of stack-recursion tests
  2765. # This test dumps core in Tcl 8.0.3!
  2766. test interp-30.1 {deletion of aliases inside namespaces} {
  2767.     set i [interp create]
  2768.     $i alias ns::cmd list
  2769.     $i alias ns::cmd {}
  2770. } {}
  2771. test interp-31.1 {alias invocation scope} {
  2772.     proc mySet {varName value} {
  2773. upvar 1 $varName localVar
  2774. set localVar $value
  2775.     }
  2776.     interp alias {} myNewSet {} mySet
  2777.     proc testMyNewSet {value} {
  2778. myNewSet a $value
  2779. return $a
  2780.     }
  2781.     catch {unset a}
  2782.     set result [testMyNewSet "ok"]
  2783.     rename testMyNewSet {}
  2784.     rename mySet {}
  2785.     rename myNewSet {}
  2786.     set result
  2787. } ok
  2788. test interp-32.1 { parent's working directory should
  2789.                    be inherited by a child interp } {
  2790.     cd [temporaryDirectory]
  2791.     set parent [pwd]
  2792.     set i [interp create]
  2793.     set child [$i eval pwd]
  2794.     interp delete $i
  2795.     file mkdir cwd_test
  2796.     cd cwd_test
  2797.     lappend parent [pwd]
  2798.     set i [interp create]
  2799.     lappend child [$i eval pwd]
  2800.     cd ..
  2801.     file delete cwd_test
  2802.     interp delete $i
  2803.     cd [workingDirectory]
  2804.     expr {[string equal $parent $child] ? 1 :
  2805.              "{$parent} != {$child}"}
  2806. } 1
  2807. test interp-33.1 {refCounting for target words of alias [Bug 730244]} {
  2808.     # This test will panic if Bug 730244 is not fixed.
  2809.     set i [interp create]
  2810.     proc testHelper args {rename testHelper {}; return $args}
  2811.     # Note: interp names are simple words by default
  2812.     trace add execution testHelper enter "interp alias $i alias {} ;#"
  2813.     interp alias $i alias {} testHelper this
  2814.     $i eval alias 
  2815. } this
  2816. # cleanup
  2817. foreach i [interp slaves] {
  2818.   interp delete $i
  2819. }
  2820. ::tcltest::cleanupTests
  2821. return