diff options
Diffstat (limited to 'tests/parse.test')
| -rw-r--r-- | tests/parse.test | 81 |
1 files changed, 37 insertions, 44 deletions
diff --git a/tests/parse.test b/tests/parse.test index 287c392..cd02386 100644 --- a/tests/parse.test +++ b/tests/parse.test @@ -16,22 +16,17 @@ if {[catch {package require tcltest 2.0.2}]} { namespace eval ::tcl::test::parse { namespace import ::tcltest::* -::tcltest::loadTestedCommands -catch [list package require -exact Tcltest [info patchlevel]] - testConstraint testparser [llength [info commands testparser]] -testConstraint testbytestring [llength [info commands testbytestring]] 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-1.1 {Tcl_ParseCommand procedure, computing string length} {testparser testbytestring} { - testparser [testbytestring "foo\0 bar"] -1 +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 @@ -302,11 +297,9 @@ test parse-6.15 {ParseTokens procedure, backslash-newline} testparser { 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 testbytestring} { - expr {[testparser [testbytestring "foo\0zz"] 0] eq -"- [testbytestring foo\0zz] 1 word [testbytestring foo\0zz] 3 text foo 0 text [testbytestring \0] 0 text zz 0 {}" - } -} 1 +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 @@ -369,7 +362,7 @@ test parse-8.8 {Tcl_EvalObjv procedure, async handlers} -constraints { variable ::aresult variable ::acode proc async1 {result code} { - variable ::aresult + variable ::aresult variable ::acode set aresult $result set acode $code @@ -706,8 +699,8 @@ test parse-13.6 {Tcl_ParseVar memory leak} -constraints memory -setup { rename getbytes {} } -result 0 -test parse-14.1 {Tcl_ParseBraces procedure, computing string length} {testparser testbytestring} { - testparser [testbytestring "foo\0 bar"] -1 +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 @@ -743,8 +736,8 @@ 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 testbytestring} { - testparser [testbytestring "foo\0 bar"] -1 +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 @@ -909,11 +902,11 @@ test parse-15.53 {CommandComplete procedure} " test parse-15.54 {CommandComplete procedure} " info complete \"foo bar;# \{\" " 1 -test parse-15.55 {CommandComplete procedure} testbytestring { - info complete "set x [testbytestring \0]; puts hi" +test parse-15.55 {CommandComplete procedure} { + info complete "set x [bytestring \0]; puts hi" } 1 -test parse-15.56 {CommandComplete procedure} testbytestring { - info complete "set x [testbytestring \0]; \{" +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" @@ -921,16 +914,16 @@ test parse-15.57 {CommandComplete procedure} { 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} testbytestring { +test parse-15.59 {CommandComplete procedure} { # Test for Tcl Bug 684744 - info complete [testbytestring "\x00;if 1 \{"] + info complete [encoding convertfrom identity "\x00;if 1 \{"] } 0 test parse-15.60 {CommandComplete procedure} { # Test for Tcl Bug 1968882 info complete \\\n } 0 -test parse-16.1 {Bug 218885 (Scriptics bug 2535)} { +test parse-16.1 {Tcl_EvalEx, check termOffset is set correctly for non TCL_OK cases, bug 2535} { subst {[eval {return foo}]bar} } foobar @@ -1066,19 +1059,32 @@ test parse-19.2 {Bug 1115904: recursion limit in Tcl_EvalEx} -constraints { interp create i load {} Tcltest i i eval {proc {} args {}} - interp recursionlimit i 2 + interp recursionlimit i 3 } -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-19.3 {Bug 1115904: recursion limit in Tcl_EvalEx} -setup { + interp create i + i eval {proc {} args {}} + interp recursionlimit i 3 +} -body { + i eval {subst {[]}} +} -cleanup { + interp delete i +} + +test parse-19.4 {Bug 1115904: recursion limit in Tcl_EvalEx} -setup { + interp create i + i eval {proc {} args {}} + interp recursionlimit i 3 +} -body { + i eval {subst {[[]]}} +} -cleanup { + interp delete i +} -returnCodes error -match glob -result {too many nested*} test parse-20.1 {TclParseBackslash: truncated escape} testparser { testparser {\u12345} 1 @@ -1118,19 +1124,6 @@ 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 } |