diff options
Diffstat (limited to 'tests/parse.test')
| -rw-r--r-- | tests/parse.test | 593 |
1 files changed, 400 insertions, 193 deletions
diff --git a/tests/parse.test b/tests/parse.test index fa50679..c3f05ab 100644 --- a/tests/parse.test +++ b/tests/parse.test @@ -8,166 +8,246 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest 2 - namespace import -force ::tcltest::* +if {[catch {package require tcltest 2.0.2}]} { + puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required." + return } -if {[info commands testparser] == {}} { - puts "This application hasn't been compiled with the \"testparser\"" - puts "command, so I can't test the Tcl parser." - ::tcltest::cleanupTests - return -} +namespace eval ::tcl::test::parse { + namespace import ::tcltest::* -test parse-1.1 {Tcl_ParseCommand procedure, computing string length} { +testConstraint testparser [llength [info commands testparser]] +testConstraint testevalobjv [llength [info commands testevalobjv]] +testConstraint testevalex [llength [info commands testevalex]] +testConstraint testparsevarname [llength [info commands testparsevarname]] +testConstraint testparsevar [llength [info commands testparsevar]] +testConstraint testasync [llength [info commands testasync]] +testConstraint testcmdtrace [llength [info commands testcmdtrace]] + +test parse-1.1 {Tcl_ParseCommand procedure, computing string length} testparser { testparser [bytestring "foo\0 bar"] -1 } {- foo 1 simple foo 1 text foo 0 {}} -test parse-1.2 {Tcl_ParseCommand procedure, computing string length} { +test parse-1.2 {Tcl_ParseCommand procedure, computing string length} testparser { testparser "foo bar" -1 } {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}} -test parse-1.3 {Tcl_ParseCommand procedure, leading space} { +test parse-1.3 {Tcl_ParseCommand procedure, leading space} testparser { testparser " \n\t foo" 0 } {- foo 1 simple foo 1 text foo 0 {}} -test parse-1.4 {Tcl_ParseCommand procedure, leading space} { +test parse-1.4 {Tcl_ParseCommand procedure, leading space} testparser { testparser "\f\r\vfoo" 0 } {- foo 1 simple foo 1 text foo 0 {}} -test parse-1.5 {Tcl_ParseCommand procedure, backslash-newline in leading space} { +test parse-1.5 {Tcl_ParseCommand procedure, backslash-newline in leading space} testparser { testparser " \\\n foo" 0 } {- foo 1 simple foo 1 text foo 0 {}} -test parse-1.6 {Tcl_ParseCommand procedure, backslash-newline in leading space} { +test parse-1.6 {Tcl_ParseCommand procedure, backslash-newline in leading space} testparser { testparser { \a foo} 0 } {- {\a foo} 2 word {\a} 1 backslash {\a} 0 simple foo 1 text foo 0 {}} -test parse-1.7 {Tcl_ParseCommand procedure, missing continuation line in leading space} { +test parse-1.7 {Tcl_ParseCommand procedure, missing continuation line in leading space} testparser { testparser " \\\n" 0 } {- {} 0 {}} -test parse-1.8 {Tcl_ParseCommand procedure, eof in leading space} { +test parse-1.8 {Tcl_ParseCommand procedure, eof in leading space} testparser { testparser " foo" 3 } {- {} 0 { foo}} +test parse-1.9 {Tcl_ParseCommand procedure, backslash newline + newline} testparser { + testparser "cmd1\\\n\ncmd2" 0 +} {- cmd1\\\n\n 1 simple cmd1 1 text cmd1 0 cmd2} +test parse-1.10 {Tcl_ParseCommand procedure, backslash newline + newline} testparser { + testparser "list \\\nA B\\\n\nlist C D" 0 +} {- list\ \\\nA\ B\\\n\n 3 simple list 1 text list 0 simple A 1 text A 0 simple B 1 text B 0 {list C D}} -test parse-2.1 {Tcl_ParseCommand procedure, comments} { +test parse-2.1 {Tcl_ParseCommand procedure, comments} testparser { testparser "# foo bar\n foo" 0 } {{# foo bar } foo 1 simple foo 1 text foo 0 {}} -test parse-2.2 {Tcl_ParseCommand procedure, several comments} { +test parse-2.2 {Tcl_ParseCommand procedure, several comments} testparser { testparser " # foo bar\n # another comment\n\n foo" 0 } {{# foo bar # another comment } foo 1 simple foo 1 text foo 0 {}} -test parse-2.3 {Tcl_ParseCommand procedure, backslash-newline in comments} { +test parse-2.3 {Tcl_ParseCommand procedure, backslash-newline in comments} testparser { testparser " # foo bar\\\ncomment on continuation line\nfoo" 0 -} {#\ foo\ bar\\\ncomment\ on\ continuation\ line\n foo 1 simple foo 1 text foo 0 {}} -test parse-2.4 {Tcl_ParseCommand procedure, missing continuation line in comment} { +} {\#\ foo\ bar\\\ncomment\ on\ continuation\ line\n foo 1 simple foo 1 text foo 0 {}} +test parse-2.4 {Tcl_ParseCommand procedure, missing continuation line in comment} testparser { testparser "# \\\n" 0 -} {#\ \ \ \\\n {} 0 {}} -test parse-2.5 {Tcl_ParseCommand procedure, eof in comment} { +} {\#\ \ \ \\\n {} 0 {}} +test parse-2.5 {Tcl_ParseCommand procedure, eof in comment} testparser { testparser " # foo bar\nfoo" 8 } {{# foo b} {} 0 {ar foo}} -test parse-3.1 {Tcl_ParseCommand procedure, parsing words, skipping space} { +test parse-3.1 {Tcl_ParseCommand procedure, parsing words, skipping space} testparser { testparser "foo bar\t\tx" 0 } {- {foo bar x} 3 simple foo 1 text foo 0 simple bar 1 text bar 0 simple x 1 text x 0 {}} -test parse-3.2 {Tcl_ParseCommand procedure, missing continuation line in leading space} { +test parse-3.2 {Tcl_ParseCommand procedure, missing continuation line in leading space} testparser { testparser "abc \\\n" 0 } {- abc\ \ \\\n 1 simple abc 1 text abc 0 {}} -test parse-3.3 {Tcl_ParseCommand procedure, parsing words, command ends in space} { +test parse-3.3 {Tcl_ParseCommand procedure, parsing words, command ends in space} testparser { testparser "foo ; bar x" 0 } {- {foo ;} 1 simple foo 1 text foo 0 { bar x}} -test parse-3.4 {Tcl_ParseCommand procedure, parsing words, command ends in space} { +test parse-3.4 {Tcl_ParseCommand procedure, parsing words, command ends in space} testparser { testparser "foo " 5 } {- {foo } 1 simple foo 1 text foo 0 { }} -test parse-3.5 {Tcl_ParseCommand procedure, quoted words} { +test parse-3.5 {Tcl_ParseCommand procedure, quoted words} testparser { testparser {foo "a b c" d "efg";} 0 } {- {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 {}} -test parse-3.6 {Tcl_ParseCommand procedure, words in braces} { +test parse-3.6 {Tcl_ParseCommand procedure, words in braces} testparser { testparser {foo {a $b [concat foo]} {c d}} 0 } {- {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 {}} -test parse-3.7 {Tcl_ParseCommand procedure, error in unquoted word} { - list [catch {testparser "foo \$\{abc" 0} msg] $msg $errorInfo +test parse-3.7 {Tcl_ParseCommand procedure, error in unquoted word} testparser { + list [catch {testparser "foo \$\{abc" 0} msg] $msg $::errorInfo } {1 {missing close-brace for variable name} missing\ close-brace\ for\ variable\ name\n\ \ \ \ (remainder\ of\ script:\ \"\{abc\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"foo\ \\\$\\\{abc\"\ 0\"} -test parse-4.1 {Tcl_ParseCommand procedure, simple words} { +test parse-4.1 {Tcl_ParseCommand procedure, simple words} testparser { testparser {foo} 0 } {- foo 1 simple foo 1 text foo 0 {}} -test parse-4.2 {Tcl_ParseCommand procedure, simple words} { +test parse-4.2 {Tcl_ParseCommand procedure, simple words} testparser { testparser {{abc}} 0 } {- {{abc}} 1 simple {{abc}} 1 text abc 0 {}} -test parse-4.3 {Tcl_ParseCommand procedure, simple words} { +test parse-4.3 {Tcl_ParseCommand procedure, simple words} testparser { testparser {"c d"} 0 } {- {"c d"} 1 simple {"c d"} 1 text {c d} 0 {}} -test parse-4.4 {Tcl_ParseCommand procedure, simple words} { +test parse-4.4 {Tcl_ParseCommand procedure, simple words} testparser { testparser {x$d} 0 } {- {x$d} 1 word {x$d} 3 text x 0 variable {$d} 1 text d 0 {}} -test parse-4.5 {Tcl_ParseCommand procedure, simple words} { +test parse-4.5 {Tcl_ParseCommand procedure, simple words} testparser { testparser {"a [foo] b"} 0 } {- {"a [foo] b"} 1 word {"a [foo] b"} 3 text {a } 0 command {[foo]} 0 text { b} 0 {}} -test parse-4.6 {Tcl_ParseCommand procedure, simple words} { +test parse-4.6 {Tcl_ParseCommand procedure, simple words} testparser { testparser {$x} 0 } {- {$x} 1 word {$x} 2 variable {$x} 1 text x 0 {}} -test parse-5.1 {Tcl_ParseCommand procedure, backslash-newline terminates word} { +test parse-5.1 {Tcl_ParseCommand procedure, backslash-newline terminates word} testparser { testparser "{abc}\\\n" 0 } {- \{abc\}\\\n 1 simple {{abc}} 1 text abc 0 {}} -test parse-5.2 {Tcl_ParseCommand procedure, backslash-newline terminates word} { +test parse-5.2 {Tcl_ParseCommand procedure, backslash-newline terminates word} testparser { testparser "foo\\\nbar" 0 } {- foo\\\nbar 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}} -test parse-5.3 {Tcl_ParseCommand procedure, word terminator is command terminator} { +test parse-5.3 {Tcl_ParseCommand procedure, word terminator is command terminator} testparser { testparser "foo\n bar" 0 } {- {foo } 1 simple foo 1 text foo 0 { bar}} -test parse-5.4 {Tcl_ParseCommand procedure, word terminator is command terminator} { +test parse-5.4 {Tcl_ParseCommand procedure, word terminator is command terminator} testparser { testparser "foo; bar" 0 } {- {foo;} 1 simple foo 1 text foo 0 { bar}} -test parse-5.5 {Tcl_ParseCommand procedure, word terminator is end of string} { +test parse-5.5 {Tcl_ParseCommand procedure, word terminator is end of string} testparser { testparser "\"foo\" bar" 5 } {- {"foo"} 1 simple {"foo"} 1 text foo 0 { bar}} -test parse-5.6 {Tcl_ParseCommand procedure, junk after close quote} { - list [catch {testparser {foo "bar"x} 0} msg] $msg $errorInfo +test parse-5.6 {Tcl_ParseCommand procedure, junk after close quote} testparser { + list [catch {testparser {foo "bar"x} 0} msg] $msg $::errorInfo } {1 {extra characters after close-quote} {extra characters after close-quote (remainder of script: "x") invoked from within "testparser {foo "bar"x} 0"}} -test parse-5.7 {Tcl_ParseCommand procedure, backslash-newline after close quote} { +test parse-5.7 {Tcl_ParseCommand procedure, backslash-newline after close quote} testparser { testparser "foo \"bar\"\\\nx" 0 } {- foo\ \"bar\"\\\nx 3 simple foo 1 text foo 0 simple {"bar"} 1 text bar 0 simple x 1 text x 0 {}} -test parse-5.8 {Tcl_ParseCommand procedure, junk after close brace} { - list [catch {testparser {foo {bar}x} 0} msg] $msg $errorInfo +test parse-5.8 {Tcl_ParseCommand procedure, junk after close brace} testparser { + list [catch {testparser {foo {bar}x} 0} msg] $msg $::errorInfo } {1 {extra characters after close-brace} {extra characters after close-brace (remainder of script: "x") invoked from within "testparser {foo {bar}x} 0"}} -test parse-5.9 {Tcl_ParseCommand procedure, backslash-newline after close brace} { +test parse-5.9 {Tcl_ParseCommand procedure, backslash-newline after close brace} testparser { testparser "foo {bar}\\\nx" 0 } {- foo\ \{bar\}\\\nx 3 simple foo 1 text foo 0 simple {{bar}} 1 text bar 0 simple x 1 text x 0 {}} -test parse-5.10 {Tcl_ParseCommand procedure, multiple deletion of non-static buffer} { +test parse-5.10 {Tcl_ParseCommand procedure, multiple deletion of non-static buffer} testparser { # This test is designed to catch bug 1681. - 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 + 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 } "1 {missing \"} {missing \" (remainder of script: \"\"\\1\\2\\3\\4\\5\\6\\7\\8\\9\\1\\2\\3\\4\\5\\6\\7\\8\") invoked from within \"testparser \"a \\\"\\\\1\\\\2\\\\3\\\\4\\\\5\\\\6\\\\7\\\\8\\\\9\\\\1\\\\2\\\\3\\\\4\\\\5\\\\6\\\\7\\\\8\" 0\"}" -test parse-6.1 {ParseTokens procedure, empty word} { +test parse-5.11 {Tcl_ParseCommand: {*} parsing} testparser { + testparser {{expan}} 0 +} {- {{expan}} 1 simple {{expan}} 1 text expan 0 {}} +test parse-5.12 {Tcl_ParseCommand: {*} parsing} -constraints { + testparser +} -body { + testparser {{expan}x} 0 +} -returnCodes error -result {extra characters after close-brace} +test parse-5.13 {Tcl_ParseCommand: {*} parsing} testparser { + testparser {{**}} 0 +} {- {{**}} 1 simple {{**}} 1 text ** 0 {}} +test parse-5.14 {Tcl_ParseCommand: {*} parsing} -constraints { + testparser +} -body { + testparser {{**}x} 0 +} -returnCodes error -result {extra characters after close-brace} +test parse-5.15 {Tcl_ParseCommand: {*} parsing} -constraints { + testparser +} -body { + testparser {{*}{123456}x} 0 +} -returnCodes error -result {extra characters after close-brace} +test parse-5.16 {Tcl_ParseCommand: {*} parsing} testparser { + testparser {{123456\ + }} 0 +} {- {{123456 }} 1 simple {{123456 }} 1 text {123456 } 0 {}} +test parse-5.17 {Tcl_ParseCommand: {*} parsing} -constraints { + testparser +} -body { + testparser {{123456\ + }x} 0 +} -returnCodes error -result {extra characters after close-brace} +test parse-5.18 {Tcl_ParseCommand: {*} parsing} testparser { + testparser {{*\ + }} 0 +} {- {{* }} 1 simple {{* }} 1 text {* } 0 {}} +test parse-5.19 {Tcl_ParseCommand: {*} parsing} -constraints { + testparser +} -body { + testparser {{*\ + }x} 0 +} -returnCodes error -result {extra characters after close-brace} +test parse-5.20 {Tcl_ParseCommand: {*} parsing} testparser { + testparser {{123456}} 0 +} {- {{123456}} 1 simple {{123456}} 1 text 123456 0 {}} +test parse-5.21 {Tcl_ParseCommand: {*} parsing} -constraints { + testparser +} -body { + testparser {{123456}x} 0 +} -returnCodes error -result {extra characters after close-brace} +test parse-5.22 {Tcl_ParseCommand: {*} parsing} testparser { + testparser {{*}} 0 +} {- {{*}} 1 simple {{*}} 1 text * 0 {}} +test parse-5.23 {Tcl_ParseCommand: {*} parsing} testparser { + testparser {{*} } 0 +} {- {{*} } 1 simple {{*}} 1 text * 0 {}} +test parse-5.24 {Tcl_ParseCommand: {*} parsing} testparser { + testparser {{*}x} 0 +} {- {{*}x} 1 simple x 1 text x 0 {}} +test parse-5.25 {Tcl_ParseCommand: {*} parsing} testparser { + testparser {{*} +} 0 +} {- {{*} +} 1 simple {{*}} 1 text * 0 {}} +test parse-5.26 {Tcl_ParseCommand: {*} parsing} testparser { + testparser {{*};} 0 +} {- {{*};} 1 simple {{*}} 1 text * 0 {}} +test parse-5.27 {Tcl_ParseCommand: {*} parsing} testparser { + testparser "{*}\\\n foo bar" 0 +} {- \{*\}\\\n\ foo\ bar 3 simple {{*}} 1 text * 0 simple foo 1 text foo 0 simple bar 1 text bar 0 {}} + +test parse-6.1 {ParseTokens procedure, empty word} testparser { testparser {""} 0 } {- {""} 1 simple {""} 1 text {} 0 {}} -test parse-6.2 {ParseTokens procedure, simple range} { +test parse-6.2 {ParseTokens procedure, simple range} testparser { testparser {"abc$x.e"} 0 } {- {"abc$x.e"} 1 word {"abc$x.e"} 4 text abc 0 variable {$x} 1 text x 0 text .e 0 {}} -test parse-6.3 {ParseTokens procedure, variable reference} { +test parse-6.3 {ParseTokens procedure, variable reference} testparser { testparser {abc$x.e $y(z)} 0 } {- {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 {}} -test parse-6.4 {ParseTokens procedure, variable reference} { +test parse-6.4 {ParseTokens procedure, variable reference} testparser { list [catch {testparser {$x([a )} 0} msg] $msg } {1 {missing close-bracket}} -test parse-6.5 {ParseTokens procedure, command substitution} { +test parse-6.5 {ParseTokens procedure, command substitution} testparser { testparser {[foo $x bar]z} 0 } {- {[foo $x bar]z} 1 word {[foo $x bar]z} 2 command {[foo $x bar]} 0 text z 0 {}} -test parse-6.6 {ParseTokens procedure, command substitution} { +test parse-6.6 {ParseTokens procedure, command substitution} testparser { testparser {[foo \] [a b]]} 0 } {- {[foo \] [a b]]} 1 word {[foo \] [a b]]} 1 command {[foo \] [a b]]} 0 {}} -test parse-6.7 {ParseTokens procedure, error in command substitution} { - list [catch {testparser {a [b {}c d] e} 0} msg] $msg $errorInfo +test parse-6.7 {ParseTokens procedure, error in command substitution} testparser { + list [catch {testparser {a [b {}c d] e} 0} msg] $msg $::errorInfo } {1 {extra characters after close-brace} {extra characters after close-brace (remainder of script: "c d] e") invoked from within @@ -183,87 +263,94 @@ test parse-6.10 {ParseTokens procedure, incomplete sub-command} { expr 1+1 #this is a comment ]} } {0} -test parse-6.11 {ParseTokens procedure, memory allocation for big nested command} { +test parse-6.11 {ParseTokens procedure, memory allocation for big nested command} testparser { 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 } {- {[$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 {}} -test parse-6.12 {ParseTokens procedure, missing close bracket} { - list [catch {testparser {[foo $x bar} 0} msg] $msg $errorInfo +test parse-6.12 {ParseTokens procedure, missing close bracket} testparser { + list [catch {testparser {[foo $x bar} 0} msg] $msg $::errorInfo } {1 {missing close-bracket} {missing close-bracket (remainder of script: "[foo $x bar") invoked from within "testparser {[foo $x bar} 0"}} -test parse-6.13 {ParseTokens procedure, backslash-newline without continuation line} { - list [catch {testparser "\"a b\\\n" 0} msg] $msg $errorInfo +test parse-6.13 {ParseTokens procedure, backslash-newline without continuation line} testparser { + list [catch {testparser "\"a b\\\n" 0} msg] $msg $::errorInfo } {1 {missing "} missing\ \"\n\ \ \ \ (remainder\ of\ script:\ \"\"a\ b\\\n\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"\\\"a\ b\\\\\\n\"\ 0\"} -test parse-6.14 {ParseTokens procedure, backslash-newline} { +test parse-6.14 {ParseTokens procedure, backslash-newline} testparser { testparser "b\\\nc" 0 } {- b\\\nc 2 simple b 1 text b 0 simple c 1 text c 0 {}} -test parse-6.15 {ParseTokens procedure, backslash-newline} { +test parse-6.15 {ParseTokens procedure, backslash-newline} testparser { testparser "\"b\\\nc\"" 0 } {- \"b\\\nc\" 1 word \"b\\\nc\" 3 text b 0 backslash \\\n 0 text c 0 {}} -test parse-6.16 {ParseTokens procedure, backslash substitution} { +test parse-6.16 {ParseTokens procedure, backslash substitution} testparser { testparser {\n\a\x7f} 0 } {- {\n\a\x7f} 1 word {\n\a\x7f} 3 backslash {\n} 0 backslash {\a} 0 backslash {\x7f} 0 {}} -test parse-6.17 {ParseTokens procedure, null characters} { +test parse-6.17 {ParseTokens procedure, null characters} testparser { testparser [bytestring "foo\0zz"] 0 } "- [bytestring foo\0zz] 1 word [bytestring foo\0zz] 3 text foo 0 text [bytestring \0] 0 text zz 0 {}" -test parse-6.18 {ParseTokens procedure, seek past numBytes for close-bracket} { +test parse-6.18 {ParseTokens procedure, seek past numBytes for close-bracket} testparser { # Test for Bug 681841 list [catch {testparser {[a]} 2} msg] $msg } {1 {missing close-bracket}} -test parse-7.1 {Tcl_FreeParse and ExpandTokenArray procedures} { +test parse-7.1 {Tcl_FreeParse and ExpandTokenArray procedures} testparser { 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 } {- {$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 {}} -testConstraint testevalobjv [llength [info commands testevalobjv]] -testConstraint testevalex [llength [info commands testevalex]] test parse-8.1 {Tcl_EvalObjv procedure} testevalobjv { testevalobjv 0 concat this is a test } {this is a test} test parse-8.2 {Tcl_EvalObjv procedure, unknown commands} testevalobjv { - rename unknown unknown.old + rename ::unknown unknown.old set x [catch {testevalobjv 10 asdf poiu} msg] - rename unknown.old unknown + rename unknown.old ::unknown list $x $msg } {1 {invalid command name "asdf"}} test parse-8.3 {Tcl_EvalObjv procedure, unknown commands} testevalobjv { - rename unknown unknown.old - proc unknown args { + rename ::unknown unknown.old + proc ::unknown args { return "unknown $args" } set x [catch {testevalobjv 0 asdf poiu} msg] - rename unknown {} - rename unknown.old unknown + rename ::unknown {} + rename unknown.old ::unknown list $x $msg } {0 {unknown asdf poiu}} test parse-8.4 {Tcl_EvalObjv procedure, unknown commands} testevalobjv { - rename unknown unknown.old - proc unknown args { + rename ::unknown unknown.old + proc ::unknown args { error "I don't like that command" } set x [catch {testevalobjv 0 asdf poiu} msg] - rename unknown {} - rename unknown.old unknown + rename ::unknown {} + rename unknown.old ::unknown list $x $msg } {1 {I don't like that command}} -test parse-8.5 {Tcl_EvalObjv procedure, command traces} testevalobjv { +test parse-8.5 {Tcl_EvalObjv procedure, command traces} {testevalobjv testcmdtrace} { testevalobjv 0 set x 123 testcmdtrace tracetest {testevalobjv 0 set x $x} } {{testevalobjv 0 set x $x} {testevalobjv 0 set x 123} {set x 123} {set x 123}} -test parse-8.7 {Tcl_EvalObjv procedure, TCL_EVAL_GLOBAL flag} testevalobjv { +test parse-8.7 {Tcl_EvalObjv procedure, TCL_EVAL_GLOBAL flag} -constraints { + testevalobjv +} -setup { proc x {} { set y 23 set z [testevalobjv 1 set y] return [list $z $y] } - catch {unset y} - set y 16 + set ::y 16 +} -cleanup { + unset ::y +} -body { x -} {16 23} -test parse-8.8 {Tcl_EvalObjv procedure, async handlers} testevalobjv { +} -result {16 23} +test parse-8.8 {Tcl_EvalObjv procedure, async handlers} -constraints { + testevalobjv testasync +} -setup { + variable ::aresult + variable ::acode proc async1 {result code} { - global aresult acode + variable ::aresult + variable ::acode set aresult $result set acode $code return "new result" @@ -271,10 +358,11 @@ test parse-8.8 {Tcl_EvalObjv procedure, async handlers} testevalobjv { set handler1 [testasync create async1] set aresult xxx set acode yyy - set x [list [catch [list testevalobjv 0 testasync mark $handler1 original 0] msg] $msg $acode $aresult] +} -cleanup { testasync delete - set x -} {0 {new result} 0 original} +} -body { + list [testevalobjv 0 testasync mark $handler1 original 0] $acode $aresult +} -result {{new result} 0 original} test parse-8.9 {Tcl_EvalObjv procedure, exceptional return} testevalobjv { list [catch {testevalobjv 0 error message} msg] $msg } {1 message} @@ -284,8 +372,8 @@ test parse-8.10 {Tcl_EvalObjv procedure, TCL_EVAL_GLOBAL} testevalobjv { catch {rename ::noSuchCommand {}} set ::info {} namespace eval test_ns_1 { - testevalobjv 1 noSuchCommand - uplevel #0 noSuchCommand + testevalobjv 1 noSuchCommand + uplevel #0 noSuchCommand } namespace delete test_ns_1 rename ::unknown {} @@ -301,10 +389,10 @@ test parse-8.11 {Tcl_EvalObjv procedure, TCL_EVAL_INVOKE} testevalobjv { $::slave alias bar noSuchCommand set ::info {} namespace eval test_ns_1 { - proc foo args {lappend ::info namespace} - $::slave eval bar - testevalobjv 1 [list $::slave eval bar] - uplevel #0 [list $::slave eval bar] + proc foo args {lappend ::info namespace} + $::slave eval bar + testevalobjv 1 [list $::slave eval bar] + uplevel #0 [list $::slave eval bar] } namespace delete test_ns_1 rename ::foo {} @@ -314,18 +402,18 @@ test parse-8.11 {Tcl_EvalObjv procedure, TCL_EVAL_INVOKE} testevalobjv { } [subst {[set level 2; incr level [info level]] global 1 global 1 global}] test parse-8.12 {Tcl_EvalObjv procedure, TCL_EVAL_INVOKE} { set ::auto_index(noSuchCommand) { - proc noSuchCommand {} {lappend ::info global} + proc noSuchCommand {} {lappend ::info global} } set ::auto_index(::[string trimleft [namespace current]::test_ns_1::noSuchCommand :]) [list \ - proc [namespace current]::test_ns_1::noSuchCommand {} { - lappend ::info ns - }] + proc [namespace current]::test_ns_1::noSuchCommand {} { + lappend ::info ns + }] catch {rename ::noSuchCommand {}} set ::slave [interp create] $::slave alias bar noSuchCommand set ::info {} namespace eval test_ns_1 { - $::slave eval bar + $::slave eval bar } namespace delete test_ns_1 interp delete $::slave @@ -333,14 +421,15 @@ test parse-8.12 {Tcl_EvalObjv procedure, TCL_EVAL_INVOKE} { set ::info } global -test parse-9.1 {Tcl_LogCommandInfo, line numbers} { + +test parse-9.1 {Tcl_LogCommandInfo, line numbers} testevalex { catch {unset x} list [catch {testevalex {for {} 1 {} { # asdf set x - }}}] $errorInfo + }}}] $::errorInfo } {1 {can't read "x": no such variable while executing "set x" @@ -360,264 +449,268 @@ test parse-9.1 {Tcl_LogCommandInfo, line numbers} { set x }}"}} test parse-9.2 {Tcl_LogCommandInfo, truncating long commands} { - list [testevalex {catch {set a b 111111111 222222222 333333333 444444444 555555555 666666666 777777777 888888888 999999999 000000000 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd eeeeeeeee fffffffff ggggggggg}}] $errorInfo + list [catch {set a b 111111111 222222222 333333333 444444444 555555555 666666666 777777777 888888888 999999999 000000000 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd eeeeeeeee fffffffff ggggggggg}] $::errorInfo } {1 {wrong # args: should be "set varName ?newValue?" while executing "set a b 111111111 222222222 333333333 444444444 555555555 666666666 777777777 888888888 999999999 000000000 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd ee..."}} -test parse-10.1 {Tcl_EvalTokens, simple text} { +test parse-10.1 {Tcl_EvalTokens, simple text} testevalex { testevalex {concat test} } {test} -test parse-10.2 {Tcl_EvalTokens, backslash sequences} { +test parse-10.2 {Tcl_EvalTokens, backslash sequences} testevalex { testevalex {concat test\063\062test} } {test32test} -test parse-10.3 {Tcl_EvalTokens, nested commands} { +test parse-10.3 {Tcl_EvalTokens, nested commands} testevalex { testevalex {concat [expr 2 + 6]} } {8} -test parse-10.4 {Tcl_EvalTokens, nested commands} { +test parse-10.4 {Tcl_EvalTokens, nested commands} testevalex { catch {unset a} list [catch {testevalex {concat xxx[expr $a]}} msg] $msg } {1 {can't read "a": no such variable}} -test parse-10.5 {Tcl_EvalTokens, simple variables} { +test parse-10.5 {Tcl_EvalTokens, simple variables} testevalex { set a hello testevalex {concat $a} } {hello} -test parse-10.6 {Tcl_EvalTokens, array variables} { +test parse-10.6 {Tcl_EvalTokens, array variables} testevalex { catch {unset a} set a(12) 46 testevalex {concat $a(12)} } {46} -test parse-10.7 {Tcl_EvalTokens, array variables} { +test parse-10.7 {Tcl_EvalTokens, array variables} testevalex { catch {unset a} set a(12) 46 testevalex {concat $a(1[expr 3 - 1])} } {46} -test parse-10.8 {Tcl_EvalTokens, array variables} { +test parse-10.8 {Tcl_EvalTokens, array variables} testevalex { catch {unset a} list [catch {testevalex {concat $x($a)}} msg] $msg } {1 {can't read "a": no such variable}} -test parse-10.9 {Tcl_EvalTokens, array variables} { +test parse-10.9 {Tcl_EvalTokens, array variables} testevalex { catch {unset a} list [catch {testevalex {concat xyz$a(1)}} msg] $msg } {1 {can't read "a(1)": no such variable}} -test parse-10.10 {Tcl_EvalTokens, object values} { +test parse-10.10 {Tcl_EvalTokens, object values} testevalex { set a 123 testevalex {concat $a} } {123} -test parse-10.11 {Tcl_EvalTokens, object values} { +test parse-10.11 {Tcl_EvalTokens, object values} testevalex { set a 123 testevalex {concat $a$a$a} } {123123123} -test parse-10.12 {Tcl_EvalTokens, object values} { +test parse-10.12 {Tcl_EvalTokens, object values} testevalex { testevalex {concat [expr 2][expr 4][expr 6]} } {246} -test parse-10.13 {Tcl_EvalTokens, string values} { +test parse-10.13 {Tcl_EvalTokens, string values} testevalex { testevalex {concat {a" b"}} } {a" b"} -test parse-10.14 {Tcl_EvalTokens, string values} { +test parse-10.14 {Tcl_EvalTokens, string values} testevalex { set a 111 testevalex {concat x$a.$a.$a} } {x111.111.111} -test parse-11.1 {Tcl_EvalEx, TCL_EVAL_GLOBAL flag} { +test parse-11.1 {Tcl_EvalEx, TCL_EVAL_GLOBAL flag} -constraints { + testevalex +} -setup { proc x {} { set y 777 set z [testevalex "set y" global] return [list $z $y] } - catch {unset y} - set y 321 + set ::y 321 +} -cleanup { + unset ::y +} -body { x -} {321 777} -test parse-11.2 {Tcl_EvalEx, error while parsing} { +} -result {321 777} +test parse-11.2 {Tcl_EvalEx, error while parsing} testevalex { list [catch {testevalex {concat "abc}} msg] $msg } {1 {missing "}} -test parse-11.3 {Tcl_EvalEx, error while collecting words} { +test parse-11.3 {Tcl_EvalEx, error while collecting words} testevalex { catch {unset a} list [catch {testevalex {concat xyz $a}} msg] $msg } {1 {can't read "a": no such variable}} -test parse-11.4 {Tcl_EvalEx, error in Tcl_EvalObjv call} { +test parse-11.4 {Tcl_EvalEx, error in Tcl_EvalObjv call} testevalex { catch {unset a} list [catch {testevalex {_bogus_ a b c d}} msg] $msg } {1 {invalid command name "_bogus_"}} -test parse-11.5 {Tcl_EvalEx, exceptional return} { +test parse-11.5 {Tcl_EvalEx, exceptional return} testevalex { list [catch {testevalex {break}} msg] $msg } {3 {}} -test parse-11.6 {Tcl_EvalEx, freeing memory} { +test parse-11.6 {Tcl_EvalEx, freeing memory} testevalex { 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 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} -test parse-11.7 {Tcl_EvalEx, multiple commands in script} { +test parse-11.7 {Tcl_EvalEx, multiple commands in script} testevalex { list [testevalex {set a b; set c d}] $a $c } {d b d} -test parse-11.8 {Tcl_EvalEx, multiple commands in script} { +test parse-11.8 {Tcl_EvalEx, multiple commands in script} testevalex { list [testevalex { set a b set c d }] $a $c } {d b d} -test parse-11.9 {Tcl_EvalEx, freeing memory after error} { +test parse-11.9 {Tcl_EvalEx, freeing memory after error} testevalex { catch {unset a} 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 } {1 {can't read "a": no such variable}} -test parse-11.10 {Tcl_EvalTokens, empty commands} { +test parse-11.10 {Tcl_EvalTokens, empty commands} testevalex { testevalex {concat xyz; } } {xyz} -test parse-11.11 {Tcl_EvalTokens, empty commands} { +test parse-11.11 {Tcl_EvalTokens, empty commands} testevalex { testevalex "concat abc; ; # this is a comment\n" } {abc} -test parse-11.12 {Tcl_EvalTokens, empty commands} { +test parse-11.12 {Tcl_EvalTokens, empty commands} testevalex { testevalex {} } {} -test parse-12.1 {Tcl_ParseVarName procedure, initialization} { +test parse-12.1 {Tcl_ParseVarName procedure, initialization} testparsevarname { list [catch {testparsevarname {$a([first second])} 8 0} msg] $msg } {1 {missing close-bracket}} -test parse-12.2 {Tcl_ParseVarName procedure, initialization} { +test parse-12.2 {Tcl_ParseVarName procedure, initialization} testparsevarname { testparsevarname {$a([first second])} 0 0 } {- {} 0 variable {$a([first second])} 2 text a 0 command {[first second]} 0 {}} -test parse-12.3 {Tcl_ParseVarName procedure, initialization} { +test parse-12.3 {Tcl_ParseVarName procedure, initialization} testparsevarname { list [catch {testparsevarname {$abcd} 3 0} msg] $msg } {0 {- {} 0 variable {$ab} 1 text ab 0 cd}} -test parse-12.4 {Tcl_ParseVarName procedure, initialization} { +test parse-12.4 {Tcl_ParseVarName procedure, initialization} testparsevarname { testparsevarname {$abcd} 0 0 } {- {} 0 variable {$abcd} 1 text abcd 0 {}} -test parse-12.5 {Tcl_ParseVarName procedure, just a dollar sign} { +test parse-12.5 {Tcl_ParseVarName procedure, just a dollar sign} testparsevarname { testparsevarname {$abcd} 1 0 } {- {} 0 text {$} 0 abcd} -test parse-12.6 {Tcl_ParseVarName procedure, braced variable name} { +test parse-12.6 {Tcl_ParseVarName procedure, braced variable name} testparser { testparser {${..[]b}cd} 0 } {- {${..[]b}cd} 1 word {${..[]b}cd} 3 variable {${..[]b}} 1 text {..[]b} 0 text cd 0 {}} -test parse-12.7 {Tcl_ParseVarName procedure, braced variable name} { +test parse-12.7 {Tcl_ParseVarName procedure, braced variable name} testparser { testparser "\$\{\{\} " 0 } {- \$\{\{\}\ 1 word \$\{\{\} 2 variable \$\{\{\} 1 text \{ 0 {}} -test parse-12.8 {Tcl_ParseVarName procedure, missing close brace} { - list [catch {testparser "$\{abc" 0} msg] $msg $errorInfo +test parse-12.8 {Tcl_ParseVarName procedure, missing close brace} testparser { + list [catch {testparser "$\{abc" 0} msg] $msg $::errorInfo } {1 {missing close-brace for variable name} missing\ close-brace\ for\ variable\ name\n\ \ \ \ (remainder\ of\ script:\ \"\{abc\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"\$\\\{abc\"\ 0\"} -test parse-12.9 {Tcl_ParseVarName procedure, missing close brace} { +test parse-12.9 {Tcl_ParseVarName procedure, missing close brace} testparsevarname { list [catch {testparsevarname {${bcd}} 4 0} msg] $msg } {1 {missing close-brace for variable name}} -test parse-12.10 {Tcl_ParseVarName procedure, missing close brace} { +test parse-12.10 {Tcl_ParseVarName procedure, missing close brace} testparsevarname { list [catch {testparsevarname {${bc}} 4 0} msg] $msg } {1 {missing close-brace for variable name}} -test parse-12.11 {Tcl_ParseVarName procedure, simple variable name} { +test parse-12.11 {Tcl_ParseVarName procedure, simple variable name} testparser { testparser {$az_AZ.} 0 } {- {$az_AZ.} 1 word {$az_AZ.} 3 variable {$az_AZ} 1 text az_AZ 0 text . 0 {}} -test parse-12.12 {Tcl_ParseVarName procedure, simple variable name} { +test parse-12.12 {Tcl_ParseVarName procedure, simple variable name} testparser { testparser {$abcdefg} 4 } {- {$abc} 1 word {$abc} 2 variable {$abc} 1 text abc 0 defg} -test parse-12.13 {Tcl_ParseVarName procedure, simple variable name with ::} { +test parse-12.13 {Tcl_ParseVarName procedure, simple variable name with ::} testparser { testparser {$xyz::ab:c} 0 } {- {$xyz::ab:c} 1 word {$xyz::ab:c} 3 variable {$xyz::ab} 1 text xyz::ab 0 text :c 0 {}} -test parse-12.14 {Tcl_ParseVarName procedure, variable names with many colons} { +test parse-12.14 {Tcl_ParseVarName procedure, variable names with many colons} testparser { testparser {$xyz:::::c} 0 } {- {$xyz:::::c} 1 word {$xyz:::::c} 2 variable {$xyz:::::c} 1 text xyz:::::c 0 {}} -test parse-12.15 {Tcl_ParseVarName procedure, : vs. ::} { +test parse-12.15 {Tcl_ParseVarName procedure, : vs. ::} testparsevarname { testparsevarname {$ab:cd} 0 0 } {- {} 0 variable {$ab} 1 text ab 0 :cd} -test parse-12.16 {Tcl_ParseVarName procedure, eof in ::} { +test parse-12.16 {Tcl_ParseVarName procedure, eof in ::} testparsevarname { testparsevarname {$ab::cd} 4 0 } {- {} 0 variable {$ab} 1 text ab 0 ::cd} -test parse-12.17 {Tcl_ParseVarName procedure, eof in ::} { +test parse-12.17 {Tcl_ParseVarName procedure, eof in ::} testparsevarname { testparsevarname {$ab:::cd} 5 0 } {- {} 0 variable {$ab::} 1 text ab:: 0 :cd} -test parse-12.18 {Tcl_ParseVarName procedure, no variable name} { +test parse-12.18 {Tcl_ParseVarName procedure, no variable name} testparser { testparser {$$ $.} 0 } {- {$$ $.} 2 word {$$} 2 text {$} 0 text {$} 0 word {$.} 2 text {$} 0 text . 0 {}} -test parse-12.19 {Tcl_ParseVarName procedure, EOF before (} { +test parse-12.19 {Tcl_ParseVarName procedure, EOF before (} testparsevarname { testparsevarname {$ab(cd)} 3 0 } {- {} 0 variable {$ab} 1 text ab 0 (cd)} -test parse-12.20 {Tcl_ParseVarName procedure, array reference} { +test parse-12.20 {Tcl_ParseVarName procedure, array reference} testparser { testparser {$x(abc)} 0 } {- {$x(abc)} 1 word {$x(abc)} 3 variable {$x(abc)} 2 text x 0 text abc 0 {}} -test parse-12.21 {Tcl_ParseVarName procedure, array reference} { +test parse-12.21 {Tcl_ParseVarName procedure, array reference} testparser { testparser {$x(ab$cde[foo bar])} 0 } {- {$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 {}} -test parse-12.22 {Tcl_ParseVarName procedure, array reference} { +test parse-12.22 {Tcl_ParseVarName procedure, array reference} testparser { testparser {$x([cmd arg]zz)} 0 } {- {$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 {}} -test parse-12.23 {Tcl_ParseVarName procedure, missing close paren in array reference} { - list [catch {testparser {$x(poiu} 0} msg] $msg $errorInfo +test parse-12.23 {Tcl_ParseVarName procedure, missing close paren in array reference} testparser { + list [catch {testparser {$x(poiu} 0} msg] $msg $::errorInfo } {1 {missing )} {missing ) (remainder of script: "(poiu") invoked from within "testparser {$x(poiu} 0"}} -test parse-12.24 {Tcl_ParseVarName procedure, missing close paren in array reference} { - list [catch {testparsevarname {$ab(cd)} 6 0} msg] $msg $errorInfo +test parse-12.24 {Tcl_ParseVarName procedure, missing close paren in array reference} testparsevarname { + list [catch {testparsevarname {$ab(cd)} 6 0} msg] $msg $::errorInfo } {1 {missing )} {missing ) (remainder of script: "(cd)") invoked from within "testparsevarname {$ab(cd)} 6 0"}} -test parse-12.25 {Tcl_ParseVarName procedure, nested array reference} { +test parse-12.25 {Tcl_ParseVarName procedure, nested array reference} testparser { testparser {$x(a$y(b$z))} 0 } {- {$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 {}} -test parse-13.1 {Tcl_ParseVar procedure} { +test parse-13.1 {Tcl_ParseVar procedure} testparsevar { set abc 24 testparsevar {$abc.fg} } {24 .fg} -test parse-13.2 {Tcl_ParseVar procedure, no variable name} { +test parse-13.2 {Tcl_ParseVar procedure, no variable name} testparsevar { testparsevar {$} } {{$} {}} -test parse-13.3 {Tcl_ParseVar procedure, no variable name} { +test parse-13.3 {Tcl_ParseVar procedure, no variable name} testparsevar { testparsevar {$.123} } {{$} .123} -test parse-13.4 {Tcl_ParseVar procedure, error looking up variable} { +test parse-13.4 {Tcl_ParseVar procedure, error looking up variable} testparsevar { catch {unset abc} list [catch {testparsevar {$abc}} msg] $msg } {1 {can't read "abc": no such variable}} -test parse-13.5 {Tcl_ParseVar procedure, error looking up variable} { +test parse-13.5 {Tcl_ParseVar procedure, error looking up variable} testparsevar { catch {unset abc} list [catch {testparsevar {$abc([bogus x y z])}} msg] $msg } {1 {invalid command name "bogus"}} -test parse-14.1 {Tcl_ParseBraces procedure, computing string length} { +test parse-14.1 {Tcl_ParseBraces procedure, computing string length} testparser { testparser [bytestring "foo\0 bar"] -1 } {- foo 1 simple foo 1 text foo 0 {}} -test parse-14.2 {Tcl_ParseBraces procedure, computing string length} { +test parse-14.2 {Tcl_ParseBraces procedure, computing string length} testparser { testparser "foo bar" -1 } {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}} -test parse-14.3 {Tcl_ParseBraces procedure, words in braces} { +test parse-14.3 {Tcl_ParseBraces procedure, words in braces} testparser { testparser {foo {a $b [concat foo]} {c d}} 0 } {- {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 {}} -test parse-14.4 {Tcl_ParseBraces procedure, empty nested braces} { +test parse-14.4 {Tcl_ParseBraces procedure, empty nested braces} testparser { testparser {foo {{}}} 0 } {- {foo {{}}} 2 simple foo 1 text foo 0 simple {{{}}} 1 text {{}} 0 {}} -test parse-14.5 {Tcl_ParseBraces procedure, nested braces} { +test parse-14.5 {Tcl_ParseBraces procedure, nested braces} testparser { testparser {foo {{a {b} c} {} {d e}}} 0 } {- {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 {}} -test parse-14.6 {Tcl_ParseBraces procedure, backslashes in words in braces} { +test parse-14.6 {Tcl_ParseBraces procedure, backslashes in words in braces} testparser { testparser "foo {a \\n\\\{}" 0 } {- {foo {a \n\{}} 2 simple foo 1 text foo 0 simple {{a \n\{}} 1 text {a \n\{} 0 {}} -test parse-14.7 {Tcl_ParseBraces procedure, missing continuation line in braces} { - list [catch {testparser "\{abc\\\n" 0} msg] $msg $errorInfo +test parse-14.7 {Tcl_ParseBraces procedure, missing continuation line in braces} testparser { + list [catch {testparser "\{abc\\\n" 0} msg] $msg $::errorInfo } {1 {missing close-brace} missing\ close-brace\n\ \ \ \ (remainder\ of\ script:\ \"\{abc\\\n\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"\\\{abc\\\\\\n\"\ 0\"} -test parse-14.8 {Tcl_ParseBraces procedure, backslash-newline in braces} { +test parse-14.8 {Tcl_ParseBraces procedure, backslash-newline in braces} testparser { testparser "foo {\\\nx}" 0 } {- foo\ \{\\\nx\} 2 simple foo 1 text foo 0 word \{\\\nx\} 2 backslash \\\n 0 text x 0 {}} -test parse-14.9 {Tcl_ParseBraces procedure, backslash-newline in braces} { +test parse-14.9 {Tcl_ParseBraces procedure, backslash-newline in braces} testparser { testparser "foo {a \\\n b}" 0 } {- 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 {}} -test parse-14.10 {Tcl_ParseBraces procedure, backslash-newline in braces} { +test parse-14.10 {Tcl_ParseBraces procedure, backslash-newline in braces} testparser { testparser "foo {xyz\\\n }" 0 } {- foo\ \{xyz\\\n\ \} 2 simple foo 1 text foo 0 word \{xyz\\\n\ \} 2 text xyz 0 backslash \\\n\ 0 {}} -test parse-14.11 {Tcl_ParseBraces procedure, empty braced string} { +test parse-14.11 {Tcl_ParseBraces procedure, empty braced string} testparser { testparser {foo {}} 0 } {- {foo {}} 2 simple foo 1 text foo 0 simple {{}} 1 text {} 0 {}} -test parse-14.12 {Tcl_ParseBraces procedure, missing close brace} { - list [catch {testparser "foo \{xy\\\nz" 0} msg] $msg $errorInfo +test parse-14.12 {Tcl_ParseBraces procedure, missing close brace} testparser { + list [catch {testparser "foo \{xy\\\nz" 0} msg] $msg $::errorInfo } {1 {missing close-brace} missing\ close-brace\n\ \ \ \ (remainder\ of\ script:\ \"\{xy\\\nz\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"foo\ \\\{xy\\\\\\nz\"\ 0\"} -test parse-15.1 {Tcl_ParseQuotedString procedure, computing string length} { +test parse-15.1 {Tcl_ParseQuotedString procedure, computing string length} testparser { testparser [bytestring "foo\0 bar"] -1 } {- foo 1 simple foo 1 text foo 0 {}} -test parse-15.2 {Tcl_ParseQuotedString procedure, computing string length} { +test parse-15.2 {Tcl_ParseQuotedString procedure, computing string length} testparser { testparser "foo bar" -1 } {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}} -test parse-15.3 {Tcl_ParseQuotedString procedure, word is quoted string} { +test parse-15.3 {Tcl_ParseQuotedString procedure, word is quoted string} testparser { testparser {foo "a b c" d "efg";} 0 } {- {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 {}} -test parse-15.4 {Tcl_ParseQuotedString procedure, garbage after quoted string} { - list [catch {testparser {foo "a b c"d} 0} msg] $msg $errorInfo +test parse-15.4 {Tcl_ParseQuotedString procedure, garbage after quoted string} testparser { + list [catch {testparser {foo "a b c"d} 0} msg] $msg $::errorInfo } {1 {extra characters after close-quote} {extra characters after close-quote (remainder of script: "d") invoked from within @@ -762,16 +855,16 @@ test parse-15.50 {CommandComplete procedure} { info complete "abc\\\n" } 0 test parse-15.51 {CommandComplete procedure} " - info complete \"\\{abc\\}\\{\" + info complete \"\\\{abc\\\}\\\{\" " 1 test parse-15.52 {CommandComplete procedure} { info complete "\"abc\"(" } 1 test parse-15.53 {CommandComplete procedure} " - info complete \" # {\" + info complete \" # \{\" " 1 test parse-15.54 {CommandComplete procedure} " - info complete \"foo bar;# {\" + info complete \"foo bar;# \{\" " 1 test parse-15.55 {CommandComplete procedure} { info complete "set x [bytestring \0]; puts hi" @@ -789,6 +882,10 @@ test parse-15.59 {CommandComplete procedure} { # Test for Tcl Bug 684744 info complete [encoding convertfrom identity "\x00;if 1 \{"] } 0 +test parse-15.60 {CommandComplete procedure} { + # Test for Tcl Bug 1968882 + info complete \\\n +} 0 test parse-16.1 {Tcl_EvalEx, check termOffset is set correctly for non TCL_OK cases, bug 2535} { subst {[eval {return foo}]bar} @@ -798,6 +895,115 @@ test parse-17.1 {Correct return codes from errors during substitution} { catch {eval {w[continue]}} } 4 +test parse-18.1 {Tcl_SubstObj, ParseTokens flags} { + subst {foo\t$::tcl_library\t[set ::tcl_library]} +} "foo $::tcl_library $::tcl_library" +test parse-18.2 {Tcl_SubstObj, ParseTokens flags} { + subst -nocommands {foo\t$::tcl_library\t[set ::tcl_library]} +} "foo $::tcl_library \[set ::tcl_library]" +test parse-18.3 {Tcl_SubstObj, ParseTokens flags} { + subst -novariables {foo\t$::tcl_library\t[set ::tcl_library]} +} "foo \$::tcl_library $::tcl_library" +test parse-18.4 {Tcl_SubstObj, ParseTokens flags} { + subst -nobackslashes {foo\t$::tcl_library\t[set ::tcl_library]} +} "foo\\t$::tcl_library\\t$::tcl_library" +test parse-18.5 {Tcl_SubstObj, ParseTokens flags} { + subst -novariables -nobackslashes {foo\t$::tcl_library\t[set ::tcl_library]} +} "foo\\t\$::tcl_library\\t$::tcl_library" +test parse-18.6 {Tcl_SubstObj, ParseTokens flags} { + subst -nocommands -nobackslashes {foo\t$::tcl_library\t[set ::tcl_library]} +} "foo\\t$::tcl_library\\t\[set ::tcl_library]" +test parse-18.7 {Tcl_SubstObj, ParseTokens flags} { + subst -nocommands -novariables {foo\t$::tcl_library\t[set ::tcl_library]} +} "foo \$::tcl_library \[set ::tcl_library]" +test parse-18.8 {Tcl_SubstObj, ParseTokens flags} { + subst -nocommands -novariables -nobackslashes \ + {foo\t$::tcl_library\t[set ::tcl_library]} +} "foo\\t\$::tcl_library\\t\[set ::tcl_library]" + +test parse-18.9 {Tcl_SubstObj, parse errors} { + list [catch "subst foo\$\{foo" msg] $msg +} [list 1 "missing close-brace for variable name"] +test parse-18.10 {Tcl_SubstObj, parse errors} { + list [catch "subst foo\[set \$\{foo]" msg] $msg +} [list 1 "missing close-brace for variable name"] +test parse-18.11 {Tcl_SubstObj, parse errors} { + list [catch "subst foo\$array(\$\{foo)" msg] $msg +} [list 1 "missing close-brace for variable name"] +test parse-18.12 {Tcl_SubstObj, parse errors} { + list [catch "subst foo\$(\$\{foo)" msg] $msg +} [list 1 "missing close-brace for variable name"] +test parse-18.13 {Tcl_SubstObj, parse errors} { + list [catch "subst \[" msg] $msg +} [list 1 "missing close-bracket"] + +test parse-18.14 {Tcl_SubstObj, exception handling} { + subst {abc,[break],def} +} {abc,} +test parse-18.15 {Tcl_SubstObj, exception handling} { + subst {abc,[continue; expr 1+2],def} +} {abc,,def} +test parse-18.16 {Tcl_SubstObj, exception handling} { + subst {abc,[return foo; expr 1+2],def} +} {abc,foo,def} +test parse-18.17 {Tcl_SubstObj, exception handling} { + subst {abc,[return -code 10 foo; expr 1+2],def} +} {abc,foo,def} +test parse-18.18 {Tcl_SubstObj, exception handling} { + subst {abc,[break; set {} {}{}],def} +} {abc,} +test parse-18.19 {Tcl_SubstObj, exception handling} { + list [catch {subst {abc,[continue; expr 1+2; set {} {}{}],def}} msg] $msg +} [list 1 "extra characters after close-brace"] +test parse-18.20 {Tcl_SubstObj, exception handling} { + list [catch {subst {abc,[return foo; expr 1+2; set {} {}{}],def}} msg] $msg +} [list 1 "extra characters after close-brace"] +test parse-18.21 {Tcl_SubstObj, exception handling} { + list [catch { + subst {abc,[return -code 10 foo; expr 1+2; set {} {}{}],def} + } msg] $msg +} [list 1 "extra characters after close-brace"] + +test parse-18.22 {Tcl_SubstObj, side effects} { + set a 0 + list [subst {foo[incr a]bar}] $a +} [list foo1bar 1] +test parse-18.23 {Tcl_SubstObj, side effects} { + set a 0 + list [subst {foo[incr a; incr a]bar}] $a +} [list foo2bar 2] +test parse-18.24 {Tcl_SubstObj, side effects} { + set a 0 + list [subst {foo[incr a; break; incr a]bar}] $a +} [list foo 1] +test parse-18.25 {Tcl_SubstObj, side effects} { + set a 0 + list [subst {foo[incr a; continue; incr a]bar}] $a +} [list foobar 1] +test parse-18.26 {Tcl_SubstObj, side effects} { + set a 0 + list [subst {foo[incr a; return; incr a]bar}] $a +} [list foobar 1] +test parse-18.27 {Tcl_SubstObj, side effects} { + set a 0 + list [subst {foo[incr a; return -code 10; incr a]bar}] $a +} [list foobar 1] +test parse-18.28 {Tcl_SubstObj, side effects} { + set a 0 + catch {subst {foo[incr a; parse error {}{}; incr a]bar}} + set a +} 1 +test parse-18.29 {Tcl_SubstObj, side effects} { + set a 0 + catch {subst {foo[incr a; incr a; parse error {}{}]bar}} + set a +} 2 +test parse-18.30 {Tcl_SubstObj, side effects} { + set a 0 + catch {subst {foo[incr a; incr a parse error {}{}]bar}} + set a +} 1 + test parse-19.1 {Bug 1115904: recursion limit in Tcl_EvalEx} -constraints { testevalex } -setup { @@ -844,7 +1050,8 @@ test parse-19.4 {Bug 1115904: recursion limit in Tcl_EvalEx} -setup { interp delete i } -returnCodes error -match glob -result {too many nested*} -# cleanup -catch {unset a} -::tcltest::cleanupTests +cleanupTests +} + +namespace delete ::tcl::test::parse return |