Symaptic: os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/subst.test@260cb5ec6c19

     1 # Commands covered:  subst

2 #

     3 # This file contains a collection of tests for one or more of the Tcl

     4 # built-in commands.  Sourcing this file into Tcl runs the tests and

     5 # generates output for errors.  No output means no errors were found.

6 #

     7 # Copyright (c) 1994 The Regents of the University of California.

     8 # Copyright (c) 1994 Sun Microsystems, Inc.

     9 # Copyright (c) 1998-2000 Ajuba Solutions.

    10 #

    11 # See the file "license.terms" for information on usage and redistribution

    12 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.

    13 #

    14 # RCS: @(#) $Id: subst.test,v 1.13.2.7 2004/10/26 21:42:53 dgp Exp $

    16 if {[lsearch [namespace children] ::tcltest] == -1} {

    17     package require tcltest

    18     namespace import -force ::tcltest::*

    19 }

    21 test subst-1.1 {basics} {

    22     list [catch {subst} msg] $msg

    23 } {1 {wrong # args: should be "subst ?-nobackslashes? ?-nocommands? ?-novariables? string"}}

    24 test subst-1.2 {basics} {

    25     list [catch {subst a b c} msg] $msg

    26 } {1 {bad switch "a": must be -nobackslashes, -nocommands, or -novariables}}

    28 test subst-2.1 {simple strings} {

    29     subst {}

    30 } {}

    31 test subst-2.2 {simple strings} {

    32     subst a

    33 } a

    34 test subst-2.3 {simple strings} {

    35     subst abcdefg

    36 } abcdefg

    37 test subst-2.4 {simple strings} {

    38     # Tcl Bug 685106

    39     subst [bytestring bar\x00soom]

    40 } [bytestring bar\x00soom]

    42 test subst-3.1 {backslash substitutions} {

    43     subst {\x\$x\[foo bar]\\}

    44 } "x\$x\[foo bar]\\"

    45 test subst-3.2 {backslash substitutions with utf chars} {

    46     # 'j' is just a char that doesn't mean anything, and \344 is 'ä'

    47     # that also doesn't mean anything, but is multi-byte in UTF-8.

    48     list [subst \j] [subst \\j] [subst \\344] [subst \\\344]

    49 } "j j \344 \344"

    51 test subst-4.1 {variable substitutions} {

    52     set a 44

    53     subst {$a}

    54 } {44}

    55 test subst-4.2 {variable substitutions} {

    56     set a 44

    57     subst {x$a.y{$a}.z}

    58 } {x44.y{44}.z}

    59 test subst-4.3 {variable substitutions} {

    60     catch {unset a}

    61     set a(13) 82

    62     set i 13

    63     subst {x.$a($i)}

    64 } {x.82}

    65 catch {unset a}

    66 set long {This is a very long string, intentionally made so long that it

    67 	will overflow the static character size for dstrings, so that

    68 	additional memory will have to be allocated by subst.  That way,

    69 	if the subst procedure forgets to free up memory while returning

    70 	an error, there will be memory that isn't freed (this will be

    71 	detected when the tests are run under a checking memory allocator

    72 	such as Purify).}

    73 test subst-4.4 {variable substitutions} {

    74     list [catch {subst {$long $a}} msg] $msg

    75 } {1 {can't read "a": no such variable}}

    77 test subst-5.1 {command substitutions} {

    78     subst {[concat {}]}

    79 } {}

    80 test subst-5.2 {command substitutions} {

    81     subst {[concat A test string]}

    82 } {A test string}

    83 test subst-5.3 {command substitutions} {

    84     subst {x.[concat foo].y.[concat bar].z}

    85 } {x.foo.y.bar.z}

    86 test subst-5.4 {command substitutions} {

    87     list [catch {subst {$long [set long] [bogus_command]}} msg] $msg

    88 } {1 {invalid command name "bogus_command"}}

    89 test subst-5.5 {command substitutions} {

    90     set a 0

    91     list [catch {subst {[set a 1}} msg] $a $msg

    92 } {1 0 {missing close-bracket}}

    93 test subst-5.6 {command substitutions} {

    94     set a 0

    95     list [catch {subst {0[set a 1}} msg] $a $msg

    96 } {1 0 {missing close-bracket}}

    97 test subst-5.7 {command substitutions} {

    98     set a 0

    99     list [catch {subst {0[set a 1; set a 2}} msg] $a $msg

   100 } {1 1 {missing close-bracket}}

   102 # repeat the tests above simulating cmd line input

   103 test subst-5.8 {command substitutions} {

   104     set script {[subst {[set a 1}]}

   105     list [catch {exec [info nameofexecutable] << $script} msg] $msg

   106 } {1 {missing close-bracket}}

   107 test subst-5.9 {command substitutions} {

   108     set script {[subst {0[set a 1}]}

   109     list [catch {exec [info nameofexecutable] << $script} msg] $msg

   110 } {1 {missing close-bracket}}

   111 test subst-5.10 {command substitutions} {

   112     set script {[subst {0[set a 1; set a 2}]}

   113     list [catch {exec [info nameofexecutable] << $script} msg] $msg

   114 } {1 {missing close-bracket}}

   116 test subst-6.1 {clear the result after command substitution} {

   117     catch {unset a}

   118     list [catch {subst {[concat foo] $a}} msg] $msg

   119 } {1 {can't read "a": no such variable}}

   121 test subst-7.1 {switches} {

   122     list [catch {subst foo bar} msg] $msg

   123 } {1 {bad switch "foo": must be -nobackslashes, -nocommands, or -novariables}}

   124 test subst-7.2 {switches} {

   125     list [catch {subst -no bar} msg] $msg

   126 } {1 {ambiguous switch "-no": must be -nobackslashes, -nocommands, or -novariables}}

   127 test subst-7.3 {switches} {

   128     list [catch {subst -bogus bar} msg] $msg

   129 } {1 {bad switch "-bogus": must be -nobackslashes, -nocommands, or -novariables}}

   130 test subst-7.4 {switches} {

   131     set x 123

   132     subst -nobackslashes {abc $x [expr 1+2] \\\x41}

   133 } {abc 123 3 \\\x41}

   134 test subst-7.5 {switches} {

   135     set x 123

   136     subst -nocommands {abc $x [expr 1+2] \\\x41}

   137 } {abc 123 [expr 1+2] \A}

   138 test subst-7.6 {switches} {

   139     set x 123

   140     subst -novariables {abc $x [expr 1+2] \\\x41}

   141 } {abc $x 3 \A}

   142 test subst-7.7 {switches} {

   143     set x 123

   144     subst -nov -nob -noc {abc $x [expr 1+2] \\\x41}

   145 } {abc $x [expr 1+2] \\\x41}

   147 test subst-8.1 {return in a subst} {

   148     subst {foo [return {x}; bogus code] bar}

   149 } {foo x bar}

   150 test subst-8.2 {return in a subst} {

   151     subst {foo [return x ; bogus code] bar}

   152 } {foo x bar}

   153 test subst-8.3 {return in a subst} {

   154     subst {foo [if 1 { return {x}; bogus code }] bar}

   155 } {foo x bar}

   156 test subst-8.4 {return in a subst} {

   157     subst {[eval {return hi}] there}

   158 } {hi there}

   159 test subst-8.5 {return in a subst} {

   160     subst {foo [return {]}; bogus code] bar}

   161 } {foo ] bar}

   162 test subst-8.6 {return in a subst} {

   163     list [catch {subst {foo [return {x}; bogus code bar}} msg] $msg

   164 } {1 {missing close-bracket}}

   165 test subst-8.7 {return in a subst, parse error} {

   166     subst {foo [return {x} ; set a {}" ; stuff] bar}

   167 } {foo xset a {}" ; stuff] bar}

   168 test subst-8.8 {return in a subst, parse error} {

   169     subst {foo [return {x} ; set bar baz ; set a {}" ; stuff] bar}

   170 } {foo xset bar baz ; set a {}" ; stuff] bar}

   171 test subst-8.9 {return in a variable subst} {

   172     subst {foo $var([return {x}]) bar}

   173 } {foo x bar}

   175 test subst-9.1 {error in a subst} {

   176     list [catch {subst {[error foo; bogus code]bar}} msg] $msg

   177 } {1 foo}

   178 test subst-9.2 {error in a subst} {

   179     list [catch {subst {[if 1 { error foo; bogus code}]bar}} msg] $msg

   180 } {1 foo}

   181 test subst-9.3 {error in a variable subst} {

   182     list [catch {subst {foo $var([error foo]) bar}} msg] $msg

   183 } {1 foo}

   185 test subst-10.1 {break in a subst} {

   186     subst {foo [break; bogus code] bar}

   187 } {foo }

   188 test subst-10.2 {break in a subst} {

   189     subst {foo [break; return x; bogus code] bar}

   190 } {foo }

   191 test subst-10.3 {break in a subst} {

   192     subst {foo [if 1 { break; bogus code}] bar}

   193 } {foo }

   194 test subst-10.4 {break in a subst, parse error} {

   195     subst {foo [break ; set a {}{} ; stuff] bar}

   196 } {foo }

   197 test subst-10.5 {break in a subst, parse error} {

   198     subst {foo [break ;set bar baz ;set a {}{} ; stuff] bar}

   199 } {foo }

   200 test subst-10.6 {break in a variable subst} {

   201     subst {foo $var([break]) bar}

   202 } {foo }

   204 test subst-11.1 {continue in a subst} {

   205     subst {foo [continue; bogus code] bar}

   206 } {foo  bar}

   207 test subst-11.2 {continue in a subst} {

   208     subst {foo [continue; return x; bogus code] bar}

   209 } {foo  bar}

   210 test subst-11.3 {continue in a subst} {

   211     subst {foo [if 1 { continue; bogus code}] bar}

   212 } {foo  bar}

   213 test subst-11.4 {continue in a subst, parse error} {

   214     subst {foo [continue ; set a {}{} ; stuff] bar}

   215 } {foo set a {}{} ; stuff] bar}

   216 test subst-11.5 {continue in a subst, parse error} {

   217     subst {foo [continue ;set bar baz ;set a {}{} ; stuff] bar}

   218 } {foo set bar baz ;set a {}{} ; stuff] bar}

   219 test subst-11.6 {continue in a variable subst} {

   220     subst {foo $var([continue]) bar}

   221 } {foo  bar}

   223 test subst-12.1 {nasty case, Bug 1036649} {

   224     for {set i 0} {$i < 10} {incr i} {

   225 	set res [list [catch {subst "\[subst {};"} msg] $msg]

   226 	if {$msg ne "missing close-bracket"} break

   227     }

   228     set res

   229 } {1 {missing close-bracket}}

   230 test subst-12.2 {nasty case, Bug 1036649} {

   231     for {set i 0} {$i < 10} {incr i} {

   232 	set res [list [catch {subst "\[subst {}; "} msg] $msg]

   233 	if {$msg ne "missing close-bracket"} break

   234     }

   235     set res

   236 } {1 {missing close-bracket}}

   237 test subst-12.3 {nasty case, Bug 1036649} {

   238     set x 0

   239     for {set i 0} {$i < 10} {incr i} {

   240         set res [list [catch {subst "\[incr x;"} msg] $msg]

   241         if {$msg ne "missing close-bracket"} break

   242     }

   243     list $res $x

   244 } {{1 {missing close-bracket}} 10}

   245 test subst-12.4 {nasty case, Bug 1036649} {

   246     set x 0

   247     for {set i 0} {$i < 10} {incr i} {

   248         set res [list [catch {subst "\[incr x; "} msg] $msg]

   249         if {$msg ne "missing close-bracket"} break

   250     }

   251     list $res $x

   252 } {{1 {missing close-bracket}} 10}

   253 test subst-12.5 {nasty case, Bug 1036649} {

   254     set x 0

   255     for {set i 0} {$i < 10} {incr i} {

   256         set res [list [catch {subst "\[incr x"} msg] $msg]

   257         if {$msg ne "missing close-bracket"} break

   258     }

   259     list $res $x

   260 } {{1 {missing close-bracket}} 0}

   262 # cleanup

   263 ::tcltest::cleanupTests

   264 return

author	sl
	Tue, 10 Jun 2014 14:32:02 +0200
changeset 1	260cb5ec6c19
permissions	-rw-r--r--