开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
parse.test
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：35k
源码类别：

通讯编程

开发平台：

Visual C++

parse.test：源码内容
  1. # This file contains a collection of tests for the procedures in the
  2. # file tclParse.c.  Sourcing this file into Tcl runs the tests and
  3. # generates output for errors.  No output means no errors were found.
  4. #
  5. # Copyright (c) 1997 Sun Microsystems, Inc.
  6. # Copyright (c) 1998-1999 by Scriptics Corporation.
  7. #
  8. # See the file "license.terms" for information on usage and redistribution
  9. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10. #
  11. # RCS: @(#) $Id: parse.test,v 1.11.2.5 2006/03/07 05:30:24 dgp Exp $
  13. if {[lsearch [namespace children] ::tcltest] == -1} {
  14.     package require tcltest 2
  15.     namespace import -force ::tcltest::*
  16. }
  18. if {[info commands testparser] == {}} {
  19.     puts "This application hasn't been compiled with the "testparser""
  20.     puts "command, so I can't test the Tcl parser."
  21.     ::tcltest::cleanupTests
  22.     return 
  23. }
  25. test parse-1.1 {Tcl_ParseCommand procedure, computing string length} {
  26.     testparser [bytestring "foo bar"] -1
  27. } {- foo 1 simple foo 1 text foo 0 {}}
  28. test parse-1.2 {Tcl_ParseCommand procedure, computing string length} {
  29.     testparser "foo bar" -1
  30. } {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}}
  31. test parse-1.3 {Tcl_ParseCommand procedure, leading space} {
  32.     testparser "  nt   foo" 0
  33. } {- foo 1 simple foo 1 text foo 0 {}}
  34. test parse-1.4 {Tcl_ParseCommand procedure, leading space} {
  35.     testparser "frvfoo" 0
  36. } {- foo 1 simple foo 1 text foo 0 {}}
  37. test parse-1.5 {Tcl_ParseCommand procedure, backslash-newline in leading space} {
  38.     testparser "  \n foo" 0
  39. } {- foo 1 simple foo 1 text foo 0 {}}
  40. test parse-1.6 {Tcl_ParseCommand procedure, backslash-newline in leading space} {
  41.     testparser {  a foo} 0
  42. } {- {a foo} 2 word {a} 1 backslash {a} 0 simple foo 1 text foo 0 {}}
  43. test parse-1.7 {Tcl_ParseCommand procedure, missing continuation line in leading space} {
  44.     testparser "   \n" 0
  45. } {- {} 0 {}}
  46. test parse-1.8 {Tcl_ParseCommand procedure, eof in leading space} {
  47.     testparser "      foo" 3
  48. } {- {} 0 {   foo}}
  50. test parse-2.1 {Tcl_ParseCommand procedure, comments} {
  51.     testparser "# foo barn foo" 0
  52. } {{# foo bar
  53. } foo 1 simple foo 1 text foo 0 {}}
  54. test parse-2.2 {Tcl_ParseCommand procedure, several comments} {
  55.     testparser " # foo barn # another commentnn   foo" 0
  56. } {{# foo bar
  57.  # another comment
  58. } foo 1 simple foo 1 text foo 0 {}}
  59. test parse-2.3 {Tcl_ParseCommand procedure, backslash-newline in comments} {
  60.     testparser " # foo bar\ncomment on continuation linenfoo" 0
  61. } {# foo bar\ncomment on continuation linen foo 1 simple foo 1 text foo 0 {}}
  62. test parse-2.4 {Tcl_ParseCommand procedure, missing continuation line in comment} {
  63.     testparser "#   \n" 0
  64. } {#   \n {} 0 {}}
  65. test parse-2.5 {Tcl_ParseCommand procedure, eof in comment} {
  66.     testparser " # foo barnfoo" 8
  67. } {{# foo b} {} 0 {ar
  68. foo}}
  70. test parse-3.1 {Tcl_ParseCommand procedure, parsing words, skipping space} {
  71.     testparser "foo  barttx" 0
  72. } {- {foo  bar x} 3 simple foo 1 text foo 0 simple bar 1 text bar 0 simple x 1 text x 0 {}}
  73. test parse-3.2 {Tcl_ParseCommand procedure, missing continuation line in leading space} {
  74.     testparser "abc  \n" 0
  75. } {- abc  \n 1 simple abc 1 text abc 0 {}}
  76. test parse-3.3 {Tcl_ParseCommand procedure, parsing words, command ends in space} {
  77.     testparser "foo  ;  bar x" 0
  78. } {- {foo  ;} 1 simple foo 1 text foo 0 {  bar x}}
  79. test parse-3.4 {Tcl_ParseCommand procedure, parsing words, command ends in space} {
  80.     testparser "foo       " 5
  81. } {- {foo  } 1 simple foo 1 text foo 0 {     }}
  82. test parse-3.5 {Tcl_ParseCommand procedure, quoted words} {
  83.     testparser {foo "a b c" d "efg";} 0
  84. } {- {foo "a b c" d "efg";} 4 simple foo 1 text foo 0 simple {"a b c"} 1 text {a b c} 0 simple d 1 text d 0 simple {"efg"} 1 text efg 0 {}}
  85. test parse-3.6 {Tcl_ParseCommand procedure, words in braces} {
  86.     testparser {foo {a $b [concat foo]} {c d}} 0
  87. } {- {foo {a $b [concat foo]} {c d}} 3 simple foo 1 text foo 0 simple {{a $b [concat foo]}} 1 text {a $b [concat foo]} 0 simple {{c d}} 1 text {c d} 0 {}}
  88. test parse-3.7 {Tcl_ParseCommand procedure, error in unquoted word} {
  89.     list [catch {testparser "foo ${abc" 0} msg] $msg $errorInfo
  90. } {1 {missing close-brace for variable name} missing close-brace for variable namen    (remainder of script: "{abc")n    invoked from withinn"testparser "foo \$\{abc" 0"}
  92. test parse-4.1 {Tcl_ParseCommand procedure, simple words} {
  93.     testparser {foo} 0
  94. } {- foo 1 simple foo 1 text foo 0 {}}
  95. test parse-4.2 {Tcl_ParseCommand procedure, simple words} {
  96.     testparser {{abc}} 0
  97. } {- {{abc}} 1 simple {{abc}} 1 text abc 0 {}}
  98. test parse-4.3 {Tcl_ParseCommand procedure, simple words} {
  99.     testparser {"c d"} 0
  100. } {- {"c d"} 1 simple {"c d"} 1 text {c d} 0 {}}
  101. test parse-4.4 {Tcl_ParseCommand procedure, simple words} {
  102.     testparser {x$d} 0
  103. } {- {x$d} 1 word {x$d} 3 text x 0 variable {$d} 1 text d 0 {}}
  104. test parse-4.5 {Tcl_ParseCommand procedure, simple words} {
  105.     testparser {"a [foo] b"} 0
  106. } {- {"a [foo] b"} 1 word {"a [foo] b"} 3 text {a } 0 command {[foo]} 0 text { b} 0 {}}
  107. test parse-4.6 {Tcl_ParseCommand procedure, simple words} {
  108.     testparser {$x} 0
  109. } {- {$x} 1 word {$x} 2 variable {$x} 1 text x 0 {}}
  111. test parse-5.1 {Tcl_ParseCommand procedure, backslash-newline terminates word} {
  112.     testparser "{abc}\n" 0
  113. } {- {abc}\n 1 simple {{abc}} 1 text abc 0 {}}
  114. test parse-5.2 {Tcl_ParseCommand procedure, backslash-newline terminates word} {
  115.     testparser "foo\nbar" 0
  116. } {- foo\nbar 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}}
  117. test parse-5.3 {Tcl_ParseCommand procedure, word terminator is command terminator} {
  118.     testparser "foon bar" 0
  119. } {- {foo
  120. } 1 simple foo 1 text foo 0 { bar}}
  121. test parse-5.4 {Tcl_ParseCommand procedure, word terminator is command terminator} {
  122.     testparser "foo; bar" 0
  123. } {- {foo;} 1 simple foo 1 text foo 0 { bar}}
  124. test parse-5.5 {Tcl_ParseCommand procedure, word terminator is end of string} {
  125.     testparser ""foo" bar" 5
  126. } {- {"foo"} 1 simple {"foo"} 1 text foo 0 { bar}}
  127. test parse-5.6 {Tcl_ParseCommand procedure, junk after close quote} {
  128.     list [catch {testparser {foo "bar"x} 0} msg] $msg $errorInfo
  129. } {1 {extra characters after close-quote} {extra characters after close-quote
  130.     (remainder of script: "x")
  131.     invoked from within
  132. "testparser {foo "bar"x} 0"}}
  133. test parse-5.7 {Tcl_ParseCommand procedure, backslash-newline after close quote} {
  134.     testparser "foo "bar"\nx" 0
  135. } {- foo "bar"\nx 3 simple foo 1 text foo 0 simple {"bar"} 1 text bar 0 simple x 1 text x 0 {}}
  136. test parse-5.8 {Tcl_ParseCommand procedure, junk after close brace} {
  137.     list [catch {testparser {foo {bar}x} 0} msg] $msg $errorInfo
  138. } {1 {extra characters after close-brace} {extra characters after close-brace
  139.     (remainder of script: "x")
  140.     invoked from within
  141. "testparser {foo {bar}x} 0"}}
  142. test parse-5.9 {Tcl_ParseCommand procedure, backslash-newline after close brace} {
  143.     testparser "foo {bar}\nx" 0
  144. } {- foo {bar}\nx 3 simple foo 1 text foo 0 simple {{bar}} 1 text bar 0 simple x 1 text x 0 {}}
  145. test parse-5.10 {Tcl_ParseCommand procedure, multiple deletion of non-static buffer} {
  146.     # This test is designed to catch bug 1681.
  147.     list [catch {testparser "a "\1\2\3\4\5\6\7\8\9\1\2\3\4\5\6\7\8" 0} msg] $msg $errorInfo
  148. } "1 {missing "} {missing "
  149.     (remainder of script: ""\1\2\3\4\5\6\7\8\9\1\2\3\4\5\6\7\8")
  150.     invoked from within
  151. "testparser "a \"\\1\\2\\3\\4\\5\\6\\7\\8\\9\\1\\2\\3\\4\\5\\6\\7\\8" 0"}"
  153. test parse-6.1 {ParseTokens procedure, empty word} {
  154.     testparser {""} 0
  155. } {- {""} 1 simple {""} 1 text {} 0 {}}
  156. test parse-6.2 {ParseTokens procedure, simple range} {
  157.     testparser {"abc$x.e"} 0
  158. } {- {"abc$x.e"} 1 word {"abc$x.e"} 4 text abc 0 variable {$x} 1 text x 0 text .e 0 {}}
  159. test parse-6.3 {ParseTokens procedure, variable reference} {
  160.     testparser {abc$x.e $y(z)} 0
  161. } {- {abc$x.e $y(z)} 2 word {abc$x.e} 4 text abc 0 variable {$x} 1 text x 0 text .e 0 word {$y(z)} 3 variable {$y(z)} 2 text y 0 text z 0 {}}
  162. test parse-6.4 {ParseTokens procedure, variable reference} {
  163.     list [catch {testparser {$x([a )} 0} msg] $msg
  164. } {1 {missing close-bracket}}
  165. test parse-6.5 {ParseTokens procedure, command substitution} {
  166.     testparser {[foo $x bar]z} 0
  167. } {- {[foo $x bar]z} 1 word {[foo $x bar]z} 2 command {[foo $x bar]} 0 text z 0 {}}
  168. test parse-6.6 {ParseTokens procedure, command substitution} {
  169.     testparser {[foo ] [a b]]} 0
  170. } {- {[foo ] [a b]]} 1 word {[foo ] [a b]]} 1 command {[foo ] [a b]]} 0 {}}
  171. test parse-6.7 {ParseTokens procedure, error in command substitution} {
  172.     list [catch {testparser {a [b {}c d] e} 0} msg] $msg $errorInfo
  173. } {1 {extra characters after close-brace} {extra characters after close-brace
  174.     (remainder of script: "c d] e")
  175.     invoked from within
  176. "testparser {a [b {}c d] e} 0"}}
  177. test parse-6.8 {ParseTokens procedure, error in command substitution} {
  178.     info complete {a [b {}c d]}
  179. } {1}
  180. test parse-6.9 {ParseTokens procedure, error in command substitution} {
  181.     info complete {a [b "c d}
  182. } {0}
  183. test parse-6.10 {ParseTokens procedure, incomplete sub-command} {
  184.     info complete {puts [
  185. expr 1+1
  186. #this is a comment ]}
  187. } {0}
  188. test parse-6.11 {ParseTokens procedure, memory allocation for big nested command} {
  189.     testparser {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 0
  190. } {- {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 1 word {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 1 command {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 0 {}}
  191. test parse-6.12 {ParseTokens procedure, missing close bracket} {
  192.     list [catch {testparser {[foo $x bar} 0} msg] $msg $errorInfo
  193. } {1 {missing close-bracket} {missing close-bracket
  194.     (remainder of script: "[foo $x bar")
  195.     invoked from within
  196. "testparser {[foo $x bar} 0"}}
  197. test parse-6.13 {ParseTokens procedure, backslash-newline without continuation line} {
  198.     list [catch {testparser ""a b\n" 0} msg] $msg $errorInfo
  199. } {1 {missing "} missing "n    (remainder of script: ""a b\n")n    invoked from withinn"testparser "\"a b\\\n" 0"}
  200. test parse-6.14 {ParseTokens procedure, backslash-newline} {
  201.     testparser "b\nc" 0
  202. } {- b\nc 2 simple b 1 text b 0 simple c 1 text c 0 {}}
  203. test parse-6.15 {ParseTokens procedure, backslash-newline} {
  204.     testparser ""b\nc"" 0
  205. } {- "b\nc" 1 word "b\nc" 3 text b 0 backslash \n 0 text c 0 {}}
  206. test parse-6.16 {ParseTokens procedure, backslash substitution} {
  207.     testparser {nax7f} 0
  208. } {- {nax7f} 1 word {nax7f} 3 backslash {n} 0 backslash {a} 0 backslash {x7f} 0 {}}
  209. test parse-6.17 {ParseTokens procedure, null characters} {
  210.     testparser [bytestring "foozz"] 0
  211. } "- [bytestring foozz] 1 word [bytestring foozz] 3 text foo 0 text [bytestring ] 0 text zz 0 {}"
  212. test parse-6.18 {ParseTokens procedure, seek past numBytes for close-bracket} {
  213.     # Test for Bug 681841
  214.     list [catch {testparser {[a]} 2} msg] $msg
  215. } {1 {missing close-bracket}}
  217. test parse-7.1 {Tcl_FreeParse and ExpandTokenArray procedures} {
  218.     testparser {$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) } 0
  219. } {- {$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) } 16 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 {}}
  221. testConstraint testevalobjv [llength [info commands testevalobjv]]
  222. testConstraint testevalex [llength [info commands testevalex]]
  223. test parse-8.1 {Tcl_EvalObjv procedure} testevalobjv {
  224.     testevalobjv 0 concat this is a test
  225. } {this is a test}
  226. test parse-8.2 {Tcl_EvalObjv procedure, unknown commands} testevalobjv {
  227.     rename unknown unknown.old
  228.     set x [catch {testevalobjv 10 asdf poiu} msg]
  229.     rename unknown.old unknown
  230.     list $x $msg
  231. } {1 {invalid command name "asdf"}}
  232. test parse-8.3 {Tcl_EvalObjv procedure, unknown commands} testevalobjv {
  233.     rename unknown unknown.old
  234.     proc unknown args {
  235. return "unknown $args"
  236.     }
  237.     set x [catch {testevalobjv 0 asdf poiu} msg]
  238.     rename unknown {}
  239.     rename unknown.old unknown
  240.     list $x $msg
  241. } {0 {unknown asdf poiu}}
  242. test parse-8.4 {Tcl_EvalObjv procedure, unknown commands} testevalobjv {
  243.     rename unknown unknown.old
  244.     proc unknown args {
  245. error "I don't like that command"
  246.     }
  247.     set x [catch {testevalobjv 0 asdf poiu} msg]
  248.     rename unknown {}
  249.     rename unknown.old unknown
  250.     list $x $msg
  251. } {1 {I don't like that command}}
  252. test parse-8.5 {Tcl_EvalObjv procedure, command traces} testevalobjv {
  253.     testevalobjv 0 set x 123
  254.     testcmdtrace tracetest {testevalobjv 0 set x $x}
  255. } {{testevalobjv 0 set x $x} {testevalobjv 0 set x 123} {set x 123} {set x 123}}
  256. test parse-8.7 {Tcl_EvalObjv procedure, TCL_EVAL_GLOBAL flag} testevalobjv {
  257.     proc x {} {
  258. set y 23
  259. set z [testevalobjv 1 set y]
  260. return [list $z $y]
  261.     }
  262.     catch {unset y}
  263.     set y 16
  264.     x
  265. } {16 23}
  266. test parse-8.8 {Tcl_EvalObjv procedure, async handlers} testevalobjv {
  267.     proc async1 {result code} {
  268. global aresult acode
  269. set aresult $result
  270. set acode $code
  271. return "new result"
  272.     }
  273.     set handler1 [testasync create async1]
  274.     set aresult xxx
  275.     set acode yyy
  276.     set x [list [catch [list testevalobjv 0 testasync mark $handler1 original 0] msg] $msg $acode $aresult]
  277.     testasync delete
  278.     set x
  279. } {0 {new result} 0 original}
  280. test parse-8.9 {Tcl_EvalObjv procedure, exceptional return} testevalobjv {
  281.     list [catch {testevalobjv 0 error message} msg] $msg
  282. } {1 message}
  283. test parse-8.10 {Tcl_EvalObjv procedure, TCL_EVAL_GLOBAL} testevalobjv {
  284.     rename ::unknown unknown.save
  285.     proc ::unknown args {lappend ::info [info level]}
  286.     catch {rename ::noSuchCommand {}}
  287.     set ::info {}
  288.     namespace eval test_ns_1 {
  289. testevalobjv 1 noSuchCommand
  290. uplevel #0 noSuchCommand
  291.     }
  292.     namespace delete test_ns_1
  293.     rename ::unknown {}
  294.     rename unknown.save ::unknown
  295.     set ::info
  296. } {1 1}
  297. test parse-8.11 {Tcl_EvalObjv procedure, TCL_EVAL_INVOKE} testevalobjv {
  298.     rename ::unknown unknown.save
  299.     proc ::unknown args {lappend ::info [info level]; uplevel 1 foo}
  300.     proc ::foo args {lappend ::info global}
  301.     catch {rename ::noSuchCommand {}}
  302.     set ::slave [interp create]
  303.     $::slave alias bar noSuchCommand
  304.     set ::info {}
  305.     namespace eval test_ns_1 {
  306. proc foo args {lappend ::info namespace}
  307. $::slave eval bar
  308. testevalobjv 1 [list $::slave eval bar]
  309. uplevel #0 [list $::slave eval bar]
  310.     }
  311.     namespace delete test_ns_1
  312.     rename ::foo {}
  313.     rename ::unknown {}
  314.     rename unknown.save ::unknown
  315.     set ::info
  316. } [subst {[set level 2; incr level [info level]] global 1 global 1 global}]
  317. test parse-8.12 {Tcl_EvalObjv procedure, TCL_EVAL_INVOKE} {
  318.     set ::auto_index(noSuchCommand) {
  319. proc noSuchCommand {} {lappend ::info global}
  320.     }
  321.     set ::auto_index(::[string trimleft [namespace current]::test_ns_1::noSuchCommand :]) [list 
  322. proc [namespace current]::test_ns_1::noSuchCommand {} {
  323.     lappend ::info ns
  324. }]
  325.     catch {rename ::noSuchCommand {}}
  326.     set ::slave [interp create]
  327.     $::slave alias bar noSuchCommand
  328.     set ::info {}
  329.     namespace eval test_ns_1 {
  330. $::slave eval bar
  331.     }
  332.     namespace delete test_ns_1
  333.     interp delete $::slave
  334.     catch {rename ::noSuchCommand {}}
  335.     set ::info
  336. } global
  338. test parse-9.1 {Tcl_LogCommandInfo, line numbers} {
  339.     catch {unset x}
  340.     list [catch {testevalex {for {} 1 {} {
  343. # asdf
  344. set x
  345.     }}}] $errorInfo
  346. } {1 {can't read "x": no such variable
  347.     while executing
  348. "set x"
  349.     ("for" body line 5)
  350.     invoked from within
  351. "for {} 1 {} {
  354. # asdf
  355. set x
  356.     }"
  357.     invoked from within
  358. "testevalex {for {} 1 {} {
  361. # asdf
  362. set x
  363.     }}"}}
  364. test parse-9.2 {Tcl_LogCommandInfo, truncating long commands} {
  365.     list [testevalex {catch {set a b 111111111 222222222 333333333 444444444 555555555 666666666 777777777 888888888 999999999 000000000 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd eeeeeeeee fffffffff ggggggggg}}] $errorInfo
  366. } {1 {wrong # args: should be "set varName ?newValue?"
  367.     while executing
  368. "set a b 111111111 222222222 333333333 444444444 555555555 666666666 777777777 888888888 999999999 000000000 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd ee..."}}
  370. test parse-10.1 {Tcl_EvalTokens, simple text} {
  371.     testevalex {concat test}
  372. } {test}
  373. test parse-10.2 {Tcl_EvalTokens, backslash sequences} {
  374.     testevalex {concat test6362test}
  375. } {test32test}
  376. test parse-10.3 {Tcl_EvalTokens, nested commands} {
  377.     testevalex {concat [expr 2 + 6]}
  378. } {8}
  379. test parse-10.4 {Tcl_EvalTokens, nested commands} {
  380.     catch {unset a}
  381.     list [catch {testevalex {concat xxx[expr $a]}} msg] $msg
  382. } {1 {can't read "a": no such variable}}
  383. test parse-10.5 {Tcl_EvalTokens, simple variables} {
  384.     set a hello
  385.     testevalex {concat $a}
  386. } {hello}
  387. test parse-10.6 {Tcl_EvalTokens, array variables} {
  388.     catch {unset a}
  389.     set a(12) 46
  390.     testevalex {concat $a(12)}
  391. } {46}
  392. test parse-10.7 {Tcl_EvalTokens, array variables} {
  393.     catch {unset a}
  394.     set a(12) 46
  395.     testevalex {concat $a(1[expr 3 - 1])}
  396. } {46}
  397. test parse-10.8 {Tcl_EvalTokens, array variables} {
  398.     catch {unset a}
  399.     list [catch {testevalex {concat $x($a)}} msg] $msg
  400. } {1 {can't read "a": no such variable}}
  401. test parse-10.9 {Tcl_EvalTokens, array variables} {
  402.     catch {unset a}
  403.     list [catch {testevalex {concat xyz$a(1)}} msg] $msg
  404. } {1 {can't read "a(1)": no such variable}}
  405. test parse-10.10 {Tcl_EvalTokens, object values} {
  406.     set a 123
  407.     testevalex {concat $a}
  408. } {123}
  409. test parse-10.11 {Tcl_EvalTokens, object values} {
  410.     set a 123
  411.     testevalex {concat $a$a$a}
  412. } {123123123}
  413. test parse-10.12 {Tcl_EvalTokens, object values} {
  414.     testevalex {concat [expr 2][expr 4][expr 6]}
  415. } {246}
  416. test parse-10.13 {Tcl_EvalTokens, string values} {
  417.     testevalex {concat {a" b"}}
  418. } {a" b"}
  419. test parse-10.14 {Tcl_EvalTokens, string values} {
  420.     set a 111
  421.     testevalex {concat x$a.$a.$a}
  422. } {x111.111.111}
  424. test parse-11.1 {Tcl_EvalEx, TCL_EVAL_GLOBAL flag} {
  425.     proc x {} {
  426. set y 777
  427. set z [testevalex "set y" global]
  428. return [list $z $y]
  429.     }
  430.     catch {unset y}
  431.     set y 321
  432.     x
  433. } {321 777}
  434. test parse-11.2 {Tcl_EvalEx, error while parsing} {
  435.     list [catch {testevalex {concat "abc}} msg] $msg
  436. } {1 {missing "}}
  437. test parse-11.3 {Tcl_EvalEx, error while collecting words} {
  438.     catch {unset a}
  439.     list [catch {testevalex {concat xyz $a}} msg] $msg
  440. } {1 {can't read "a": no such variable}}
  441. test parse-11.4 {Tcl_EvalEx, error in Tcl_EvalObjv call} {
  442.     catch {unset a}
  443.     list [catch {testevalex {_bogus_ a b c d}} msg] $msg
  444. } {1 {invalid command name "_bogus_"}}
  445. test parse-11.5 {Tcl_EvalEx, exceptional return} {
  446.     list [catch {testevalex {break}} msg] $msg
  447. } {3 {}}
  448. test parse-11.6 {Tcl_EvalEx, freeing memory} {
  449.     testevalex {concat a b c d e f g h i j k l m n o p q r s t u v w x y z}
  450. } {a b c d e f g h i j k l m n o p q r s t u v w x y z}
  451. test parse-11.7 {Tcl_EvalEx, multiple commands in script} {
  452.     list [testevalex {set a b; set c d}] $a $c
  453. } {d b d}
  454. test parse-11.8 {Tcl_EvalEx, multiple commands in script} {
  455.     list [testevalex {
  456. set a b
  457. set c d
  458.     }] $a $c
  459. } {d b d}
  460. test parse-11.9 {Tcl_EvalEx, freeing memory after error} {
  461.     catch {unset a}
  462.     list [catch {testevalex {concat a b c d e f g h i j k l m n o p q r s t u v w x y z $a}} msg] $msg
  463. } {1 {can't read "a": no such variable}}
  464. test parse-11.10 {Tcl_EvalTokens, empty commands} {
  465.     testevalex {concat xyz;   }
  466. } {xyz}
  467. test parse-11.11 {Tcl_EvalTokens, empty commands} {
  468.     testevalex "concat abc; ; # this is a commentn"
  469. } {abc}
  470. test parse-11.12 {Tcl_EvalTokens, empty commands} {
  471.     testevalex {}
  472. } {}
  474. test parse-12.1 {Tcl_ParseVarName procedure, initialization} {
  475.     list [catch {testparsevarname {$a([first second])} 8 0} msg] $msg
  476. } {1 {missing close-bracket}}
  477. test parse-12.2 {Tcl_ParseVarName procedure, initialization} {
  478.     testparsevarname {$a([first second])} 0 0
  479. } {- {} 0 variable {$a([first second])} 2 text a 0 command {[first second]} 0 {}}
  480. test parse-12.3 {Tcl_ParseVarName procedure, initialization} {
  481.     list [catch {testparsevarname {$abcd} 3 0} msg] $msg
  482. } {0 {- {} 0 variable {$ab} 1 text ab 0 cd}}
  483. test parse-12.4 {Tcl_ParseVarName procedure, initialization} {
  484.     testparsevarname {$abcd} 0 0
  485. } {- {} 0 variable {$abcd} 1 text abcd 0 {}}
  486. test parse-12.5 {Tcl_ParseVarName procedure, just a dollar sign} {
  487.     testparsevarname {$abcd} 1 0
  488. } {- {} 0 text {$} 0 abcd}
  489. test parse-12.6 {Tcl_ParseVarName procedure, braced variable name} {
  490.     testparser {${..[]b}cd} 0
  491. } {- {${..[]b}cd} 1 word {${..[]b}cd} 3 variable {${..[]b}} 1 text {..[]b} 0 text cd 0 {}}
  492. test parse-12.7 {Tcl_ParseVarName procedure, braced variable name} {
  493.     testparser "${{} " 0
  494. } {- ${{}  1 word ${{} 2 variable ${{} 1 text { 0 {}}
  495. test parse-12.8 {Tcl_ParseVarName procedure, missing close brace} {
  496.     list [catch {testparser "${abc" 0} msg] $msg $errorInfo
  497. } {1 {missing close-brace for variable name} missing close-brace for variable namen    (remainder of script: "{abc")n    invoked from withinn"testparser "$\{abc" 0"}
  498. test parse-12.9 {Tcl_ParseVarName procedure, missing close brace} {
  499.     list [catch {testparsevarname {${bcd}} 4 0} msg] $msg
  500. } {1 {missing close-brace for variable name}}
  501. test parse-12.10 {Tcl_ParseVarName procedure, missing close brace} {
  502.     list [catch {testparsevarname {${bc}} 4 0} msg] $msg
  503. } {1 {missing close-brace for variable name}}
  504. test parse-12.11 {Tcl_ParseVarName procedure, simple variable name} {
  505.     testparser {$az_AZ.} 0
  506. } {- {$az_AZ.} 1 word {$az_AZ.} 3 variable {$az_AZ} 1 text az_AZ 0 text . 0 {}}
  507. test parse-12.12 {Tcl_ParseVarName procedure, simple variable name} {
  508.     testparser {$abcdefg} 4
  509. } {- {$abc} 1 word {$abc} 2 variable {$abc} 1 text abc 0 defg}
  510. test parse-12.13 {Tcl_ParseVarName procedure, simple variable name with ::} {
  511.     testparser {$xyz::ab:c} 0
  512. } {- {$xyz::ab:c} 1 word {$xyz::ab:c} 3 variable {$xyz::ab} 1 text xyz::ab 0 text :c 0 {}}
  513. test parse-12.14 {Tcl_ParseVarName procedure, variable names with many colons} {
  514.     testparser {$xyz:::::c} 0
  515. } {- {$xyz:::::c} 1 word {$xyz:::::c} 2 variable {$xyz:::::c} 1 text xyz:::::c 0 {}}
  516. test parse-12.15 {Tcl_ParseVarName procedure, : vs. ::} {
  517.     testparsevarname {$ab:cd} 0 0
  518. } {- {} 0 variable {$ab} 1 text ab 0 :cd}
  519. test parse-12.16 {Tcl_ParseVarName procedure, eof in ::} {
  520.     testparsevarname {$ab::cd} 4 0
  521. } {- {} 0 variable {$ab} 1 text ab 0 ::cd}
  522. test parse-12.17 {Tcl_ParseVarName procedure, eof in ::} {
  523.     testparsevarname {$ab:::cd} 5 0
  524. } {- {} 0 variable {$ab::} 1 text ab:: 0 :cd}
  525. test parse-12.18 {Tcl_ParseVarName procedure, no variable name} {
  526.     testparser {$$ $.} 0
  527. } {- {$$ $.} 2 word {$$} 2 text {$} 0 text {$} 0 word {$.} 2 text {$} 0 text . 0 {}}
  528. test parse-12.19 {Tcl_ParseVarName procedure, EOF before (} {
  529.     testparsevarname {$ab(cd)} 3 0
  530. } {- {} 0 variable {$ab} 1 text ab 0 (cd)}
  531. test parse-12.20 {Tcl_ParseVarName procedure, array reference} {
  532.     testparser {$x(abc)} 0
  533. } {- {$x(abc)} 1 word {$x(abc)} 3 variable {$x(abc)} 2 text x 0 text abc 0 {}}
  534. test parse-12.21 {Tcl_ParseVarName procedure, array reference} {
  535.     testparser {$x(ab$cde[foo bar])} 0
  536. } {- {$x(ab$cde[foo bar])} 1 word {$x(ab$cde[foo bar])} 6 variable {$x(ab$cde[foo bar])} 5 text x 0 text ab 0 variable {$cde} 1 text cde 0 command {[foo bar]} 0 {}}
  537. test parse-12.22 {Tcl_ParseVarName procedure, array reference} {
  538.     testparser {$x([cmd arg]zz)} 0
  539. } {- {$x([cmd arg]zz)} 1 word {$x([cmd arg]zz)} 4 variable {$x([cmd arg]zz)} 3 text x 0 command {[cmd arg]} 0 text zz 0 {}}
  540. test parse-12.23 {Tcl_ParseVarName procedure, missing close paren in array reference} {
  541.     list [catch {testparser {$x(poiu} 0} msg] $msg $errorInfo
  542. } {1 {missing )} {missing )
  543.     (remainder of script: "(poiu")
  544.     invoked from within
  545. "testparser {$x(poiu} 0"}}
  546. test parse-12.24 {Tcl_ParseVarName procedure, missing close paren in array reference} {
  547.     list [catch {testparsevarname {$ab(cd)} 6 0} msg] $msg $errorInfo
  548. } {1 {missing )} {missing )
  549.     (remainder of script: "(cd)")
  550.     invoked from within
  551. "testparsevarname {$ab(cd)} 6 0"}}
  552. test parse-12.25 {Tcl_ParseVarName procedure, nested array reference} {
  553.     testparser {$x(a$y(b$z))} 0
  554. } {- {$x(a$y(b$z))} 1 word {$x(a$y(b$z))} 8 variable {$x(a$y(b$z))} 7 text x 0 text a 0 variable {$y(b$z)} 4 text y 0 text b 0 variable {$z} 1 text z 0 {}}
  556. test parse-13.1 {Tcl_ParseVar procedure} {
  557.     set abc 24
  558.     testparsevar {$abc.fg}
  559. } {24 .fg}
  560. test parse-13.2 {Tcl_ParseVar procedure, no variable name} {
  561.     testparsevar {$}
  562. } {{$} {}}
  563. test parse-13.3 {Tcl_ParseVar procedure, no variable name} {
  564.     testparsevar {$.123}
  565. } {{$} .123}
  566. test parse-13.4 {Tcl_ParseVar procedure, error looking up variable} {
  567.     catch {unset abc}
  568.     list [catch {testparsevar {$abc}} msg] $msg
  569. } {1 {can't read "abc": no such variable}}
  570. test parse-13.5 {Tcl_ParseVar procedure, error looking up variable} {
  571.     catch {unset abc}
  572.     list [catch {testparsevar {$abc([bogus x y z])}} msg] $msg
  573. } {1 {invalid command name "bogus"}}
  575. test parse-14.1 {Tcl_ParseBraces procedure, computing string length} {
  576.     testparser [bytestring "foo bar"] -1
  577. } {- foo 1 simple foo 1 text foo 0 {}}
  578. test parse-14.2 {Tcl_ParseBraces procedure, computing string length} {
  579.     testparser "foo bar" -1
  580. } {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}}
  581. test parse-14.3 {Tcl_ParseBraces procedure, words in braces} {
  582.     testparser {foo {a $b [concat foo]} {c d}} 0
  583. } {- {foo {a $b [concat foo]} {c d}} 3 simple foo 1 text foo 0 simple {{a $b [concat foo]}} 1 text {a $b [concat foo]} 0 simple {{c d}} 1 text {c d} 0 {}}
  584. test parse-14.4 {Tcl_ParseBraces procedure, empty nested braces} {
  585.     testparser {foo {{}}} 0
  586. } {- {foo {{}}} 2 simple foo 1 text foo 0 simple {{{}}} 1 text {{}} 0 {}}
  587. test parse-14.5 {Tcl_ParseBraces procedure, nested braces} {
  588.     testparser {foo {{a {b} c} {} {d e}}} 0
  589. } {- {foo {{a {b} c} {} {d e}}} 2 simple foo 1 text foo 0 simple {{{a {b} c} {} {d e}}} 1 text {{a {b} c} {} {d e}} 0 {}}
  590. test parse-14.6 {Tcl_ParseBraces procedure, backslashes in words in braces} {
  591.     testparser "foo {a \n\{}" 0
  592. } {- {foo {a n{}} 2 simple foo 1 text foo 0 simple {{a n{}} 1 text {a n{} 0 {}}
  593. test parse-14.7 {Tcl_ParseBraces procedure, missing continuation line in braces} {
  594.     list [catch {testparser "{abc\n" 0} msg] $msg $errorInfo
  595. } {1 {missing close-brace} missing close-bracen    (remainder of script: "{abc\n")n    invoked from withinn"testparser "\{abc\\\n" 0"}
  596. test parse-14.8 {Tcl_ParseBraces procedure, backslash-newline in braces} {
  597.     testparser "foo {\nx}" 0
  598. } {- foo {\nx} 2 simple foo 1 text foo 0 word {\nx} 2 backslash \n 0 text x 0 {}}
  599. test parse-14.9 {Tcl_ParseBraces procedure, backslash-newline in braces} {
  600.     testparser "foo {a \n   b}" 0
  601. } {- foo {a \n   b} 2 simple foo 1 text foo 0 word {a \n   b} 3 text {a } 0 backslash \n    0 text b 0 {}}
  602. test parse-14.10 {Tcl_ParseBraces procedure, backslash-newline in braces} {
  603.     testparser "foo {xyz\n }" 0
  604. } {- foo {xyz\n } 2 simple foo 1 text foo 0 word {xyz\n } 2 text xyz 0 backslash \n  0 {}}
  605. test parse-14.11 {Tcl_ParseBraces procedure, empty braced string} {
  606.     testparser {foo {}} 0
  607. } {- {foo {}} 2 simple foo 1 text foo 0 simple {{}} 1 text {} 0 {}}
  608. test parse-14.12 {Tcl_ParseBraces procedure, missing close brace} {
  609.     list [catch {testparser "foo {xy\nz" 0} msg] $msg $errorInfo
  610. } {1 {missing close-brace} missing close-bracen    (remainder of script: "{xy\nz")n    invoked from withinn"testparser "foo \{xy\\\nz" 0"}
  612. test parse-15.1 {Tcl_ParseQuotedString procedure, computing string length} {
  613.     testparser [bytestring "foo bar"] -1
  614. } {- foo 1 simple foo 1 text foo 0 {}}
  615. test parse-15.2 {Tcl_ParseQuotedString procedure, computing string length} {
  616.     testparser "foo bar" -1
  617. } {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}}
  618. test parse-15.3 {Tcl_ParseQuotedString procedure, word is quoted string} {
  619.     testparser {foo "a b c" d "efg";} 0
  620. } {- {foo "a b c" d "efg";} 4 simple foo 1 text foo 0 simple {"a b c"} 1 text {a b c} 0 simple d 1 text d 0 simple {"efg"} 1 text efg 0 {}}
  621. test parse-15.4 {Tcl_ParseQuotedString procedure, garbage after quoted string} {
  622.     list [catch {testparser {foo "a b c"d} 0} msg] $msg $errorInfo
  623. } {1 {extra characters after close-quote} {extra characters after close-quote
  624.     (remainder of script: "d")
  625.     invoked from within
  626. "testparser {foo "a b c"d} 0"}}
  628. test parse-15.5 {CommandComplete procedure} {
  629.     info complete ""
  630. } 1
  631. test parse-15.6 {CommandComplete procedure} {
  632.     info complete "  n"
  633. } 1
  634. test parse-15.7 {CommandComplete procedure} {
  635.     info complete "abc def"
  636. } 1
  637. test parse-15.8 {CommandComplete procedure} {
  638.     info complete "a b c d e f tn"
  639. } 1
  640. test parse-15.9 {CommandComplete procedure} {
  641.     info complete {a b c"d}
  642. } 1
  643. test parse-15.10 {CommandComplete procedure} {
  644.     info complete {a b "c d" e}
  645. } 1
  646. test parse-15.11 {CommandComplete procedure} {
  647.     info complete {a b "c d"}
  648. } 1
  649. test parse-15.12 {CommandComplete procedure} {
  650.     info complete {a b "c d"}
  651. } 1
  652. test parse-15.13 {CommandComplete procedure} {
  653.     info complete {a b "c d}
  654. } 0
  655. test parse-15.14 {CommandComplete procedure} {
  656.     info complete {a b "}
  657. } 0
  658. test parse-15.15 {CommandComplete procedure} {
  659.     info complete {a b "cd"xyz}
  660. } 1
  661. test parse-15.16 {CommandComplete procedure} {
  662.     info complete {a b "c $d() d"}
  663. } 1
  664. test parse-15.17 {CommandComplete procedure} {
  665.     info complete {a b "c $dd("}
  666. } 0
  667. test parse-15.18 {CommandComplete procedure} {
  668.     info complete {a b "c "}
  669. } 0
  670. test parse-15.19 {CommandComplete procedure} {
  671.     info complete {a b "c [d e f]"}
  672. } 1
  673. test parse-15.20 {CommandComplete procedure} {
  674.     info complete {a b "c [d e f] g"}
  675. } 1
  676. test parse-15.21 {CommandComplete procedure} {
  677.     info complete {a b "c [d e f"}
  678. } 0
  679. test parse-15.22 {CommandComplete procedure} {
  680.     info complete {a {b c d} e}
  681. } 1
  682. test parse-15.23 {CommandComplete procedure} {
  683.     info complete {a {b c d}}
  684. } 1
  685. test parse-15.24 {CommandComplete procedure} {
  686.     info complete "a b{c d"
  687. } 1
  688. test parse-15.25 {CommandComplete procedure} {
  689.     info complete "a b {c"
  690. } 0
  691. test parse-15.26 {CommandComplete procedure} {
  692.     info complete "a b {c{ }"
  693. } 0
  694. test parse-15.27 {CommandComplete procedure} {
  695.     info complete "a b {c d e}xxx"
  696. } 1
  697. test parse-15.28 {CommandComplete procedure} {
  698.     info complete "a b {c \{d e}xxx"
  699. } 1
  700. test parse-15.29 {CommandComplete procedure} {
  701.     info complete {a b [ab cd ef]}
  702. } 1
  703. test parse-15.30 {CommandComplete procedure} {
  704.     info complete {a b x[ab][cd][ef] gh}
  705. } 1
  706. test parse-15.31 {CommandComplete procedure} {
  707.     info complete {a b x[ab][cd[ef] gh}
  708. } 0
  709. test parse-15.32 {CommandComplete procedure} {
  710.     info complete {a b x[ gh}
  711. } 0
  712. test parse-15.33 {CommandComplete procedure} {
  713.     info complete {[]]]}
  714. } 1
  715. test parse-15.34 {CommandComplete procedure} {
  716.     info complete {abc x$yyy}
  717. } 1
  718. test parse-15.35 {CommandComplete procedure} {
  719.     info complete "abc x${abc[\d} xyz"
  720. } 1
  721. test parse-15.36 {CommandComplete procedure} {
  722.     info complete "abc x${ xyz"
  723. } 0
  724. test parse-15.37 {CommandComplete procedure} {
  725.     info complete {word $a(xyz)}
  726. } 1
  727. test parse-15.38 {CommandComplete procedure} {
  728.     info complete {word $a(}
  729. } 0
  730. test parse-15.39 {CommandComplete procedure} {
  731.     info complete "set a \n"
  732. } 0
  733. test parse-15.40 {CommandComplete procedure} {
  734.     info complete "set a \\n"
  735. } 1
  736. test parse-15.41 {CommandComplete procedure} {
  737.     info complete "set a \n "
  738. } 1
  739. test parse-15.42 {CommandComplete procedure} {
  740.     info complete "set a \"
  741. } 1
  742. test parse-15.43 {CommandComplete procedure} {
  743.     info complete "foo \n{"
  744. } 0
  745. test parse-15.44 {CommandComplete procedure} {
  746.     info complete "anbn# {n# {ncn"
  747. } 1
  748. test parse-15.45 {CommandComplete procedure} {
  749.     info complete "#Incomplete comment\n"
  750. } 0
  751. test parse-15.46 {CommandComplete procedure} {
  752.     info complete "#Incomplete comment\nBut now it's complete.n"
  753. } 1
  754. test parse-15.47 {CommandComplete procedure} {
  755.     info complete "# Complete comment\\n"
  756. } 1
  757. test parse-15.48 {CommandComplete procedure} {
  758.     info complete "abc\n def"
  759. } 1
  760. test parse-15.49 {CommandComplete procedure} {
  761.     info complete "abc\n "
  762. } 1
  763. test parse-15.50 {CommandComplete procedure} {
  764.     info complete "abc\n"
  765. } 0
  766. test parse-15.51 {CommandComplete procedure} "
  767.     info complete "\{abc\}\{"
  768. " 1
  769. test parse-15.52 {CommandComplete procedure} {
  770.     info complete ""abc"("
  771. } 1
  772. test parse-15.53 {CommandComplete procedure} "
  773.     info complete " # {"
  774. " 1
  775. test parse-15.54 {CommandComplete procedure} "
  776.     info complete "foo bar;# {"
  777. " 1
  778. test parse-15.55 {CommandComplete procedure} {
  779.     info complete "set x [bytestring ]; puts hi"
  780. } 1
  781. test parse-15.56 {CommandComplete procedure} {
  782.     info complete "set x [bytestring ]; {"
  783. } 0
  784. test parse-15.57 {CommandComplete procedure} {
  785.     info complete "# Comment should be complete command"
  786. } 1
  787. test parse-15.58 {CommandComplete procedure, memory leaks} {
  788.     info complete "1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22"
  789. } 1
  790. test parse-15.59 {CommandComplete procedure} {
  791.     # Test for Tcl Bug 684744
  792.     info complete [encoding convertfrom identity "x00;if 1 {"]
  793. } 0
  795. test parse-16.1 {Tcl_EvalEx, check termOffset is set correctly for non TCL_OK cases, bug 2535} {
  796.     subst {[eval {return foo}]bar}
  797. } foobar
  799. test parse-17.1 {Correct return codes from errors during substitution} {
  800.     catch {eval {w[continue]}}
  801. } 4
  803. test parse-19.1 {Bug 1115904: recursion limit in Tcl_EvalEx} -constraints {
  804.     testevalex
  805. } -setup {
  806.     interp create i
  807.     load {} Tcltest i
  808.     i eval {proc {} args {}}
  809.     interp recursionlimit i 3
  810. } -body {
  811.     i eval {testevalex {[]}}
  812. } -cleanup {
  813.     interp delete i
  814. }
  816. test parse-19.2 {Bug 1115904: recursion limit in Tcl_EvalEx} -constraints {
  817.     testevalex
  818. } -setup {
  819.     interp create i
  820.     load {} Tcltest i
  821.     i eval {proc {} args {}}
  822.     interp recursionlimit i 3
  823. } -body {
  824.     i eval {testevalex {[[]]}}
  825. } -cleanup {
  826.     interp delete i
  827. } -returnCodes error -match glob -result {too many nested*}
  829. test parse-19.3 {Bug 1115904: recursion limit in Tcl_EvalEx} -setup {
  830.     interp create i
  831.     i eval {proc {} args {}}
  832.     interp recursionlimit i 3
  833. } -body {
  834.     i eval {subst {[]}}
  835. } -cleanup {
  836.     interp delete i
  837. }
  839. test parse-19.4 {Bug 1115904: recursion limit in Tcl_EvalEx} -setup {
  840.     interp create i
  841.     i eval {proc {} args {}}
  842.     interp recursionlimit i 3
  843. } -body {
  844.     i eval {subst {[[]]}}
  845. } -cleanup {
  846.     interp delete i
  847. } -returnCodes error -match glob -result {too many nested*}
  849. # cleanup
  850. catch {unset a}
  851. ::tcltest::cleanupTests
  852. return