diff options
Diffstat (limited to 'tests/parse.test')
| -rw-r--r-- | tests/parse.test | 1638 |
1 files changed, 1107 insertions, 531 deletions
diff --git a/tests/parse.test b/tests/parse.test index 7019b7a..01443c9 100644 --- a/tests/parse.test +++ b/tests/parse.test @@ -1,556 +1,1132 @@ -# Commands covered: set (plus basic command syntax). Also tests -# the procedures in the file tclParse.c. -# -# This file contains a collection of tests for one or more of the Tcl -# built-in commands. Sourcing this file into Tcl runs the tests and +# This file contains a collection of tests for the procedures in the +# file tclParse.c. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # -# Copyright (c) 1991-1993 The Regents of the University of California. -# Copyright (c) 1994-1996 Sun Microsystems, Inc. +# Copyright (c) 1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: parse.test,v 1.2 1998/09/14 18:40:12 stanton Exp $ - -if {[string compare test [info procs test]] == 1} then {source defs} -proc fourArgs {a b c d} { - global arg1 arg2 arg3 arg4 - set arg1 $a - set arg2 $b - set arg3 $c - set arg4 $d +if {[catch {package require tcltest 2.0.2}]} { + puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required." + return } -proc getArgs args { - global argv - set argv $args -} +namespace eval ::tcl::test::parse { + namespace import ::tcltest::* -# Basic argument parsing. - -test parse-1.1 {basic argument parsing} { - set arg1 {} - fourArgs a b c d - list $arg1 $arg2 $arg3 $arg4 -} {a b c d} -test parse-1.2 {basic argument parsing} { - set arg1 {} - eval "fourArgs 123\v4\f56\r7890" - list $arg1 $arg2 $arg3 $arg4 -} {123 4 56 7890} - -# Quotes. - -test parse-2.1 {quotes and variable-substitution} { - getArgs "a b c" d - set argv -} {{a b c} d} -test parse-2.2 {quotes and variable-substitution} { - set a 101 - getArgs "a$a b c" - set argv -} {{a101 b c}} -test parse-2.3 {quotes and variable-substitution} { - set argv "xy[format xabc]" - set argv -} {xyxabc} -test parse-2.4 {quotes and variable-substitution} { - set argv "xy\t" - set argv -} xy\t -test parse-2.5 {quotes and variable-substitution} { - set argv "a b c -d e f" - set argv -} a\ b\tc\nd\ e\ f -test parse-2.6 {quotes and variable-substitution} { - set argv a"bcd"e - set argv -} {a"bcd"e} - -# Braces. - -test parse-3.1 {braces} { - getArgs {a b c} d - set argv -} "{a b c} d" -test parse-3.2 {braces} { - set a 101 - set argv {a$a b c} - set b [string index $argv 1] - set b -} {$} -test parse-3.3 {braces} { - set argv {a[format xyz] b} - string length $argv -} 15 -test parse-3.4 {braces} { - set argv {a\nb\}} - string length $argv -} 6 -test parse-3.5 {braces} { - set argv {{{{}}}} - set argv -} "{{{}}}" -test parse-3.6 {braces} { - set argv a{{}}b - set argv -} "a{{}}b" -test parse-3.7 {braces} { - set a [format "last]"] - set a -} {last]} +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] -# Command substitution. +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]] +testConstraint testevent [llength [info commands testevent]] +testConstraint memory [llength [info commands memory]] -test parse-4.1 {command substitution} { - set a [format xyz] - set a -} xyz -test parse-4.2 {command substitution} { - set a a[format xyz]b[format q] - set a -} axyzbq -test parse-4.3 {command substitution} { - set a a[ -set b 22; -format %s $b +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} 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} testparser { + testparser " \n\t foo" 0 +} {- foo 1 simple foo 1 text foo 0 {}} +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} 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} 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} testparser { + testparser " \\\n" 0 +} {- {} 0 {}} +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}} -]b - set a -} a22b -test parse-4.4 {command substitution} { - set a 7.7 - if [catch {expr int($a)}] {set a foo} - set a -} 7.7 +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} 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} 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} testparser { + testparser "# \\\n" 0 +} {\#\ \ \ \\\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} 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} 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} 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} testparser { + testparser "foo " 5 +} {- {foo } 1 simple foo 1 text foo 0 { }} +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} 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} 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} testparser { + testparser {foo} 0 +} {- foo 1 simple foo 1 text foo 0 {}} +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} 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} 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} 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} 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} 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} 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} 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} 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} 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} 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} 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} 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} 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} 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 +} "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-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-5.28 {Tcl_ParseCommand: {*} parsing, expanded literals} testparser { + testparser {{*}{a b}} 0 +} {- {{*}{a b}} 2 simple a 1 text a 0 simple b 1 text b 0 {}} +test parse-5.29 {Tcl_ParseCommand: {*} parsing, expanded literals, naked backslashes} testparser { + testparser {{*}{a \n b}} 0 +} {- {{*}{a \n b}} 1 expand {{*}{a \n b}} 1 text {a \n b} 0 {}} +test parse-5.30 {Tcl_ParseCommand: {*} parsing, expanded literals} testparser { + testparser {{*}"a b"} 0 +} {- {{*}"a b"} 2 simple a 1 text a 0 simple b 1 text b 0 {}} +test parse-5.31 {Tcl_ParseCommand: {*} parsing, expanded literals, naked backslashes} testparser { + testparser {{*}"a \n b"} 0 +} {- {{*}"a \n b"} 1 expand {{*}"a \n b"} 3 text {a } 0 backslash {\n} 0 text { b} 0 {}} -# Variable substitution. +test parse-6.1 {ParseTokens procedure, empty word} testparser { + testparser {""} 0 +} {- {""} 1 simple {""} 1 text {} 0 {}} +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} 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} testparser { + list [catch {testparser {$x([a )} 0} msg] $msg +} {1 {missing close-bracket}} +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} 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} 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 +"testparser {a [b {}c d] e} 0"}} +test parse-6.8 {ParseTokens procedure, error in command substitution} { + info complete {a [b {}c d]} +} {1} +test parse-6.9 {ParseTokens procedure, error in command substitution} { + info complete {a [b "c d} +} {0} +test parse-6.10 {ParseTokens procedure, incomplete sub-command} { + info complete {puts [ + expr 1+1 + #this is a comment ]} +} {0} +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} 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} 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} 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} 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} 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} 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} 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} 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 {}} -test parse-5.1 {variable substitution} { +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 + set x [catch {testevalobjv 10 asdf poiu} msg] + 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 { + return "unknown $args" + } + set x [catch {testevalobjv 0 asdf poiu} msg] + 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 { + error "I don't like that command" + } + set x [catch {testevalobjv 0 asdf poiu} msg] + 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 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} -constraints { + testevalobjv +} -setup { + proc x {} { + set y 23 + set z [testevalobjv 1 set y] + return [list $z $y] + } + set ::y 16 +} -cleanup { + unset ::y +} -body { + x +} -result {16 23} +test parse-8.8 {Tcl_EvalObjv procedure, async handlers} -constraints { + testevalobjv testasync +} -setup { + variable ::aresult + variable ::acode + proc async1 {result code} { + variable ::aresult + variable ::acode + set aresult $result + set acode $code + return "new result" + } + set handler1 [testasync create async1] + set aresult xxx + set acode yyy +} -cleanup { + testasync delete +} -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} +test parse-8.10 {Tcl_EvalObjv procedure, TCL_EVAL_GLOBAL} testevalobjv { + rename ::unknown unknown.save + proc ::unknown args {lappend ::info [info level]} + catch {rename ::noSuchCommand {}} + set ::info {} + namespace eval test_ns_1 { + testevalobjv 1 noSuchCommand + uplevel #0 noSuchCommand + } + namespace delete test_ns_1 + rename ::unknown {} + rename unknown.save ::unknown + set ::info +} {1 1} +test parse-8.11 {Tcl_EvalObjv procedure, TCL_EVAL_INVOKE} testevalobjv { + rename ::unknown unknown.save + proc ::unknown args {lappend ::info [info level]; uplevel 1 foo} + proc ::foo args {lappend ::info global} + catch {rename ::noSuchCommand {}} + set ::slave [interp create] + $::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] + } + namespace delete test_ns_1 + rename ::foo {} + rename ::unknown {} + rename unknown.save ::unknown + set ::info +} [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} + } + set ::auto_index(::[string trimleft [namespace current]::test_ns_1::noSuchCommand :]) [list \ + 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 + } + namespace delete test_ns_1 + interp delete $::slave + catch {rename ::noSuchCommand {}} + set ::info +} global + + +test parse-9.1 {Tcl_LogCommandInfo, line numbers} testevalex { + unset -nocomplain x + list [catch {testevalex {for {} 1 {} { + + + # asdf + set x + }}}] $::errorInfo +} {1 {can't read "x": no such variable + while executing +"set x" + ("for" body line 5) + invoked from within +"for {} 1 {} { + + + # asdf + set x + }" + invoked from within +"testevalex {for {} 1 {} { + + + # asdf + set x + }}"}} +test parse-9.2 {Tcl_LogCommandInfo, truncating long commands} { + 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} testevalex { + testevalex {concat test} +} {test} +test parse-10.2 {Tcl_EvalTokens, backslash sequences} testevalex { + testevalex {concat test\063\062test} +} {test32test} +test parse-10.3 {Tcl_EvalTokens, nested commands} testevalex { + testevalex {concat [expr 2 + 6]} +} {8} +test parse-10.4 {Tcl_EvalTokens, nested commands} testevalex { + unset -nocomplain 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} testevalex { + set a hello + testevalex {concat $a} +} {hello} +test parse-10.6 {Tcl_EvalTokens, array variables} testevalex { + unset -nocomplain a + set a(12) 46 + testevalex {concat $a(12)} +} {46} +test parse-10.7 {Tcl_EvalTokens, array variables} testevalex { + unset -nocomplain a + set a(12) 46 + testevalex {concat $a(1[expr 3 - 1])} +} {46} +test parse-10.8 {Tcl_EvalTokens, array variables} testevalex { + unset -nocomplain 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} testevalex { + unset -nocomplain 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} testevalex { set a 123 - set b $a - set b -} 123 -test parse-5.2 {variable substitution} { - set a 345 - set b x$a.b - set b -} x345.b -test parse-5.3 {variable substitution} { - set _123z xx - set b $_123z^ - set b -} xx^ -test parse-5.4 {variable substitution} { - set a 78 - set b a${a}b - set b -} a78b -test parse-5.5 {variable substitution} {catch {$_non_existent_} msg} 1 -test parse-5.6 {variable substitution} { - catch {$_non_existent_} msg - set msg -} {can't read "_non_existent_": no such variable} -test parse-5.7 {array variable substitution} { - catch {unset a} - set a(xyz) 123 - set b $a(xyz)foo - set b -} 123foo -test parse-5.8 {array variable substitution} { - catch {unset a} - set "a(x y z)" 123 - set b $a(x y z)foo - set b -} 123foo -test parse-5.9 {array variable substitution} { - catch {unset a}; catch {unset qqq} - set "a(x y z)" qqq - set $a([format x]\ y [format z]) foo - set qqq -} foo -test parse-5.10 {array variable substitution} { - catch {unset a} - list [catch {set b $a(22)} msg] $msg -} {1 {can't read "a(22)": no such variable}} -test parse-5.11 {array variable substitution} { - set b a$! - set b -} {a$!} -test parse-5.12 {array variable substitution} { - set b a$() - set b -} {a$()} -catch {unset a} -test parse-5.13 {array variable substitution} { - catch {unset a} - set long {This is a very long variable, long enough to cause storage \ - allocation to occur in Tcl_ParseVar. If that storage isn't getting \ - freed up correctly, then a core leak will occur when this test is \ - run. This text is probably beginning to sound like drivel, but I've \ - run out of things to say and I need more characters still.} - set a($long) 777 - set b $a($long) - list $b [array names a] -} {777 {{This is a very long variable, long enough to cause storage \ - allocation to occur in Tcl_ParseVar. If that storage isn't getting \ - freed up correctly, then a core leak will occur when this test is \ - run. This text is probably beginning to sound like drivel, but I've \ - run out of things to say and I need more characters still.}}} -test parse-5.14 {array variable substitution} { - catch {unset a}; catch {unset b}; catch {unset a1} - set a1(22) foo - set a(foo) bar - set b $a($a1(22)) - set b -} bar -catch {unset a}; catch {unset a1} - -# Backslash substitution. - -set errNum 1 -proc bsCheck {char num} { - global errNum -; test parse-6.$errNum {backslash substitution} { - scan $char %c value - set value - } $num - set errNum [expr $errNum+1] -} + testevalex {concat $a} +} {123} +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} testevalex { + testevalex {concat [expr 2][expr 4][expr 6]} +} {246} +test parse-10.13 {Tcl_EvalTokens, string values} testevalex { + testevalex {concat {a" b"}} +} {a" b"} +test parse-10.14 {Tcl_EvalTokens, string values} testevalex { + set a 111 + testevalex {concat x$a.$a.$a} +} {x111.111.111} -bsCheck \b 8 -bsCheck \e 101 -bsCheck \f 12 -bsCheck \n 10 -bsCheck \r 13 -bsCheck \t 9 -bsCheck \v 11 -bsCheck \{ 123 -bsCheck \} 125 -bsCheck \[ 91 -bsCheck \] 93 -bsCheck \$ 36 -bsCheck \ 32 -bsCheck \; 59 -bsCheck \\ 92 -bsCheck \Ca 67 -bsCheck \Ma 77 -bsCheck \CMa 67 -bsCheck \8a 8 -bsCheck \14 12 -bsCheck \141 97 -bsCheck \340 224 -bsCheck b\0 98 -bsCheck \x 120 -bsCheck \xa 10 -bsCheck \x41 65 -bsCheck \x541 65 - -test parse-6.1 {backslash substitution} { - set a "\a\c\n\]\}" - string length $a -} 5 -test parse-6.2 {backslash substitution} { - set a {\a\c\n\]\}} - string length $a -} 10 -test parse-6.3 {backslash substitution} { - set a "abc\ -def" - set a -} {abc def} -test parse-6.4 {backslash substitution} { - set a {abc\ -def} - set a -} {abc def} -test parse-6.5 {backslash substitution} { - set msg {} - set a xxx - set error [catch {if {24 < \ - 35} {set a 22} {set \ - a 33}} msg] - list $error $msg $a -} {0 22 22} -test parse-6.6 {backslash substitution} { - eval "concat abc\\" -} "abc\\" -test parse-6.7 {backslash substitution} { - eval "concat \\\na" -} "a" -test parse-6.8 {backslash substitution} { - eval "concat x\\\n a" -} "x a" -test parse-6.9 {backslash substitution} { - eval "concat \\x" -} "x" -test parse-6.10 {backslash substitution} { - eval "list a b\\\nc d" -} {a b c d} -test parse-6.11 {backslash substitution} { - eval "list a \"b c\"\\\nd e" -} {a {b c} d e} - -# Semi-colon. - -test parse-7.1 {semi-colons} { - set b 0 - getArgs a;set b 2 - set argv -} a -test parse-7.2 {semi-colons} { - set b 0 - getArgs a;set b 2 - set b -} 2 -test parse-7.3 {semi-colons} { - getArgs a b ; set b 1 - set argv -} {a b} -test parse-7.4 {semi-colons} { - getArgs a b ; set b 1 - set b -} 1 - -# The following checks are to ensure that the interpreter's result -# gets re-initialized by Tcl_Eval in all the right places. - -test parse-8.1 {result initialization} {concat abc} abc -test parse-8.2 {result initialization} {concat abc; proc foo {} {}} {} -test parse-8.3 {result initialization} {concat abc; proc foo {} $a} {} -test parse-8.4 {result initialization} {proc foo {} [concat abc]} {} -test parse-8.5 {result initialization} {concat abc; } abc -test parse-8.6 {result initialization} { - eval { - concat abc -}} abc -test parse-8.7 {result initialization} {} {} -test parse-8.8 {result initialization} {concat abc; ; ;} abc - -# Syntax errors. - -test parse-9.1 {syntax errors} {catch "set a \{bcd" msg} 1 -test parse-9.2 {syntax errors} { - catch "set a \{bcd" msg - set msg -} {missing close-brace} -test parse-9.3 {syntax errors} {catch {set a "bcd} msg} 1 -test parse-9.4 {syntax errors} { - catch {set a "bcd} msg - set msg -} {quoted string doesn't terminate properly} -test parse-9.5 {syntax errors} {catch {set a "bcd"xy} msg} 1 -test parse-9.6 {syntax errors} { - catch {set a "bcd"xy} msg - set msg -} {quoted string doesn't terminate properly} -test parse-9.7 {syntax errors} {catch "set a {bcd}xy" msg} 1 -test parse-9.8 {syntax errors} { - catch "set a {bcd}xy" msg - set msg -} {argument word in braces doesn't terminate properly} -test parse-9.9 {syntax errors} {catch {set a [format abc} msg} 1 -test parse-9.10 {syntax errors} { - catch {set a [format abc} msg - set msg -} {missing close-bracket or close-brace} -test parse-9.11 {syntax errors} {catch gorp-a-lot msg} 1 -test parse-9.12 {syntax errors} { - catch gorp-a-lot msg - set msg -} {invalid command name "gorp-a-lot"} -test parse-9.13 {syntax errors} { - set a [concat {a}\ - {b}] - set a -} {a b} -test parse-9.14 {syntax errors} { - list [catch {eval \$x[format "%01000d" 0](} msg] $msg $errorInfo +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] + } + set ::y 321 +} -cleanup { + unset ::y +} -body { + x +} -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} testevalex { + unset -nocomplain 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} testevalex { + unset -nocomplain a + list [catch {testevalex {_bogus_ a b c d}} msg] $msg +} {1 {invalid command name "_bogus_"}} +test parse-11.5 {Tcl_EvalEx, exceptional return} testevalex { + list [catch {testevalex {break}} msg] $msg +} {3 {}} +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} testevalex { + list [testevalex {set a b; set c d}] $a $c +} {d b d} +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} testevalex { + unset -nocomplain 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} testevalex { + testevalex {concat xyz; } +} {xyz} +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} testevalex { + testevalex {} +} {} + +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} 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} 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} testparsevarname { + testparsevarname {$abcd} 0 0 +} {- {} 0 variable {$abcd} 1 text abcd 0 {}} +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} 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} testparser { + testparser "\$\{\{\} " 0 +} {- \$\{\{\}\ 1 word \$\{\{\} 2 variable \$\{\{\} 1 text \{ 0 {}} +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} 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} 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} 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} 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 ::} 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} 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. ::} testparsevarname { + testparsevarname {$ab:cd} 0 0 +} {- {} 0 variable {$ab} 1 text ab 0 :cd} +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 ::} testparsevarname { + testparsevarname {$ab:::cd} 5 0 +} {- {} 0 variable {$ab::} 1 text ab:: 0 :cd} +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 (} testparsevarname { + testparsevarname {$ab(cd)} 3 0 +} {- {} 0 variable {$ab} 1 text ab 0 (cd)} +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} 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} 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} testparser { + list [catch {testparser {$x(poiu} 0} msg] $msg $::errorInfo } {1 {missing )} {missing ) - (parsing index for array "x000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000") - while compiling -"$x0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ..." - ("eval" body line 1) + (remainder of script: "(poiu") invoked from within -"eval \$x[format "%01000d" 0]("}} -test parse-9.15 {syntax errors, missplaced braces} { - catch { - proc misplaced_end_brace {} { - set what foo - set when [expr ${what}size - [set off$what]}] - } msg - set msg -} {wrong # args: should be "proc name args body"} -test parse-9.16 {syntax errors, missplaced braces} { - catch { - set a { - set what foo - set when [expr ${what}size - [set off$what]}] - } msg - set msg -} {argument word in braces doesn't terminate properly} - -# Long values (stressing storage management) - -set a {1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH} - -test parse-10.1 {long values} { - string length $a -} 214 -test parse-10.2 {long values} { - llength $a -} 43 -test parse-10.3 {long values} { - set b "1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH" - set b -} $a -test parse-10.4 {long values} { - set b "$a" - set b -} $a -test parse-10.5 {long values} { - set b [set a] - set b -} $a -test parse-10.6 {long values} { - set b [concat 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH] - string length $b -} 214 -test parse-10.7 {long values} { - set b [concat 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH] - llength $b -} 43 -test parse-10.8 {long values} { - set b -} $a -test parse-10.9 {long values} { - set a [concat 0000 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH IIII JJJJ KKKK LLLL MMMM NNNN OOOO PPPP QQQQ RRRR SSSS TTTT UUUU VVVV WWWW XXXX YYYY ZZZZ] - llength $a -} 62 -set i 0 -foreach j [concat 0000 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH IIII JJJJ KKKK LLLL MMMM NNNN OOOO PPPP QQQQ RRRR SSSS TTTT UUUU VVVV WWWW XXXX YYYY ZZZZ] { - set test [string index 0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ $i] - set test $test$test$test$test - set i [expr $i+1] - test parse-10.10 {long values} { - set j - } $test -} -test parse-10.11 {test buffer overflow in backslashes in braces} { - expr {"a" == {xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101}} +"testparser {$x(poiu} 0"}} +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} 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} testparsevar { + set abc 24 + testparsevar {$abc.fg} +} {24 .fg} +test parse-13.2 {Tcl_ParseVar procedure, no variable name} testparsevar { + testparsevar {$} +} {{$} {}} +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} testparsevar { + unset -nocomplain 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} testparsevar { + unset -nocomplain abc + list [catch {testparsevar {$abc([bogus x y z])}} msg] $msg +} {1 {invalid command name "bogus"}} +test parse-13.6 {Tcl_ParseVar memory leak} -constraints memory -setup { + proc getbytes {} { + return [lindex [split [memory info] \n] 3 3] + } +} -body { + set a() foo + set end [getbytes] + for {set i 0} {$i < 5} {incr i} { + set vn {} + set res [testparsevar [append vn $ a([string repeat {[]} 19]) bar]] + if {$res ne {foo bar}} {error "Unexpected result: $res"} + + set tmp $end + set end [getbytes] + } + expr {$end - $tmp} +} -cleanup { + unset -nocomplain a end i vn res tmp + rename getbytes {} +} -result 0 + +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} 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} 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} 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} 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} 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} 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} 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} 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} 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} 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} 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} 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} 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} 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} 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 +"testparser {foo "a b c"d} 0"}} + +test parse-15.5 {CommandComplete procedure} { + info complete "" +} 1 +test parse-15.6 {CommandComplete procedure} { + info complete " \n" +} 1 +test parse-15.7 {CommandComplete procedure} { + info complete "abc def" +} 1 +test parse-15.8 {CommandComplete procedure} { + info complete "a b c d e f \t\n" +} 1 +test parse-15.9 {CommandComplete procedure} { + info complete {a b c"d} +} 1 +test parse-15.10 {CommandComplete procedure} { + info complete {a b "c d" e} +} 1 +test parse-15.11 {CommandComplete procedure} { + info complete {a b "c d"} +} 1 +test parse-15.12 {CommandComplete procedure} { + info complete {a b "c d"} +} 1 +test parse-15.13 {CommandComplete procedure} { + info complete {a b "c d} +} 0 +test parse-15.14 {CommandComplete procedure} { + info complete {a b "} +} 0 +test parse-15.15 {CommandComplete procedure} { + info complete {a b "cd"xyz} +} 1 +test parse-15.16 {CommandComplete procedure} { + info complete {a b "c $d() d"} +} 1 +test parse-15.17 {CommandComplete procedure} { + info complete {a b "c $dd("} +} 0 +test parse-15.18 {CommandComplete procedure} { + info complete {a b "c \"} +} 0 +test parse-15.19 {CommandComplete procedure} { + info complete {a b "c [d e f]"} +} 1 +test parse-15.20 {CommandComplete procedure} { + info complete {a b "c [d e f] g"} +} 1 +test parse-15.21 {CommandComplete procedure} { + info complete {a b "c [d e f"} +} 0 +test parse-15.22 {CommandComplete procedure} { + info complete {a {b c d} e} +} 1 +test parse-15.23 {CommandComplete procedure} { + info complete {a {b c d}} +} 1 +test parse-15.24 {CommandComplete procedure} { + info complete "a b\{c d" +} 1 +test parse-15.25 {CommandComplete procedure} { + info complete "a b \{c" +} 0 +test parse-15.26 {CommandComplete procedure} { + info complete "a b \{c{ }" +} 0 +test parse-15.27 {CommandComplete procedure} { + info complete "a b {c d e}xxx" +} 1 +test parse-15.28 {CommandComplete procedure} { + info complete "a b {c \\\{d e}xxx" +} 1 +test parse-15.29 {CommandComplete procedure} { + info complete {a b [ab cd ef]} +} 1 +test parse-15.30 {CommandComplete procedure} { + info complete {a b x[ab][cd][ef] gh} +} 1 +test parse-15.31 {CommandComplete procedure} { + info complete {a b x[ab][cd[ef] gh} +} 0 +test parse-15.32 {CommandComplete procedure} { + info complete {a b x[ gh} +} 0 +test parse-15.33 {CommandComplete procedure} { + info complete {[]]]} +} 1 +test parse-15.34 {CommandComplete procedure} { + info complete {abc x$yyy} +} 1 +test parse-15.35 {CommandComplete procedure} { + info complete "abc x\${abc\[\\d} xyz" +} 1 +test parse-15.36 {CommandComplete procedure} { + info complete "abc x\$\{ xyz" +} 0 +test parse-15.37 {CommandComplete procedure} { + info complete {word $a(xyz)} +} 1 +test parse-15.38 {CommandComplete procedure} { + info complete {word $a(} +} 0 +test parse-15.39 {CommandComplete procedure} { + info complete "set a \\\n" +} 0 +test parse-15.40 {CommandComplete procedure} { + info complete "set a \\\\\n" +} 1 +test parse-15.41 {CommandComplete procedure} { + info complete "set a \\n " +} 1 +test parse-15.42 {CommandComplete procedure} { + info complete "set a \\" +} 1 +test parse-15.43 {CommandComplete procedure} { + info complete "foo \\\n\{" +} 0 +test parse-15.44 {CommandComplete procedure} { + info complete "a\nb\n# \{\n# \{\nc\n" +} 1 +test parse-15.45 {CommandComplete procedure} { + info complete "#Incomplete comment\\\n" +} 0 +test parse-15.46 {CommandComplete procedure} { + info complete "#Incomplete comment\\\nBut now it's complete.\n" +} 1 +test parse-15.47 {CommandComplete procedure} { + info complete "# Complete comment\\\\\n" +} 1 +test parse-15.48 {CommandComplete procedure} { + info complete "abc\\\n def" +} 1 +test parse-15.49 {CommandComplete procedure} { + info complete "abc\\\n " +} 1 +test parse-15.50 {CommandComplete procedure} { + info complete "abc\\\n" +} 0 +test parse-15.51 {CommandComplete procedure} " + info complete \"\\\{abc\\\}\\\{\" +" 1 +test parse-15.52 {CommandComplete procedure} { + info complete "\"abc\"(" +} 1 +test parse-15.53 {CommandComplete procedure} " + info complete \" # \{\" +" 1 +test parse-15.54 {CommandComplete procedure} " + info complete \"foo bar;# \{\" +" 1 +test parse-15.55 {CommandComplete procedure} { + info complete "set x [bytestring \0]; puts hi" +} 1 +test parse-15.56 {CommandComplete procedure} { + info complete "set x [bytestring \0]; \{" +} 0 +test parse-15.57 {CommandComplete procedure} { + info complete "# Comment should be complete command" +} 1 +test parse-15.58 {CommandComplete procedure, memory leaks} { + info complete "1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22" +} 1 +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-11.1 {comments} { - set a old - eval { # set a new} - set a -} {old} -test parse-11.2 {comments} { - set a old - eval " # set a new\nset a new" +test parse-16.1 {Bug 218885 (Scriptics bug 2535)} { + subst {[eval {return foo}]bar} +} foobar + +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 -} {new} -test parse-11.3 {comments} { - set a old - eval " # set a new\\\nset a new" +} 1 +test parse-18.29 {Tcl_SubstObj, side effects} { + set a 0 + catch {subst {foo[incr a; incr a; parse error {}{}]bar}} set a -} {old} -test parse-11.4 {comments} { - set a old - eval " # set a new\\\\\nset a new" +} 2 +test parse-18.30 {Tcl_SubstObj, side effects} { + set a 0 + catch {subst {foo[incr a; incr a parse error {}{}]bar}} set a -} {new} - -test parse-12.1 {comments at the end of a bracketed script} { - set x "[ -expr 1+1 -# skip this! -]" -} {2} - -if {[info command testwordend] == "testwordend"} { - test parse-13.1 {TclWordEnd procedure} { - testwordend " \n abc" - } {c} - test parse-13.2 {TclWordEnd procedure} { - testwordend " \\\n" - } {} - test parse-13.3 {TclWordEnd procedure} { - testwordend " \\\n " - } { } - test parse-13.4 {TclWordEnd procedure} { - testwordend {"abc"} - } {"} - test parse-13.5 {TclWordEnd procedure} { - testwordend {{xyz}} - } \} - test parse-13.6 {TclWordEnd procedure} { - testwordend {{a{}b{}\}} xyz} - } "\} xyz" - test parse-13.7 {TclWordEnd procedure} { - testwordend {abc[this is a]def ghi} - } {f ghi} - test parse-13.8 {TclWordEnd procedure} { - testwordend "puts\\\n\n " - } "s\\\n\n " - test parse-13.9 {TclWordEnd procedure} { - testwordend "puts\\\n " - } "s\\\n " - test parse-13.10 {TclWordEnd procedure} { - testwordend "puts\\\n xyz" - } "s\\\n xyz" - test parse-13.11 {TclWordEnd procedure} { - testwordend {a$x.$y(a long index) foo} - } ") foo" - test parse-13.12 {TclWordEnd procedure} { - testwordend {abc; def} - } {; def} - test parse-13.13 {TclWordEnd procedure} { - testwordend {abc def} - } {c def} - test parse-13.14 {TclWordEnd procedure} { - testwordend {abc def} - } {c def} - test parse-13.15 {TclWordEnd procedure} { - testwordend "abc\ndef" - } "c\ndef" - test parse-13.16 {TclWordEnd procedure} { - testwordend "abc" - } {c} - test parse-13.17 {TclWordEnd procedure} { - testwordend "a\000bc" - } {c} - test parse-13.18 {TclWordEnd procedure} { - testwordend \[a\000\] - } {]} - test parse-13.19 {TclWordEnd procedure} { - testwordend \"a\000\" - } {"} - test parse-13.20 {TclWordEnd procedure} { - testwordend a{\000}b - } {b} - test parse-13.21 {TclWordEnd procedure} { - testwordend " \000b" - } {b} +} 1 + +test parse-19.1 {Bug 1115904: recursion limit in Tcl_EvalEx} -constraints { + testevalex +} -setup { + interp create i + load {} Tcltest i + i eval {proc {} args {}} + interp recursionlimit i 3 +} -body { + i eval {testevalex {[]}} +} -cleanup { + interp delete i } -test parse-14.1 {TclScriptEnd procedure} { - info complete {puts [ - expr 1+1 - #this is a comment ]} -} {0} -test parse-14.2 {TclScriptEnd procedure} { - info complete "abc\\\n" -} {0} -test parse-14.3 {TclScriptEnd procedure} { - info complete "abc\\\\\n" -} {1} -test parse-14.4 {TclScriptEnd procedure} { - info complete "xyz \[abc \{abc\]" -} {0} -test parse-14.5 {TclScriptEnd procedure} { - info complete "xyz \[abc" -} {0} +test parse-19.2 {Bug 1115904: recursion limit in Tcl_EvalEx} -constraints { + testevalex +} -setup { + interp create i + load {} Tcltest i + i eval {proc {} args {}} + interp recursionlimit i 2 +} -body { + i eval {testevalex {[[]]}} +} -cleanup { + interp delete i +} -returnCodes error -match glob -result {too many nested*} + +test parse-19.3 {Bug 1115904: recursion limit in Tcl_EvalEx} emptyTest { + # Test no longer valid in Tcl 8.6 +} {} +test parse-19.4 {Bug 1115904: recursion limit in Tcl_EvalEx} emptyTest { + # Test no longer valid in Tcl 8.6 +} {} + +test parse-20.1 {TclParseBackslash: truncated escape} testparser { + testparser {\u12345} 1 +} {- \\ 1 simple \\ 1 text \\ 0 u12345} +test parse-20.2 {TclParseBackslash: truncated escape} testparser { + testparser {\u12345} 2 +} {- {\u} 1 word {\u} 1 backslash {\u} 0 12345} +test parse-20.3 {TclParseBackslash: truncated escape} testparser { + testparser {\u12345} 3 +} {- {\u1} 1 word {\u1} 1 backslash {\u1} 0 2345} +test parse-20.4 {TclParseBackslash: truncated escape} testparser { + testparser {\u12345} 4 +} {- {\u12} 1 word {\u12} 1 backslash {\u12} 0 345} +test parse-20.5 {TclParseBackslash: truncated escape} testparser { + testparser {\u12345} 5 +} {- {\u123} 1 word {\u123} 1 backslash {\u123} 0 45} +test parse-20.6 {TclParseBackslash: truncated escape} testparser { + testparser {\u12345} 6 +} {- {\u1234} 1 word {\u1234} 1 backslash {\u1234} 0 5} +test parse-20.7 {TclParseBackslash: truncated escape} testparser { + testparser {\u12345} 7 +} {- {\u12345} 1 word {\u12345} 2 backslash {\u1234} 0 text 5 0 {}} + +test parse-20.8 {TclParseBackslash: truncated escape} testparser { + testparser {\x12X} 1 +} {- \\ 1 simple \\ 1 text \\ 0 x12X} +test parse-20.9 {TclParseBackslash: truncated escape} testparser { + testparser {\x12X} 2 +} {- {\x} 1 word {\x} 1 backslash {\x} 0 12X} +test parse-20.10 {TclParseBackslash: truncated escape} testparser { + testparser {\x12X} 3 +} {- {\x1} 1 word {\x1} 1 backslash {\x1} 0 2X} +test parse-20.11 {TclParseBackslash: truncated escape} testparser { + testparser {\x12X} 4 +} {- {\x12} 1 word {\x12} 1 backslash {\x12} 0 X} +test parse-20.12 {TclParseBackslash: truncated escape} testparser { + testparser {\x12X} 5 +} {- {\x12X} 1 word {\x12X} 2 backslash {\x12} 0 text X 0 {}} + +test parse-21.0 {Bug 1884496} testevent { + set ::script {testevent delete a; set a [p]; set ::done $a} + proc ::p {} {string first s $::script} + testevent queue a head $::script + vwait done +} {} +test parse-21.1 {TCL_EVAL_DIRECT coverage} testevent { + testevent queue a head {testevent delete a; \ + set ::done [dict get [info frame 0] line]} + vwait done + set ::done +} 2 + +cleanupTests +} + +namespace delete ::tcl::test::parse +return |