* tests/parse.test (parse-18.*): Coverage tests for the new

        implementation of Tcl_SubstObj().  Note that tests parse-18.17 and
        parse-18.21 demonstrate some bugs left to fix in the current code.

1 files changed, 68 insertions, 1 deletions

diff --git a/tests/parse.test b/tests/parse.test
index 421bfa4..69462b2 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.12 2003/03/27 13:48:59 dkf Exp $
+# RCS: @(#) $Id: parse.test,v 1.13 2003/03/31 23:19:48 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -744,6 +744,73 @@ test parse-17.1 {Correct return codes from errors during substitution} {
     catch {eval {w[continue]}}
 } 4
 
+test parse-18.1 {Tcl_SubstObj, ParseTokens flags} {
+    subst {foo\t$::tcl_library\t[set ::tcl_library]}
+} "foo	$::tcl_library	$::tcl_library"
+test parse-18.2 {Tcl_SubstObj, ParseTokens flags} {
+    subst -nocommands {foo\t$::tcl_library\t[set ::tcl_library]}
+} "foo	$::tcl_library	\[set ::tcl_library]"
+test parse-18.3 {Tcl_SubstObj, ParseTokens flags} {
+    subst -novariables {foo\t$::tcl_library\t[set ::tcl_library]}
+} "foo	\$::tcl_library	$::tcl_library"
+test parse-18.4 {Tcl_SubstObj, ParseTokens flags} {
+    subst -nobackslashes {foo\t$::tcl_library\t[set ::tcl_library]}
+} "foo\\t$::tcl_library\\t$::tcl_library"
+test parse-18.5 {Tcl_SubstObj, ParseTokens flags} {
+    subst -novariables -nobackslashes {foo\t$::tcl_library\t[set ::tcl_library]}
+} "foo\\t\$::tcl_library\\t$::tcl_library"
+test parse-18.6 {Tcl_SubstObj, ParseTokens flags} {
+    subst -nocommands -nobackslashes {foo\t$::tcl_library\t[set ::tcl_library]}
+} "foo\\t$::tcl_library\\t\[set ::tcl_library]"
+test parse-18.7 {Tcl_SubstObj, ParseTokens flags} {
+    subst -nocommands -novariables {foo\t$::tcl_library\t[set ::tcl_library]}
+} "foo	\$::tcl_library	\[set ::tcl_library]"
+test parse-18.8 {Tcl_SubstObj, ParseTokens flags} {
+    subst -nocommands -novariables -nobackslashes \
+	    {foo\t$::tcl_library\t[set ::tcl_library]}
+} "foo\\t\$::tcl_library\\t\[set ::tcl_library]"
+
+test parse-18.9 {Tcl_SubstObj, parse errors} {
+    list [catch "subst foo\$\{foo" msg] $msg
+} [list 1 "missing close-brace for variable name"]
+test parse-18.10 {Tcl_SubstObj, parse errors} {
+    list [catch "subst foo\[set \$\{foo]" msg] $msg
+} [list 1 "missing close-brace for variable name"]
+test parse-18.11 {Tcl_SubstObj, parse errors} {
+    list [catch "subst foo\$array(\$\{foo)" msg] $msg
+} [list 1 "missing close-brace for variable name"]
+test parse-18.12 {Tcl_SubstObj, parse errors} {
+    list [catch "subst foo\$(\$\{foo)" msg] $msg
+} [list 1 "missing close-brace for variable name"]
+test parse-18.13 {Tcl_SubstObj, parse errors} {
+    list [catch "subst \[" msg] $msg
+} [list 1 "missing close-bracket"]
+
+test parse-18.14 {Tcl_SubstObj, exception handling} {
+    subst {abc,[break],def}
+} {abc,}
+test parse-18.15 {Tcl_SubstObj, exception handling} {
+    subst {abc,[continue; expr 1+2],def}
+} {abc,,def}
+test parse-18.16 {Tcl_SubstObj, exception handling} {
+    subst {abc,[return foo; expr 1+2],def}
+} {abc,foo,def}
+test parse-18.17 {Tcl_SubstObj, exception handling} {
+    subst {abc,[return -code 10 foo; expr 1+2],def}
+} {abc,foo,def}
+test parse-18.18 {Tcl_SubstObj, exception handling} {
+    subst {abc,[break; set {} {}{}],def}
+} {abc,}
+test parse-18.19 {Tcl_SubstObj, exception handling} {
+    list [catch {subst {abc,[continue; expr 1+2; set {} {}{}],def}} msg] $msg
+} [list 1 "extra characters after close-brace"]
+test parse-18.20 {Tcl_SubstObj, exception handling} {
+    list [catch {subst {abc,[return foo; expr 1+2; set {} {}{}],def}} msg] $msg
+} [list 1 "extra characters after close-brace"]
+test parse-18.21 {Tcl_SubstObj, exception handling} {
+    subst {abc,[return -code 10 foo; expr 1+2; set {} {}{}],def}
+} [list 1 "extra characters after close-brace"]
+
 # cleanup
 catch {unset a}
 ::tcltest::cleanupTests