diff options
Diffstat (limited to 'tests/parse.test')
| -rw-r--r-- | tests/parse.test | 89 |
1 files changed, 57 insertions, 32 deletions
diff --git a/tests/parse.test b/tests/parse.test index 37c44d5..01443c9 100644 --- a/tests/parse.test +++ b/tests/parse.test @@ -16,6 +16,9 @@ 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 testevalobjv [llength [info commands testevalobjv]] testConstraint testevalex [llength [info commands testevalex]] @@ -23,6 +26,8 @@ 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 { testparser [bytestring "foo\0 bar"] -1 @@ -435,7 +440,7 @@ test parse-8.12 {Tcl_EvalObjv procedure, TCL_EVAL_INVOKE} { test parse-9.1 {Tcl_LogCommandInfo, line numbers} testevalex { - catch {unset x} + unset -nocomplain x list [catch {testevalex {for {} 1 {} { @@ -476,7 +481,7 @@ test parse-10.3 {Tcl_EvalTokens, nested commands} testevalex { testevalex {concat [expr 2 + 6]} } {8} test parse-10.4 {Tcl_EvalTokens, nested commands} testevalex { - catch {unset a} + 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 { @@ -484,21 +489,21 @@ test parse-10.5 {Tcl_EvalTokens, simple variables} testevalex { testevalex {concat $a} } {hello} test parse-10.6 {Tcl_EvalTokens, array variables} testevalex { - catch {unset a} + unset -nocomplain a set a(12) 46 testevalex {concat $a(12)} } {46} test parse-10.7 {Tcl_EvalTokens, array variables} testevalex { - catch {unset a} + unset -nocomplain a set a(12) 46 testevalex {concat $a(1[expr 3 - 1])} } {46} test parse-10.8 {Tcl_EvalTokens, array variables} testevalex { - catch {unset a} + 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 { - catch {unset a} + 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 { @@ -538,11 +543,11 @@ 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 { - catch {unset a} + 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 { - catch {unset a} + 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 { @@ -561,7 +566,7 @@ test parse-11.8 {Tcl_EvalEx, multiple commands in script} testevalex { }] $a $c } {d b d} test parse-11.9 {Tcl_EvalEx, freeing memory after error} testevalex { - catch {unset a} + 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 { @@ -667,13 +672,33 @@ 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 { - catch {unset abc} + 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 { - catch {unset abc} + 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 @@ -899,7 +924,7 @@ test parse-15.60 {CommandComplete procedure} { info complete \\\n } 0 -test parse-16.1 {Tcl_EvalEx, check termOffset is set correctly for non TCL_OK cases, bug 2535} { +test parse-16.1 {Bug 218885 (Scriptics bug 2535)} { subst {[eval {return foo}]bar} } foobar @@ -1035,32 +1060,19 @@ 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 3 + 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} -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-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 @@ -1100,6 +1112,19 @@ 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 } |