home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / tests / interp.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  58.7 KB  |  2,166 lines  |  [TEXT/ALFA]

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