diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/basic.test | 6 | ||||
| -rw-r--r-- | tests/main.test | 8 | ||||
| -rw-r--r-- | tests/misc.test | 17 | ||||
| -rw-r--r-- | tests/parse.test | 6 | ||||
| -rw-r--r-- | tests/parseExpr.test | 6 | ||||
| -rw-r--r-- | tests/subst.test | 6 |
6 files changed, 34 insertions, 15 deletions
diff --git a/tests/basic.test b/tests/basic.test index dbc5216..c45a763 100644 --- a/tests/basic.test +++ b/tests/basic.test @@ -15,7 +15,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: basic.test,v 1.24 2003/02/04 17:06:52 vincentdarley Exp $ +# RCS: @(#) $Id: basic.test,v 1.25 2003/02/16 01:36:32 msofer Exp $ # package require tcltest 2 @@ -638,6 +638,10 @@ test basic-46.5 {Tcl_AllowExceptions: exception return not allowed} {exec} { "return -code return" (file "BREAKtest" line 2)}} +test basic-47.1 {Tcl_EvalEx: check for missing close-bracket} -body { + subst {a[set b [format cd]} +} -returnCodes error -result {missing close-bracket} + # cleanup catch {eval namespace delete [namespace children :: test_ns_*]} diff --git a/tests/main.test b/tests/main.test index c005c41..6778b88 100644 --- a/tests/main.test +++ b/tests/main.test @@ -1,6 +1,6 @@ # This file contains a collection of tests for generic/tclMain.c. # -# RCS: @(#) $Id: main.test,v 1.12 2003/01/31 18:54:32 dgp Exp $ +# RCS: @(#) $Id: main.test,v 1.13 2003/02/16 01:36:32 msofer Exp $ if {[catch {package require tcltest 2.0.2}]} { puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required." @@ -277,13 +277,13 @@ namespace eval ::tcl::test::main { } -body { set code [catch {exec [interpreter] script >& result} result] set f [open result] - list $code $result [read $f] + join [list $code $result [read $f]] \n } -cleanup { close $f file delete result removeFile script - } -match glob -result [list 1 {child process exited abnormally}\ - "missing close-brace\n while executing*"] + } -match glob -result [join [list 1 {child process exited abnormally}\ + "missing close-brace\n while executing*"] \n] test Tcl_Main-3.5 { Tcl_Main: startup script sets main loop diff --git a/tests/misc.test b/tests/misc.test index 12ef1bd..d6536b7 100644 --- a/tests/misc.test +++ b/tests/misc.test @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: misc.test,v 1.5 2000/04/10 17:19:02 ericm Exp $ +# RCS: @(#) $Id: misc.test,v 1.6 2003/02/16 01:36:32 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -51,13 +51,20 @@ test misc-1.2 {error in variable ref. in command in array reference} { # this is a bogus comment " set msg {} - list [catch tstProc msg] $msg $errorInfo -} {1 {missing close-brace for variable name} {missing close-brace for variable name + join [list [catch tstProc msg] $msg $errorInfo] \n +} [subst -novariables -nocommands {1 +missing close-brace for variable name +missing close-brace for variable name while compiling -"set tst $a([winfo name " +"set tst $a([winfo name $\{zz) + # this is a bogus comment + # this is a bogus comment + # this is a bogus comment + # this is a bogus comment + # this is a ..." (compiling body of proc "tstProc", line 4) invoked from within -"tstProc"}} +"tstProc"}] # cleanup ::tcltest::cleanupTests diff --git a/tests/parse.test b/tests/parse.test index 8dcf480..95330be 100644 --- a/tests/parse.test +++ b/tests/parse.test @@ -8,7 +8,7 @@ # 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.10 2003/02/11 18:27:37 hobbs Exp $ +# RCS: @(#) $Id: parse.test,v 1.11 2003/02/16 01:36:32 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -209,6 +209,10 @@ test parse-6.16 {ParseTokens procedure, backslash substitution} { 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-6.18 {ParseTokens procedure, seek past numBytes for close-bracket} { + # 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 {$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 diff --git a/tests/parseExpr.test b/tests/parseExpr.test index ad5bd17..7b87b85 100644 --- a/tests/parseExpr.test +++ b/tests/parseExpr.test @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: parseExpr.test,v 1.9 2002/12/11 20:30:16 dgp Exp $ +# RCS: @(#) $Id: parseExpr.test,v 1.10 2003/02/16 01:36:32 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -491,6 +491,10 @@ test parseExpr-15.34 {ParsePrimaryExpr procedure, single equal-specific message} test parseExpr-15.35 {ParsePrimaryExpr procedure, error in parenthesized subexpr} { list [catch {testexprparser {(: 123 : 456)} -1} msg] $msg } {1 {syntax error in expression "(: 123 : 456)": unexpected ternary 'else' separator}} +test parseExpr-15.36 {ParsePrimaryExpr procedure, missing close-bracket} { + # Test for Bug 681841 + list [catch {testexprparser {[set a [format bc]} -1} msg] $msg +} {1 {missing close-bracket}} test parseExpr-16.1 {GetLexeme procedure, whitespace before lexeme} { testexprparser { 123} -1 diff --git a/tests/subst.test b/tests/subst.test index 0ff69f8..0e46f02 100644 --- a/tests/subst.test +++ b/tests/subst.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: subst.test,v 1.12 2002/08/08 15:28:55 msofer Exp $ +# RCS: @(#) $Id: subst.test,v 1.13 2003/02/16 01:36:32 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -156,8 +156,8 @@ test subst-8.5 {return in a subst} { subst {foo [return {]}; bogus code] bar} } {foo ] bar} test subst-8.6 {return in a subst} { - subst {foo [return {x}; bogus code bar} -} {foo x} + list [catch {subst {foo [return {x}; bogus code bar}} msg] $msg +} {1 {missing close-bracket}} test subst-8.7 {return in a subst, parse error} { subst {foo [return {x} ; set a {}" ; stuff] bar} } {foo xset a {}" ; stuff] bar} |