diff options
Diffstat (limited to 'tests/parse.test')
| -rw-r--r-- | tests/parse.test | 1257 |
1 files changed, 722 insertions, 535 deletions
diff --git a/tests/parse.test b/tests/parse.test index 7019b7a..1f36063 100644 --- a/tests/parse.test +++ b/tests/parse.test @@ -1,556 +1,743 @@ -# 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} +# RCS: @(#) $Id: parse.test,v 1.3 1999/04/16 00:47:31 stanton Exp $ -proc fourArgs {a b c d} { - global arg1 arg2 arg3 arg4 - set arg1 $a - set arg2 $b - set arg3 $c - set arg4 $d +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } -proc getArgs args { - global argv - set argv $args +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 } -# 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]} - -# Command substitution. - -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 - -]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 - -# Variable substitution. - -test parse-5.1 {variable substitution} { - 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} { +test parse-1.1 {Tcl_ParseCommand procedure, computing string length} { + 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 "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 " \n\t foo" 0 +} {- foo 1 simple foo 1 text foo 0 {}} +test parse-1.4 {Tcl_ParseCommand procedure, leading space} { + 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 " \\\n foo" 0 +} {- foo 1 simple foo 1 text foo 0 {}} +test parse-1.6 {Tcl_ParseCommand procedure, backslash-newline in leading space} { + 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 " \\\n" 0 +} {- {} 0 {}} +test parse-1.8 {Tcl_ParseCommand procedure, eof in leading space} { + testparser " foo" 3 +} {- {} 0 { foo}} + +test parse-2.1 {Tcl_ParseCommand procedure, comments} { + 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 " # 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 " # 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 "# \\\n" 0 +} {#\ \ \ \\\n {} 0 {}} +test parse-2.5 {Tcl_ParseCommand procedure, eof in comment} { + testparser " # foo bar\nfoo" 8 +} {{# foo b} {} 0 {ar +foo}} + +test parse-3.1 {Tcl_ParseCommand procedure, parsing words, skipping space} { + 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 "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 "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 "foo " 5 +} {- {foo } 1 simple foo 1 text foo 0 { }} +test parse-3.5 {Tcl_ParseCommand procedure, quoted words} { + 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 {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 +} {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 {foo} 0 +} {- foo 1 simple foo 1 text foo 0 {}} +test parse-4.2 {Tcl_ParseCommand procedure, simple words} { + testparser {{abc}} 0 +} {- {{abc}} 1 simple {{abc}} 1 text abc 0 {}} +test parse-4.3 {Tcl_ParseCommand procedure, simple words} { + 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 {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 {"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 {$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 "{abc}\\\n" 0 +} {- \{abc\}\\\n 1 simple {{abc}} 1 text abc 0 {}} +test parse-5.2 {Tcl_ParseCommand procedure, backslash-newline terminates word} { + 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 "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 "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 "\"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 +} {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 "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 +} {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 "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} { + # 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-6.1 {ParseTokens procedure, empty word} { + testparser {""} 0 +} {- {""} 1 simple {""} 1 text {} 0 {}} +test parse-6.2 {ParseTokens procedure, simple range} { + 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 {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} { + list [catch {testparser {$x([a )} 0} msg] $msg +} {1 {missing close-bracket}} +test parse-6.5 {ParseTokens procedure, command substitution} { + 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 {[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 +} {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 {[$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 +} {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 +} {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 "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 "\"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 {\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 [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-7.1 {Tcl_FreeParse and ExpandTokenArray procedures} { + 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-8.1 {Tcl_EvalObjv procedure} { + testevalobjv 0 concat this is a test +} {this is a test} +test parse-8.2 {Tcl_EvalObjv procedure, unknown commands} { + 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} { + 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} { + 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 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} { + proc x {} { + set y 23 + set z [testevalobjv 1 set y] + return [list $z $y] + } + catch {unset y} + set y 16 + x +} {16 23} +test parse-8.8 {Tcl_EvalObjv procedure, async handlers} { + proc async1 {result code} { + global aresult acode + set aresult $result + set acode $code + return "new result" + } + 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] + testasync delete + set x +} {0 {new result} 0 original} +test parse-8.9 {Tcl_EvalObjv procedure, exceptional return} { + list [catch {testevalobjv 0 error message} msg] $msg +} {1 message} + +test parse-9.1 {Tcl_LogCommandInfo, line numbers} { + catch {unset 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 [testevalex {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 {concat test} +} {test} +test parse-10.2 {Tcl_EvalTokens, backslash sequences} { + testevalex {concat test\063\062test} +} {test32test} +test parse-10.3 {Tcl_EvalTokens, nested commands} { + testevalex {concat [expr 2 + 6]} +} {8} +test parse-10.4 {Tcl_EvalTokens, nested commands} { catch {unset a} - set a(xyz) 123 - set b $a(xyz)foo - set b -} 123foo -test parse-5.8 {array variable substitution} { + 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} { + set a hello + testevalex {concat $a} +} {hello} +test parse-10.6 {Tcl_EvalTokens, array variables} { 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} { + set a(12) 46 + testevalex {concat $a(12)} +} {46} +test parse-10.7 {Tcl_EvalTokens, array variables} { 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} { + set a(12) 46 + testevalex {concat $a(1[expr 3 - 1])} +} {46} +test parse-10.8 {Tcl_EvalTokens, array variables} { 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] -} + list [catch {testevalex {concat $x($a)}} msg] $msg +} {1 {can't read "a": no such variable}} +test parse-10.9 {Tcl_EvalTokens, array variables} { + 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} { + set a 123 + testevalex {concat $a} +} {123} +test parse-10.11 {Tcl_EvalTokens, object values} { + set a 123 + testevalex {concat $a$a$a} +} {123123123} +test parse-10.12 {Tcl_EvalTokens, object values} { + testevalex {concat [expr 2][expr 4][expr 6]} +} {246} +test parse-10.13 {Tcl_EvalTokens, string values} { + testevalex {concat {a" b"}} +} {a" b"} +test parse-10.14 {Tcl_EvalTokens, string values} { + 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_Eval2, TCL_EVAL_GLOBAL flag} { + proc x {} { + set y 777 + set z [testevalex "set y" global] + return [list $z $y] + } + catch {unset y} + set y 321 + x +} {321 777} +test parse-11.2 {Tcl_Eval2, error while parsing} { + list [catch {testevalex {concat "abc}} msg] $msg +} {1 {missing "}} +test parse-11.3 {Tcl_Eval2, error while collecting words} { + catch {unset a} + list [catch {testevalex {concat xyz $a}} msg] $msg +} {1 {can't read "a": no such variable}} +test parse-11.4 {Tcl_Eval2, error in Tcl_EvalObjv call} { + catch {unset a} + list [catch {testevalex {_bogus_ a b c d}} msg] $msg +} {1 {invalid command name "_bogus_"}} +test parse-11.5 {Tcl_Eval2, exceptional return} { + list [catch {testevalex {break}} msg] $msg +} {3 {}} +test parse-11.6 {Tcl_Eval2, freeing memory} { + 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_Eval2, multiple commands in script} { + list [testevalex {set a b; set c d}] $a $c +} {d b d} +test parse-11.8 {Tcl_Eval2, multiple commands in script} { + list [testevalex { + set a b + set c d + }] $a $c +} {d b d} +test parse-11.9 {Tcl_Eval2, freeing memory after error} { + 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} { + testevalex {concat xyz; } +} {xyz} +test parse-11.11 {Tcl_EvalTokens, empty commands} { + testevalex "concat abc; ; # this is a comment\n" +} {abc} +test parse-11.12 {Tcl_EvalTokens, empty commands} { + testevalex {} +} {} + +test parse-12.1 {Tcl_ParseVarName procedure, initialization} { + list [catch {testparsevarname {$a([first second])} 8 0} msg] $msg +} {1 {missing close-bracket}} +test parse-12.2 {Tcl_ParseVarName procedure, initialization} { + 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} { + 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 {$abcd} 0 0 +} {- {} 0 variable {$abcd} 1 text abcd 0 {}} +test parse-12.5 {Tcl_ParseVarName procedure, just a dollar sign} { + testparsevarname {$abcd} 1 0 +} {- {} 0 text {$} 0 abcd} +test parse-12.6 {Tcl_ParseVarName procedure, braced variable name} { + 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 "\$\{\{\} " 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 +} {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} { + 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} { + 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 {$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 {$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 {$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 {$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 {$ab:cd} 0 0 +} {- {} 0 variable {$ab} 1 text ab 0 :cd} +test parse-12.16 {Tcl_ParseVarName procedure, eof in ::} { + testparsevarname {$ab::cd} 4 0 +} {- {} 0 variable {$ab} 1 text ab 0 ::cd} +test parse-12.17 {Tcl_ParseVarName procedure, eof in ::} { + testparsevarname {$ab:::cd} 5 0 +} {- {} 0 variable {$ab::} 1 text ab:: 0 :cd} +test parse-12.18 {Tcl_ParseVarName procedure, no variable name} { + 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 {$ab(cd)} 3 0 +} {- {} 0 variable {$ab} 1 text ab 0 (cd)} +test parse-12.20 {Tcl_ParseVarName procedure, array reference} { + 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 {$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 {$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 } {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}} -} 0 +"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 +} {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 {$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-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" - set a -} {new} -test parse-11.3 {comments} { - set a old - eval " # set a new\\\nset a new" - set a -} {old} -test parse-11.4 {comments} { - set a old - eval " # set a new\\\\\nset a new" - 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} -} +test parse-13.1 {Tcl_ParseVar procedure} { + set abc 24 + testparsevar {$abc.fg} +} {24 .fg} +test parse-13.2 {Tcl_ParseVar procedure, no variable name} { + testparsevar {$} +} {{$} {}} +test parse-13.3 {Tcl_ParseVar procedure, no variable name} { + testparsevar {$.123} +} {{$} .123} +test parse-13.4 {Tcl_ParseVar procedure, error looking up variable} { + 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} { + catch {unset abc} + list [catch {testparsevar {$abc([bogus x y z])}} msg] $msg +} {1 {invalid command name "bogus"}} -test parse-14.1 {TclScriptEnd procedure} { - info complete {puts [ - expr 1+1 - #this is a comment ]} -} {0} -test parse-14.2 {TclScriptEnd procedure} { +test parse-14.1 {Tcl_ParseBraces procedure, computing string length} { + 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 "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 {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 {foo {{}}} 0 +} {- {foo {{}}} 2 simple foo 1 text foo 0 simple {{{}}} 1 text {{}} 0 {}} +test parse-14.5 {Tcl_ParseBraces procedure, nested braces} { + 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 "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 +} {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 "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 "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 "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 {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 +} {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 [bytestring "foo\0 bar"] -1 +} {- foo 1 simple foo 1 text foo 0 {}} +test parse-15.2 {Tcl_ParseQuotedString procedure, computing string length} { + 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 {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 +} {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-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} +} 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 + +# cleanup +catch {unset a} +::tcltest::cleanupTests +return + + + + + + + + + + + + + |