summaryrefslogtreecommitdiffstats
path: root/tests/subst.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/subst.test')
-rw-r--r--tests/subst.test137
1 files changed, 91 insertions, 46 deletions
diff --git a/tests/subst.test b/tests/subst.test
index 933b1c6..498512d 100644
--- a/tests/subst.test
+++ b/tests/subst.test
@@ -15,13 +15,13 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
namespace import -force ::tcltest::*
}
-
-test subst-1.1 {basics} {
- list [catch {subst} msg] $msg
-} {1 {wrong # args: should be "subst ?-nobackslashes? ?-nocommands? ?-novariables? string"}}
-test subst-1.2 {basics} {
- list [catch {subst a b c} msg] $msg
-} {1 {bad switch "a": must be -nobackslashes, -nocommands, or -novariables}}
+
+test subst-1.1 {basics} -returnCodes error -body {
+ subst
+} -result {wrong # args: should be "subst ?-nobackslashes? ?-nocommands? ?-novariables? string"}
+test subst-1.2 {basics} -returnCodes error -body {
+ subst a b c
+} -result {bad option "a": must be -nobackslashes, -nocommands, or -novariables}
test subst-2.1 {simple strings} {
subst {}
@@ -54,12 +54,13 @@ test subst-4.2 {variable substitutions} {
set a 44
subst {x$a.y{$a}.z}
} {x44.y{44}.z}
-test subst-4.3 {variable substitutions} {
+test subst-4.3 {variable substitutions} -setup {
catch {unset a}
+} -body {
set a(13) 82
set i 13
subst {x.$a($i)}
-} {x.82}
+} -result {x.82}
catch {unset a}
set long {This is a very long string, intentionally made so long that it
will overflow the static character size for dstrings, so that
@@ -68,9 +69,9 @@ set long {This is a very long string, intentionally made so long that it
an error, there will be memory that isn't freed (this will be
detected when the tests are run under a checking memory allocator
such as Purify).}
-test subst-4.4 {variable substitutions} {
- list [catch {subst {$long $a}} msg] $msg
-} {1 {can't read "a": no such variable}}
+test subst-4.4 {variable substitutions} -returnCodes error -body {
+ subst {$long $a}
+} -result {can't read "a": no such variable}
test subst-5.1 {command substitutions} {
subst {[concat {}]}
@@ -111,20 +112,20 @@ test subst-5.10 {command substitutions} {
list [catch {exec [info nameofexecutable] << $script} msg] $msg
} {1 {missing close-bracket}}
-test subst-6.1 {clear the result after command substitution} {
+test subst-6.1 {clear the result after command substitution} -body {
catch {unset a}
- list [catch {subst {[concat foo] $a}} msg] $msg
-} {1 {can't read "a": no such variable}}
+ subst {[concat foo] $a}
+} -returnCodes error -result {can't read "a": no such variable}
-test subst-7.1 {switches} {
- list [catch {subst foo bar} msg] $msg
-} {1 {bad switch "foo": must be -nobackslashes, -nocommands, or -novariables}}
-test subst-7.2 {switches} {
- list [catch {subst -no bar} msg] $msg
-} {1 {ambiguous switch "-no": must be -nobackslashes, -nocommands, or -novariables}}
-test subst-7.3 {switches} {
- list [catch {subst -bogus bar} msg] $msg
-} {1 {bad switch "-bogus": must be -nobackslashes, -nocommands, or -novariables}}
+test subst-7.1 {switches} -returnCodes error -body {
+ subst foo bar
+} -result {bad option "foo": must be -nobackslashes, -nocommands, or -novariables}
+test subst-7.2 {switches} -returnCodes error -body {
+ subst -no bar
+} -result {ambiguous option "-no": must be -nobackslashes, -nocommands, or -novariables}
+test subst-7.3 {switches} -returnCodes error -body {
+ subst -bogus bar
+} -result {bad option "-bogus": must be -nobackslashes, -nocommands, or -novariables}
test subst-7.4 {switches} {
set x 123
subst -nobackslashes {abc $x [expr 1+2] \\\x41}
@@ -157,28 +158,30 @@ test subst-8.4 {return in a subst} {
test subst-8.5 {return in a subst} {
subst {foo [return {]}; bogus code] bar}
} {foo ] bar}
-test subst-8.6 {return in a subst} {
- list [catch {subst {foo [return {x}; bogus code bar}} msg] $msg
-} {1 {missing close-bracket}}
+test subst-8.6 {return in a subst} -returnCodes error -body {
+ subst "foo \[return {x}; bogus code bar"
+} -result {missing close-bracket}
test subst-8.7 {return in a subst, parse error} -body {
- subst {foo [return {x} ; set a {}" ; stuff] bar}
+ subst {foo [return {x} ; set a {}"" ; stuff] bar}
} -returnCodes error -result {extra characters after close-brace}
test subst-8.8 {return in a subst, parse error} -body {
- subst {foo [return {x} ; set bar baz ; set a {}" ; stuff] bar}
+ subst {foo [return {x} ; set bar baz ; set a {}"" ; stuff] bar}
} -returnCodes error -result {extra characters after close-brace}
test subst-8.9 {return in a variable subst} {
subst {foo $var([return {x}]) bar}
} {foo x bar}
-test subst-9.1 {error in a subst} {
- list [catch {subst {[error foo; bogus code]bar}} msg] $msg
-} {1 foo}
-test subst-9.2 {error in a subst} {
- list [catch {subst {[if 1 { error foo; bogus code}]bar}} msg] $msg
-} {1 foo}
-test subst-9.3 {error in a variable subst} {
- list [catch {subst {foo $var([error foo]) bar}} msg] $msg
-} {1 foo}
+test subst-9.1 {error in a subst} -body {
+ subst {[error foo; bogus code]bar}
+} -returnCodes error -result foo
+test subst-9.2 {error in a subst} -body {
+ subst {[if 1 { error foo; bogus code}]bar}
+} -returnCodes error -result foo
+test subst-9.3 {error in a variable subst} -setup {
+ catch {unset var}
+} -body {
+ subst {foo $var([error foo]) bar}
+} -returnCodes error -result foo
test subst-10.1 {break in a subst} {
subst {foo [break; bogus code] bar}
@@ -223,14 +226,14 @@ test subst-12.1 {nasty case, Bug 1036649} {
set res [list [catch {subst "\[subst {};"} msg] $msg]
if {$msg ne "missing close-bracket"} break
}
- set res
+ return $res
} {1 {missing close-bracket}}
test subst-12.2 {nasty case, Bug 1036649} {
for {set i 0} {$i < 10} {incr i} {
set res [list [catch {subst "\[subst {}; "} msg] $msg]
if {$msg ne "missing close-bracket"} break
}
- set res
+ return $res
} {1 {missing close-bracket}}
test subst-12.3 {nasty case, Bug 1036649} {
set x 0
@@ -238,25 +241,67 @@ test subst-12.3 {nasty case, Bug 1036649} {
set res [list [catch {subst "\[incr x;"} msg] $msg]
if {$msg ne "missing close-bracket"} break
}
- list $res $x
-} {{1 {missing close-bracket}} 10}
+ lappend res $x
+} {1 {missing close-bracket} 10}
test subst-12.4 {nasty case, Bug 1036649} {
set x 0
for {set i 0} {$i < 10} {incr i} {
set res [list [catch {subst "\[incr x; "} msg] $msg]
if {$msg ne "missing close-bracket"} break
}
- list $res $x
-} {{1 {missing close-bracket}} 10}
+ lappend res $x
+} {1 {missing close-bracket} 10}
test subst-12.5 {nasty case, Bug 1036649} {
set x 0
for {set i 0} {$i < 10} {incr i} {
set res [list [catch {subst "\[incr x"} msg] $msg]
if {$msg ne "missing close-bracket"} break
}
- list $res $x
-} {{1 {missing close-bracket}} 0}
+ lappend res $x
+} {1 {missing close-bracket} 0}
+test subst-12.6 {nasty case with compilation} {
+ set x unset
+ set y unset
+ list [eval [list subst {[set x 1;break;incr x][set y $x]}]] $x $y
+} {{} 1 unset}
+test subst-12.7 {nasty case with compilation} {
+ set x unset
+ set y unset
+ list [eval [list subst {[set x 1;continue;incr x][set y $x]}]] $x $y
+} {1 1 1}
+
+test subst-13.1 {Bug 3081065} -setup {
+ set script [makeFile {
+ proc demo {string} {
+ subst $string
+ }
+ demo name2
+ } subst13.tcl]
+} -body {
+ interp create slave
+ slave eval [list source $script]
+ interp delete slave
+ interp create slave
+ slave eval {
+ set count 400
+ while {[incr count -1]} {
+ lappend bloat [expr {rand()}]
+ }
+ }
+ slave eval [list source $script]
+ interp delete slave
+} -cleanup {
+ removeFile subst13.tcl
+}
+test subst-13.2 {Test for segfault} -body {
+ subst {[}
+} -returnCodes error -result * -match glob
+
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
generated by cgit v0.12 at 2024-11-10 03:19:57 (GMT)