summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/basic.test6
-rw-r--r--tests/main.test8
-rw-r--r--tests/misc.test17
-rw-r--r--tests/parse.test6
-rw-r--r--tests/parseExpr.test6
-rw-r--r--tests/subst.test6
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}