Unexpected switch command behavior in TCL - switch-statement

I am trying to run the below switch block using TCL. I am expecting the output to be 10 based on how the switch statement works. But the output comes out to be Default. I am not what's the explanation behind that and how I can fix it.
set a 10
set data 10
switch $data {
$a {
puts "10"
}
default {
puts "Default"
}
}
The output is:
Default

In tcl, the string enclosed in {} is literal. The variables in the string is not substituted. The same rule applies to the statements of the {} blocks passed to if/for/switch commands.
So in your case, $a is a literal string, not 10, for the switch command.
You may re-write your switch block as following thus $a is substituted to 10 before passed to switch command.
switch $data [list \
$a {
puts "10"
} \
default {
puts "Default"
} \
]

Related

Tcl: constructing list with literal `$` in values

I'm trying to construct a (Tcl/)Tk command (to be associated with a widget's -command), that contains a variable that must be expanded at runtime.
In the original code this variable had a fixed name (so everything was simple and we used {...}):
Something like this:
proc addaction {widgid} {
$widgid add command -label "Action" -command {::actioncmd $::targetid}
}
addaction .pop1 # dynamic target is read from $::targetid
set ::targetid .foo ## now the action for the .pop1 widget targets .foo
set ::targetid .bar ## now the action for the .pop1 widget targets .bar
But now I would like to change this so we can replace the to-be-expanded variable with a fixed value in the "constructor".
The constraints are:
to keep the signature of addaction (therefore id must be optional)
not to touch ::actioncmd at all.
So I came up with something like this:
proc addaction {widgid {id $::targetid}} {
$widgid add command -label "Action" -command [list ::actioncmd $id]
}
addaction .pop1 # (as before)
addaction .pop2 .foo # static target for .pop2 is *always* .foo
Unfortunately my replacement code, doesn't work as the the $::targetid variable is no longer expanded. That is, if I trigger the widget's command I get:
$::targetid: no such object
Obviously the problem is with dynamically constructing a list that contains $args.
Or more likely: the subtle differences between lists and strings.
At least here's my test that shows that I cannot mimick {...} with [list ...]:
set a bar
set x {foo bar}
set y [list foo $a]
if { $x eq $y } {puts hooray} else {puts ouch}
# hooray, the two are equivalent, and both are 'foo bar'
set b {$bar}
set x {foo $bar}
set y [list foo $b]
if { $x eq $y } {puts hooray} else {puts ouch}
# ouch, the two are different, x is 'foo $bar' whereas y is 'foo {$bar}'
So: how can I construct a command foo $bar (with an expandable $bar) where $bar is expanded from a variable?
A naive solution could be:
proc addaction {widgid {id {}}} {
if { $id ne {} } {
set command [list ::actioncmd $id]
} else {
set command {::actioncmd $::targetid}
}
$widgid add command -label "Action" -command $command
}
But of course, in reality the addaction proc adds more actions than just a single one, and the code quickly becomes less readable (imo).
For cases such as yours, the easiest approach might be:
proc addaction {widgid {id $::targetid}} {
$widgid add command -label "Action" -command [list ::actioncmd [subst $id]]
}
That will be fine as long as those IDs are simple words (up to and including using spaces) but does require that you go in with the expectation that the value is being substituted (i.e., that $, [ and \ are special).
Alternatively, you could check how many arguments were passed and modify how the script is generated based on that:
# The value of the default doesn't actually matter
proc addaction {widgid {id $::targetid}} {
# How many argument words were passed? Includes the command name itself
if {[llength [info level 0]] == 2} {
# No extra argument; traditional code
$widgid add command -label "Action" -command {::actioncmd $::targetid}
} else {
# Extra argument: new style
$widgid add command -label "Action" -command [list ::actioncmd $id]]
}
}

Shell script error "syntax error at line 145: `<<' unmatched" [duplicate]

For personal development and projects I work on, we use four spaces instead of tabs.
However, I need to use a heredoc, and I can't do so without breaking the indention flow.
The only working way to do this I can think of would be this:
usage() {
cat << ' EOF' | sed -e 's/^ //';
Hello, this is a cool program.
This should get unindented.
This code should stay indented:
something() {
echo It works, yo!;
}
That's all.
EOF
}
Is there a better way to do this?
Let me know if this belongs on the Unix/Linux Stack Exchange instead.
(If you are using bash 4, scroll to the end for what I think is the best combination of pure shell and readability.)
For heredocs, using tabs is not a matter of preference or style; it's how the language is defined.
usage () {
⟶# Lines between EOF are each indented with the same number of tabs
⟶# Spaces can follow the tabs for in-document indentation
⟶cat <<-EOF
⟶⟶Hello, this is a cool program.
⟶⟶This should get unindented.
⟶⟶This code should stay indented:
⟶⟶ something() {
⟶⟶ echo It works, yo!;
⟶⟶ }
⟶⟶That's all.
⟶EOF
}
Another option is to avoid a here document altogether, at the cost of having to use more quotes and line continuations:
usage () {
printf '%s\n' \
"Hello, this is a cool program." \
"This should get unindented." \
"This code should stay indented:" \
" something() {" \
" echo It works, yo!" \
" }" \
"That's all."
}
If you are willing to forego POSIX compatibility, you can use an array to avoid the explicit line continuations:
usage () {
message=(
"Hello, this is a cool program."
"This should get unindented."
"This code should stay indented:"
" something() {"
" echo It works, yo!"
" }"
"That's all."
)
printf '%s\n' "${message[#]}"
}
The following uses a here document again, but this time with bash 4's readarray command to populate an array. Parameter expansion takes care of removing a fixed number of spaces from the beginning of each lie.
usage () {
# No tabs necessary!
readarray message <<' EOF'
Hello, this is a cool program.
This should get unindented.
This code should stay indented:
something() {
echo It works, yo!;
}
That's all.
EOF
# Each line is indented an extra 8 spaces, so strip them
printf '%s' "${message[#]# }"
}
One last variation: you can use an extended pattern to simplify the parameter expansion. Instead of having to count how many spaces are used for indentation, simply end the indentation with a chosen non-space character, then match the fixed prefix. I use : . (The space following
the colon is for readability; it can be dropped with a minor change to the prefix pattern.)
(Also, as an aside, one drawback to your very nice trick of using a here-doc delimiter that starts with whitespace is that it prevents you from performing expansions inside the here-doc. If you wanted to do so, you'd have to either leave the delimiter unindented, or make one minor exception to your no-tab rule and use <<-EOF and a tab-indented closing delimiter.)
usage () {
# No tabs necessary!
closing="That's all"
readarray message <<EOF
: Hello, this is a cool program.
: This should get unindented.
: This code should stay indented:
: something() {
: echo It works, yo!;
: }
: $closing
EOF
shopt -s extglob
printf '%s' "${message[#]#+( ): }"
shopt -u extglob
}
geta() {
local _ref=$1
local -a _lines
local _i
local _leading_whitespace
local _len
IFS=$'\n' read -rd '' -a _lines ||:
_leading_whitespace=${_lines[0]%%[^[:space:]]*}
_len=${#_leading_whitespace}
for _i in "${!_lines[#]}"; do
printf -v "$_ref"[$_i] '%s' "${_lines[$_i]:$_len}"
done
}
gets() {
local _ref=$1
local -a _result
local IFS
geta _result
IFS=$'\n'
printf -v "$_ref" '%s' "${_result[*]}"
}
This is a slightly different approach which requires Bash 4.1 due to printf's assigning to array elements. (for prior versions, substitute the geta function below). It deals with arbitrary leading whitespace, not just a predetermined amount.
The first function, geta, reads from stdin, strips leading whitespace and returns the result in the array whose name was passed in.
The second, gets, does the same thing as geta but returns a single string with newlines intact (except the last).
If you pass in the name of an existing variable to geta, make sure it is already empty.
Invoke geta like so:
$ geta hello <<'EOS'
> hello
> there
>EOS
$ declare -p hello
declare -a hello='([0]="hello" [1]="there")'
gets:
$ unset -v hello
$ gets hello <<'EOS'
> hello
> there
> EOS
$ declare -p hello
declare -- hello="hello
there"
This approach should work for any combination of leading whitespace characters, so long as they are the same characters for all subsequent lines. The function strips the same number of characters from the front of each line, based on the number of leading whitespace characters in the first line.
The reason all the variables start with underscore is to minimize the chance of a name collision with the passed array name. You might want to rewrite this to prefix them with something even less likely to collide.
To use in OP's function:
gets usage_message <<'EOS'
Hello, this is a cool program.
This should get unindented.
This code should stay indented:
something() {
echo It works, yo!;
}
That's all.
EOS
usage() {
printf '%s\n' "$usage_message"
}
As mentioned, for Bash older than 4.1:
geta() {
local _ref=$1
local -a _lines
local _i
local _leading_whitespace
local _len
IFS=$'\n' read -rd '' -a _lines ||:
_leading_whitespace=${_lines[0]%%[^[:space:]]*}
_len=${#_leading_whitespace}
for _i in "${!_lines[#]}"; do
eval "$(printf '%s+=( "%s" )' "$_ref" "${_lines[$_i]:$_len}")"
done
}

Check whether string contains fragment in Tcl

I have a set of words, e.g. {6-31G*, 6-311G*, 6-31++G*, 6-311++G**}. As you may see, the common fragment is "6-31". What I need to do in Tcl now is to check whether string under $variable contains this fragment. I know I could do it with regular expression like this:
if {[regexp {^6-31} $variable]} {
puts "You provided Pople-style basis set"
}
but what other solution could I use (just out of curiosity)?
Just to check if a string contains a particular substring, I'd use string first
set substring "6-31"
if {[string first $substring $variable] != -1} {
puts "\"$substring\" found in \"$variable\""
}
You can also use glob-matching with string match or switch
switch -glob -- $variable {
*$substring* {puts "found"}
default {puts "not found"}
}

TCL list element in quotes followed by } instead of space

I'm trying to write an automated validation test on a small program using TCL. It should evaluate the input h1=7 and pass if the output is 7.000000. Likewise, the input h1=9 should pass if the output is 9.0000. However, I get the following error:
ERROR: list element in quotes followed by "}" instead of space
while executing
"foreach pattern $testdata {
set inputs [ lindex $pattern 0 ]
set expected [ lindex $pattern 1 ]
eval "spawn $CLIC $inputs"
expect {..."
(file "./test/clic/test-clic.exp" line 22)
Here is the code:
#!/usr/bin/expect
set tool "clic"
set CLIC "./clic "
set testdata {
{"h1=7" "7.000000"}
{"h1=9" "9.000000"}
}
# global CLIC
foreach pattern $testdata {
set inputs [ lindex $pattern 0 ]
set expected [ lindex $pattern 1 ]
eval "spawn $CLIC $inputs"
expect {
$expected { pass $inputs }
default { fail $inputs }
}
}
How do I resolve this? Thank you.
Given the error message given and the discrepancy between the line number in the error message and the number of lines in the script you told us about, I'm guessing that you've trimmed down the script a little bit before asking the question. Which would be perfectly OK (and a good thing) except that in the trimming process you removed the thing that was causing the problem! The code that you posted doesn't have the issue.
The issue is almost certainly in one of the lines of testdata that you removed. It's either that you've got malformatted list as testdata, or that it produces a malformatted script when you do the concatenations for the eval "spawn …"; unfortunately, I can't be sure which with the info you've given us. (It's also possibly an issue in the expect with it not liking taking a value from a variable when that argument is in braces; the documentation for expect isn't very clear about this case, yet it gives hints that it might do what you want.)
A good start would be to update the script to actually use the features of Tcl 8.6 (or Tcl 8.5) since you're already using that version. The key changes happen to these lines:
foreach pattern $testdata {
set inputs [ lindex $pattern 0 ]
set expected [ lindex $pattern 1 ]
eval "spawn $CLIC $inputs"
Which are much better written as:
foreach pattern $testdata {
lassign $pattern inputs expected
spawn {*}$CLIC {*}$inputs
That has far fewer ways of being misinterpreted than what you were using before, as well as being shorter. We can also wrap that all up in code to give better error handling:
foreach pattern $testdata {
if {[catch {
lassign $pattern inputs expected
spawn {*}$CLIC {*}$inputs
} msg]} {
puts stderr "Problem handling pattern '$pattern': $msg"
continue
}
If you still get the same failure at that point, the problem is almost certainly that your overall testdata is a malformed list (and it would be malformed like this: "something"{something else} with no whitespace between closing quotes and opening braces); since that's under your complete control, you'll just have to fix it…

Auto_execok problem on cygwin

I have a problem:
the auto_execok command doesn't work on Cygwin platform as expected.
It cannot find anything from your PATH enviroment variable, as
info body auto_execok
"...
foreach dir [split $path {;}] {
"
It thinks by default that ; is right separator, but Cygwin uses :!
How to elegantly overcome this problem?
I don't want to change PATH variable as other programs/scripts could correctly use : as it should be for Cygwin.
Have you got a proper Cygwin-aware build of Tcl? As you've found, a straight Windows build runs into problems precisely because the Cygwin environment is a sort of mix between Unix and Windows. (This an example of why we don't fully support doing things in Cygwin; it gets some love from time to time, but it's not a primary platform because it is fully of fiddly complexities.) That said, this is the sort of question which it is almost certainly better to ask on comp.lang.tcl as that's got a community likely to be able to help with this sort of thing.
Also, what patch-level of Tcl is this? This matters because the level of support has most certainly varied over time…
We can use a mix of set ar [info args auto_execok], set bd [info body auto_execok],
some regsub on body with set cygdir [exec cygpath -a $wdir] and eval proc auto_exeok {$ar} {$bd} to obtain needed result.
However, for the moment, I'm not yet ready with the complete solution.
You can wrap the native tcl version of auto_execok with one that will resolve the correct path. We can use the fact that the original auto_execok will find the cygpath.exe and in one fell swoop tell use that the current script is running windows and it is setup for cygwin. Once that it is known we can wrap the original auto_execok proc with one that will use cygpath.exe to resolve the true windows path. I have used the try command so this is for 8.5 and above but this can be written using catch for lower versions of tcl. Also because subst command is used the path to cygpath is hardcoded into the new auto_execok proc so lookup only happens once. Also only allow this code to run once. So as example
before code below runs
puts "[ auto_execok tar ]"
gives
"/usr/bin/tar"
after code is run auto_execok is wrapped:
puts "[ auto_execok tar ]"
gives (on my machine):
"C:/cygwin/bin/tar.EXE"
if { [string length [ auto_execok cygpath ] ] } {
set paths [ split $env(PATH) ";" ]
set cygexecpath ""
foreach p $paths {
set c [file join $p cygpath.exe ]
puts "checking for $c "
if {[file exists $c ] } {
set cygexecpath [file join $p cygpath.exe ]
break
}
}
if { $cygexecpath eq "" } {
puts "unable to find true path to [auto_execok cygpath.exe ]"
}
# rename original proc so we can use it in our wrapper proc
rename ::auto_execok ::auto_execok_orig
uplevel #0 [subst -nocommands {proc auto_execok { path } {
try {
set path [auto_execok_orig \$path ]
if { \$path ne \"\" } {
set path [string trim [exec $cygexecpath -w \$path ] ]
}
} on error { a b } {
set path \"\"
}
return \$path
} } ]
puts "[info body auto_execok ] "
}

Resources