From 1d07ec64c90f44e3472bd76da99ce6523e231b2e Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 31 Mar 2003 23:19:48 +0000 Subject: * 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. FossilOrigin-Name: fdede0487d85e0a171d498a39b3ac16814aa698e --- ChangeLog | 6 +++++ tests/parse.test | 69 +++++++++++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 74 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index b1d2239..eaa05f3 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2003-03-31 Don Porter + + * 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. + 2003-03-27 Mo DeJong * unix/configure: Regen. 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 -- cgit v0.12