os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/subst.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/subst.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,264 @@
1.4 +# Commands covered: subst
1.5 +#
1.6 +# This file contains a collection of tests for one or more of the Tcl
1.7 +# built-in commands. Sourcing this file into Tcl runs the tests and
1.8 +# generates output for errors. No output means no errors were found.
1.9 +#
1.10 +# Copyright (c) 1994 The Regents of the University of California.
1.11 +# Copyright (c) 1994 Sun Microsystems, Inc.
1.12 +# Copyright (c) 1998-2000 Ajuba Solutions.
1.13 +#
1.14 +# See the file "license.terms" for information on usage and redistribution
1.15 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.16 +#
1.17 +# RCS: @(#) $Id: subst.test,v 1.13.2.7 2004/10/26 21:42:53 dgp Exp $
1.18 +
1.19 +if {[lsearch [namespace children] ::tcltest] == -1} {
1.20 + package require tcltest
1.21 + namespace import -force ::tcltest::*
1.22 +}
1.23 +
1.24 +test subst-1.1 {basics} {
1.25 + list [catch {subst} msg] $msg
1.26 +} {1 {wrong # args: should be "subst ?-nobackslashes? ?-nocommands? ?-novariables? string"}}
1.27 +test subst-1.2 {basics} {
1.28 + list [catch {subst a b c} msg] $msg
1.29 +} {1 {bad switch "a": must be -nobackslashes, -nocommands, or -novariables}}
1.30 +
1.31 +test subst-2.1 {simple strings} {
1.32 + subst {}
1.33 +} {}
1.34 +test subst-2.2 {simple strings} {
1.35 + subst a
1.36 +} a
1.37 +test subst-2.3 {simple strings} {
1.38 + subst abcdefg
1.39 +} abcdefg
1.40 +test subst-2.4 {simple strings} {
1.41 + # Tcl Bug 685106
1.42 + subst [bytestring bar\x00soom]
1.43 +} [bytestring bar\x00soom]
1.44 +
1.45 +test subst-3.1 {backslash substitutions} {
1.46 + subst {\x\$x\[foo bar]\\}
1.47 +} "x\$x\[foo bar]\\"
1.48 +test subst-3.2 {backslash substitutions with utf chars} {
1.49 + # 'j' is just a char that doesn't mean anything, and \344 is 'ä'
1.50 + # that also doesn't mean anything, but is multi-byte in UTF-8.
1.51 + list [subst \j] [subst \\j] [subst \\344] [subst \\\344]
1.52 +} "j j \344 \344"
1.53 +
1.54 +test subst-4.1 {variable substitutions} {
1.55 + set a 44
1.56 + subst {$a}
1.57 +} {44}
1.58 +test subst-4.2 {variable substitutions} {
1.59 + set a 44
1.60 + subst {x$a.y{$a}.z}
1.61 +} {x44.y{44}.z}
1.62 +test subst-4.3 {variable substitutions} {
1.63 + catch {unset a}
1.64 + set a(13) 82
1.65 + set i 13
1.66 + subst {x.$a($i)}
1.67 +} {x.82}
1.68 +catch {unset a}
1.69 +set long {This is a very long string, intentionally made so long that it
1.70 + will overflow the static character size for dstrings, so that
1.71 + additional memory will have to be allocated by subst. That way,
1.72 + if the subst procedure forgets to free up memory while returning
1.73 + an error, there will be memory that isn't freed (this will be
1.74 + detected when the tests are run under a checking memory allocator
1.75 + such as Purify).}
1.76 +test subst-4.4 {variable substitutions} {
1.77 + list [catch {subst {$long $a}} msg] $msg
1.78 +} {1 {can't read "a": no such variable}}
1.79 +
1.80 +test subst-5.1 {command substitutions} {
1.81 + subst {[concat {}]}
1.82 +} {}
1.83 +test subst-5.2 {command substitutions} {
1.84 + subst {[concat A test string]}
1.85 +} {A test string}
1.86 +test subst-5.3 {command substitutions} {
1.87 + subst {x.[concat foo].y.[concat bar].z}
1.88 +} {x.foo.y.bar.z}
1.89 +test subst-5.4 {command substitutions} {
1.90 + list [catch {subst {$long [set long] [bogus_command]}} msg] $msg
1.91 +} {1 {invalid command name "bogus_command"}}
1.92 +test subst-5.5 {command substitutions} {
1.93 + set a 0
1.94 + list [catch {subst {[set a 1}} msg] $a $msg
1.95 +} {1 0 {missing close-bracket}}
1.96 +test subst-5.6 {command substitutions} {
1.97 + set a 0
1.98 + list [catch {subst {0[set a 1}} msg] $a $msg
1.99 +} {1 0 {missing close-bracket}}
1.100 +test subst-5.7 {command substitutions} {
1.101 + set a 0
1.102 + list [catch {subst {0[set a 1; set a 2}} msg] $a $msg
1.103 +} {1 1 {missing close-bracket}}
1.104 +
1.105 +# repeat the tests above simulating cmd line input
1.106 +test subst-5.8 {command substitutions} {
1.107 + set script {[subst {[set a 1}]}
1.108 + list [catch {exec [info nameofexecutable] << $script} msg] $msg
1.109 +} {1 {missing close-bracket}}
1.110 +test subst-5.9 {command substitutions} {
1.111 + set script {[subst {0[set a 1}]}
1.112 + list [catch {exec [info nameofexecutable] << $script} msg] $msg
1.113 +} {1 {missing close-bracket}}
1.114 +test subst-5.10 {command substitutions} {
1.115 + set script {[subst {0[set a 1; set a 2}]}
1.116 + list [catch {exec [info nameofexecutable] << $script} msg] $msg
1.117 +} {1 {missing close-bracket}}
1.118 +
1.119 +test subst-6.1 {clear the result after command substitution} {
1.120 + catch {unset a}
1.121 + list [catch {subst {[concat foo] $a}} msg] $msg
1.122 +} {1 {can't read "a": no such variable}}
1.123 +
1.124 +test subst-7.1 {switches} {
1.125 + list [catch {subst foo bar} msg] $msg
1.126 +} {1 {bad switch "foo": must be -nobackslashes, -nocommands, or -novariables}}
1.127 +test subst-7.2 {switches} {
1.128 + list [catch {subst -no bar} msg] $msg
1.129 +} {1 {ambiguous switch "-no": must be -nobackslashes, -nocommands, or -novariables}}
1.130 +test subst-7.3 {switches} {
1.131 + list [catch {subst -bogus bar} msg] $msg
1.132 +} {1 {bad switch "-bogus": must be -nobackslashes, -nocommands, or -novariables}}
1.133 +test subst-7.4 {switches} {
1.134 + set x 123
1.135 + subst -nobackslashes {abc $x [expr 1+2] \\\x41}
1.136 +} {abc 123 3 \\\x41}
1.137 +test subst-7.5 {switches} {
1.138 + set x 123
1.139 + subst -nocommands {abc $x [expr 1+2] \\\x41}
1.140 +} {abc 123 [expr 1+2] \A}
1.141 +test subst-7.6 {switches} {
1.142 + set x 123
1.143 + subst -novariables {abc $x [expr 1+2] \\\x41}
1.144 +} {abc $x 3 \A}
1.145 +test subst-7.7 {switches} {
1.146 + set x 123
1.147 + subst -nov -nob -noc {abc $x [expr 1+2] \\\x41}
1.148 +} {abc $x [expr 1+2] \\\x41}
1.149 +
1.150 +test subst-8.1 {return in a subst} {
1.151 + subst {foo [return {x}; bogus code] bar}
1.152 +} {foo x bar}
1.153 +test subst-8.2 {return in a subst} {
1.154 + subst {foo [return x ; bogus code] bar}
1.155 +} {foo x bar}
1.156 +test subst-8.3 {return in a subst} {
1.157 + subst {foo [if 1 { return {x}; bogus code }] bar}
1.158 +} {foo x bar}
1.159 +test subst-8.4 {return in a subst} {
1.160 + subst {[eval {return hi}] there}
1.161 +} {hi there}
1.162 +test subst-8.5 {return in a subst} {
1.163 + subst {foo [return {]}; bogus code] bar}
1.164 +} {foo ] bar}
1.165 +test subst-8.6 {return in a subst} {
1.166 + list [catch {subst {foo [return {x}; bogus code bar}} msg] $msg
1.167 +} {1 {missing close-bracket}}
1.168 +test subst-8.7 {return in a subst, parse error} {
1.169 + subst {foo [return {x} ; set a {}" ; stuff] bar}
1.170 +} {foo xset a {}" ; stuff] bar}
1.171 +test subst-8.8 {return in a subst, parse error} {
1.172 + subst {foo [return {x} ; set bar baz ; set a {}" ; stuff] bar}
1.173 +} {foo xset bar baz ; set a {}" ; stuff] bar}
1.174 +test subst-8.9 {return in a variable subst} {
1.175 + subst {foo $var([return {x}]) bar}
1.176 +} {foo x bar}
1.177 +
1.178 +test subst-9.1 {error in a subst} {
1.179 + list [catch {subst {[error foo; bogus code]bar}} msg] $msg
1.180 +} {1 foo}
1.181 +test subst-9.2 {error in a subst} {
1.182 + list [catch {subst {[if 1 { error foo; bogus code}]bar}} msg] $msg
1.183 +} {1 foo}
1.184 +test subst-9.3 {error in a variable subst} {
1.185 + list [catch {subst {foo $var([error foo]) bar}} msg] $msg
1.186 +} {1 foo}
1.187 +
1.188 +test subst-10.1 {break in a subst} {
1.189 + subst {foo [break; bogus code] bar}
1.190 +} {foo }
1.191 +test subst-10.2 {break in a subst} {
1.192 + subst {foo [break; return x; bogus code] bar}
1.193 +} {foo }
1.194 +test subst-10.3 {break in a subst} {
1.195 + subst {foo [if 1 { break; bogus code}] bar}
1.196 +} {foo }
1.197 +test subst-10.4 {break in a subst, parse error} {
1.198 + subst {foo [break ; set a {}{} ; stuff] bar}
1.199 +} {foo }
1.200 +test subst-10.5 {break in a subst, parse error} {
1.201 + subst {foo [break ;set bar baz ;set a {}{} ; stuff] bar}
1.202 +} {foo }
1.203 +test subst-10.6 {break in a variable subst} {
1.204 + subst {foo $var([break]) bar}
1.205 +} {foo }
1.206 +
1.207 +test subst-11.1 {continue in a subst} {
1.208 + subst {foo [continue; bogus code] bar}
1.209 +} {foo bar}
1.210 +test subst-11.2 {continue in a subst} {
1.211 + subst {foo [continue; return x; bogus code] bar}
1.212 +} {foo bar}
1.213 +test subst-11.3 {continue in a subst} {
1.214 + subst {foo [if 1 { continue; bogus code}] bar}
1.215 +} {foo bar}
1.216 +test subst-11.4 {continue in a subst, parse error} {
1.217 + subst {foo [continue ; set a {}{} ; stuff] bar}
1.218 +} {foo set a {}{} ; stuff] bar}
1.219 +test subst-11.5 {continue in a subst, parse error} {
1.220 + subst {foo [continue ;set bar baz ;set a {}{} ; stuff] bar}
1.221 +} {foo set bar baz ;set a {}{} ; stuff] bar}
1.222 +test subst-11.6 {continue in a variable subst} {
1.223 + subst {foo $var([continue]) bar}
1.224 +} {foo bar}
1.225 +
1.226 +test subst-12.1 {nasty case, Bug 1036649} {
1.227 + for {set i 0} {$i < 10} {incr i} {
1.228 + set res [list [catch {subst "\[subst {};"} msg] $msg]
1.229 + if {$msg ne "missing close-bracket"} break
1.230 + }
1.231 + set res
1.232 +} {1 {missing close-bracket}}
1.233 +test subst-12.2 {nasty case, Bug 1036649} {
1.234 + for {set i 0} {$i < 10} {incr i} {
1.235 + set res [list [catch {subst "\[subst {}; "} msg] $msg]
1.236 + if {$msg ne "missing close-bracket"} break
1.237 + }
1.238 + set res
1.239 +} {1 {missing close-bracket}}
1.240 +test subst-12.3 {nasty case, Bug 1036649} {
1.241 + set x 0
1.242 + for {set i 0} {$i < 10} {incr i} {
1.243 + set res [list [catch {subst "\[incr x;"} msg] $msg]
1.244 + if {$msg ne "missing close-bracket"} break
1.245 + }
1.246 + list $res $x
1.247 +} {{1 {missing close-bracket}} 10}
1.248 +test subst-12.4 {nasty case, Bug 1036649} {
1.249 + set x 0
1.250 + for {set i 0} {$i < 10} {incr i} {
1.251 + set res [list [catch {subst "\[incr x; "} msg] $msg]
1.252 + if {$msg ne "missing close-bracket"} break
1.253 + }
1.254 + list $res $x
1.255 +} {{1 {missing close-bracket}} 10}
1.256 +test subst-12.5 {nasty case, Bug 1036649} {
1.257 + set x 0
1.258 + for {set i 0} {$i < 10} {incr i} {
1.259 + set res [list [catch {subst "\[incr x"} msg] $msg]
1.260 + if {$msg ne "missing close-bracket"} break
1.261 + }
1.262 + list $res $x
1.263 +} {{1 {missing close-bracket}} 0}
1.264 +
1.265 +# cleanup
1.266 +::tcltest::cleanupTests
1.267 +return