sl@0: # Commands covered:  subst
sl@0: #
sl@0: # This file contains a collection of tests for one or more of the Tcl
sl@0: # built-in commands.  Sourcing this file into Tcl runs the tests and
sl@0: # generates output for errors.  No output means no errors were found.
sl@0: #
sl@0: # Copyright (c) 1994 The Regents of the University of California.
sl@0: # Copyright (c) 1994 Sun Microsystems, Inc.
sl@0: # Copyright (c) 1998-2000 Ajuba Solutions.
sl@0: #
sl@0: # See the file "license.terms" for information on usage and redistribution
sl@0: # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0: #
sl@0: # RCS: @(#) $Id: subst.test,v 1.13.2.7 2004/10/26 21:42:53 dgp Exp $
sl@0: 
sl@0: if {[lsearch [namespace children] ::tcltest] == -1} {
sl@0:     package require tcltest
sl@0:     namespace import -force ::tcltest::*
sl@0: }
sl@0: 
sl@0: test subst-1.1 {basics} {
sl@0:     list [catch {subst} msg] $msg
sl@0: } {1 {wrong # args: should be "subst ?-nobackslashes? ?-nocommands? ?-novariables? string"}}
sl@0: test subst-1.2 {basics} {
sl@0:     list [catch {subst a b c} msg] $msg
sl@0: } {1 {bad switch "a": must be -nobackslashes, -nocommands, or -novariables}}
sl@0: 
sl@0: test subst-2.1 {simple strings} {
sl@0:     subst {}
sl@0: } {}
sl@0: test subst-2.2 {simple strings} {
sl@0:     subst a
sl@0: } a
sl@0: test subst-2.3 {simple strings} {
sl@0:     subst abcdefg
sl@0: } abcdefg
sl@0: test subst-2.4 {simple strings} {
sl@0:     # Tcl Bug 685106
sl@0:     subst [bytestring bar\x00soom]
sl@0: } [bytestring bar\x00soom]
sl@0: 
sl@0: test subst-3.1 {backslash substitutions} {
sl@0:     subst {\x\$x\[foo bar]\\}
sl@0: } "x\$x\[foo bar]\\"
sl@0: test subst-3.2 {backslash substitutions with utf chars} {
sl@0:     # 'j' is just a char that doesn't mean anything, and \344 is 'ä'
sl@0:     # that also doesn't mean anything, but is multi-byte in UTF-8.
sl@0:     list [subst \j] [subst \\j] [subst \\344] [subst \\\344]
sl@0: } "j j \344 \344"
sl@0: 
sl@0: test subst-4.1 {variable substitutions} {
sl@0:     set a 44
sl@0:     subst {$a}
sl@0: } {44}
sl@0: test subst-4.2 {variable substitutions} {
sl@0:     set a 44
sl@0:     subst {x$a.y{$a}.z}
sl@0: } {x44.y{44}.z}
sl@0: test subst-4.3 {variable substitutions} {
sl@0:     catch {unset a}
sl@0:     set a(13) 82
sl@0:     set i 13
sl@0:     subst {x.$a($i)}
sl@0: } {x.82}
sl@0: catch {unset a}
sl@0: set long {This is a very long string, intentionally made so long that it
sl@0: 	will overflow the static character size for dstrings, so that
sl@0: 	additional memory will have to be allocated by subst.  That way,
sl@0: 	if the subst procedure forgets to free up memory while returning
sl@0: 	an error, there will be memory that isn't freed (this will be
sl@0: 	detected when the tests are run under a checking memory allocator
sl@0: 	such as Purify).}
sl@0: test subst-4.4 {variable substitutions} {
sl@0:     list [catch {subst {$long $a}} msg] $msg
sl@0: } {1 {can't read "a": no such variable}}
sl@0: 
sl@0: test subst-5.1 {command substitutions} {
sl@0:     subst {[concat {}]}
sl@0: } {}
sl@0: test subst-5.2 {command substitutions} {
sl@0:     subst {[concat A test string]}
sl@0: } {A test string}
sl@0: test subst-5.3 {command substitutions} {
sl@0:     subst {x.[concat foo].y.[concat bar].z}
sl@0: } {x.foo.y.bar.z}
sl@0: test subst-5.4 {command substitutions} {
sl@0:     list [catch {subst {$long [set long] [bogus_command]}} msg] $msg
sl@0: } {1 {invalid command name "bogus_command"}}
sl@0: test subst-5.5 {command substitutions} {
sl@0:     set a 0
sl@0:     list [catch {subst {[set a 1}} msg] $a $msg 
sl@0: } {1 0 {missing close-bracket}}
sl@0: test subst-5.6 {command substitutions} {
sl@0:     set a 0
sl@0:     list [catch {subst {0[set a 1}} msg] $a $msg 
sl@0: } {1 0 {missing close-bracket}}
sl@0: test subst-5.7 {command substitutions} {
sl@0:     set a 0
sl@0:     list [catch {subst {0[set a 1; set a 2}} msg] $a $msg 
sl@0: } {1 1 {missing close-bracket}}
sl@0: 
sl@0: # repeat the tests above simulating cmd line input
sl@0: test subst-5.8 {command substitutions} {
sl@0:     set script {[subst {[set a 1}]}
sl@0:     list [catch {exec [info nameofexecutable] << $script} msg] $msg 
sl@0: } {1 {missing close-bracket}}
sl@0: test subst-5.9 {command substitutions} {
sl@0:     set script {[subst {0[set a 1}]}
sl@0:     list [catch {exec [info nameofexecutable] << $script} msg] $msg 
sl@0: } {1 {missing close-bracket}}
sl@0: test subst-5.10 {command substitutions} {
sl@0:     set script {[subst {0[set a 1; set a 2}]}
sl@0:     list [catch {exec [info nameofexecutable] << $script} msg] $msg 
sl@0: } {1 {missing close-bracket}}
sl@0: 
sl@0: test subst-6.1 {clear the result after command substitution} {
sl@0:     catch {unset a}
sl@0:     list [catch {subst {[concat foo] $a}} msg] $msg
sl@0: } {1 {can't read "a": no such variable}}
sl@0: 
sl@0: test subst-7.1 {switches} {
sl@0:     list [catch {subst foo bar} msg] $msg
sl@0: } {1 {bad switch "foo": must be -nobackslashes, -nocommands, or -novariables}}
sl@0: test subst-7.2 {switches} {
sl@0:     list [catch {subst -no bar} msg] $msg
sl@0: } {1 {ambiguous switch "-no": must be -nobackslashes, -nocommands, or -novariables}}
sl@0: test subst-7.3 {switches} {
sl@0:     list [catch {subst -bogus bar} msg] $msg
sl@0: } {1 {bad switch "-bogus": must be -nobackslashes, -nocommands, or -novariables}}
sl@0: test subst-7.4 {switches} {
sl@0:     set x 123
sl@0:     subst -nobackslashes {abc $x [expr 1+2] \\\x41}
sl@0: } {abc 123 3 \\\x41}
sl@0: test subst-7.5 {switches} {
sl@0:     set x 123
sl@0:     subst -nocommands {abc $x [expr 1+2] \\\x41}
sl@0: } {abc 123 [expr 1+2] \A}
sl@0: test subst-7.6 {switches} {
sl@0:     set x 123
sl@0:     subst -novariables {abc $x [expr 1+2] \\\x41}
sl@0: } {abc $x 3 \A}
sl@0: test subst-7.7 {switches} {
sl@0:     set x 123
sl@0:     subst -nov -nob -noc {abc $x [expr 1+2] \\\x41}
sl@0: } {abc $x [expr 1+2] \\\x41}
sl@0: 
sl@0: test subst-8.1 {return in a subst} {
sl@0:     subst {foo [return {x}; bogus code] bar}
sl@0: } {foo x bar}
sl@0: test subst-8.2 {return in a subst} {
sl@0:     subst {foo [return x ; bogus code] bar}
sl@0: } {foo x bar}
sl@0: test subst-8.3 {return in a subst} {
sl@0:     subst {foo [if 1 { return {x}; bogus code }] bar}
sl@0: } {foo x bar}
sl@0: test subst-8.4 {return in a subst} {
sl@0:     subst {[eval {return hi}] there}
sl@0: } {hi there}
sl@0: test subst-8.5 {return in a subst} {
sl@0:     subst {foo [return {]}; bogus code] bar}
sl@0: } {foo ] bar}
sl@0: test subst-8.6 {return in a subst} {
sl@0:     list [catch {subst {foo [return {x}; bogus code bar}} msg] $msg
sl@0: } {1 {missing close-bracket}}
sl@0: test subst-8.7 {return in a subst, parse error} {
sl@0:     subst {foo [return {x} ; set a {}" ; stuff] bar}
sl@0: } {foo xset a {}" ; stuff] bar}
sl@0: test subst-8.8 {return in a subst, parse error} {
sl@0:     subst {foo [return {x} ; set bar baz ; set a {}" ; stuff] bar}
sl@0: } {foo xset bar baz ; set a {}" ; stuff] bar}
sl@0: test subst-8.9 {return in a variable subst} {
sl@0:     subst {foo $var([return {x}]) bar}
sl@0: } {foo x bar}
sl@0: 
sl@0: test subst-9.1 {error in a subst} {
sl@0:     list [catch {subst {[error foo; bogus code]bar}} msg] $msg
sl@0: } {1 foo}
sl@0: test subst-9.2 {error in a subst} {
sl@0:     list [catch {subst {[if 1 { error foo; bogus code}]bar}} msg] $msg
sl@0: } {1 foo}
sl@0: test subst-9.3 {error in a variable subst} {
sl@0:     list [catch {subst {foo $var([error foo]) bar}} msg] $msg
sl@0: } {1 foo}
sl@0: 
sl@0: test subst-10.1 {break in a subst} {
sl@0:     subst {foo [break; bogus code] bar}
sl@0: } {foo }
sl@0: test subst-10.2 {break in a subst} {
sl@0:     subst {foo [break; return x; bogus code] bar}
sl@0: } {foo }
sl@0: test subst-10.3 {break in a subst} {
sl@0:     subst {foo [if 1 { break; bogus code}] bar}
sl@0: } {foo }
sl@0: test subst-10.4 {break in a subst, parse error} {
sl@0:     subst {foo [break ; set a {}{} ; stuff] bar}
sl@0: } {foo }
sl@0: test subst-10.5 {break in a subst, parse error} {
sl@0:     subst {foo [break ;set bar baz ;set a {}{} ; stuff] bar}
sl@0: } {foo }
sl@0: test subst-10.6 {break in a variable subst} {
sl@0:     subst {foo $var([break]) bar}
sl@0: } {foo }
sl@0: 
sl@0: test subst-11.1 {continue in a subst} {
sl@0:     subst {foo [continue; bogus code] bar}
sl@0: } {foo  bar}
sl@0: test subst-11.2 {continue in a subst} {
sl@0:     subst {foo [continue; return x; bogus code] bar}
sl@0: } {foo  bar}
sl@0: test subst-11.3 {continue in a subst} {
sl@0:     subst {foo [if 1 { continue; bogus code}] bar}
sl@0: } {foo  bar}
sl@0: test subst-11.4 {continue in a subst, parse error} {
sl@0:     subst {foo [continue ; set a {}{} ; stuff] bar}
sl@0: } {foo set a {}{} ; stuff] bar}
sl@0: test subst-11.5 {continue in a subst, parse error} {
sl@0:     subst {foo [continue ;set bar baz ;set a {}{} ; stuff] bar}
sl@0: } {foo set bar baz ;set a {}{} ; stuff] bar}
sl@0: test subst-11.6 {continue in a variable subst} {
sl@0:     subst {foo $var([continue]) bar}
sl@0: } {foo  bar}
sl@0: 
sl@0: test subst-12.1 {nasty case, Bug 1036649} {
sl@0:     for {set i 0} {$i < 10} {incr i} {
sl@0: 	set res [list [catch {subst "\[subst {};"} msg] $msg]
sl@0: 	if {$msg ne "missing close-bracket"} break
sl@0:     }
sl@0:     set res
sl@0: } {1 {missing close-bracket}}
sl@0: test subst-12.2 {nasty case, Bug 1036649} {
sl@0:     for {set i 0} {$i < 10} {incr i} {
sl@0: 	set res [list [catch {subst "\[subst {}; "} msg] $msg]
sl@0: 	if {$msg ne "missing close-bracket"} break
sl@0:     }
sl@0:     set res
sl@0: } {1 {missing close-bracket}}
sl@0: test subst-12.3 {nasty case, Bug 1036649} {
sl@0:     set x 0
sl@0:     for {set i 0} {$i < 10} {incr i} {
sl@0:         set res [list [catch {subst "\[incr x;"} msg] $msg]
sl@0:         if {$msg ne "missing close-bracket"} break
sl@0:     }
sl@0:     list $res $x
sl@0: } {{1 {missing close-bracket}} 10}
sl@0: test subst-12.4 {nasty case, Bug 1036649} {
sl@0:     set x 0
sl@0:     for {set i 0} {$i < 10} {incr i} {
sl@0:         set res [list [catch {subst "\[incr x; "} msg] $msg]
sl@0:         if {$msg ne "missing close-bracket"} break
sl@0:     }
sl@0:     list $res $x
sl@0: } {{1 {missing close-bracket}} 10}
sl@0: test subst-12.5 {nasty case, Bug 1036649} {
sl@0:     set x 0
sl@0:     for {set i 0} {$i < 10} {incr i} {
sl@0:         set res [list [catch {subst "\[incr x"} msg] $msg]
sl@0:         if {$msg ne "missing close-bracket"} break
sl@0:     }
sl@0:     list $res $x
sl@0: } {{1 {missing close-bracket}} 0}
sl@0: 
sl@0: # cleanup
sl@0: ::tcltest::cleanupTests
sl@0: return