Tcl: how does this proc return a value? - tcl

I'm modifying the code below, but I have no idea how it works - enlightenment welcome. The issue is that there is a proc in it (cygwin_prefix) which is meant to create a command, by either
leaving a filename unmodified, or
prepending a string to the filename
The problem is that the proc returns nothing, but the script magically still works. How? Specifically, how does the line set command [cygwin_prefix filter_g] actually manage to correctly set command?
For background, the script simply execs filter_g < foo.txt > foo.txt.temp. However, historically (this no longer seems to be the case) this didn't work on Cygwin, so it instead ran /usr/bin/env tclsh filter_g < foo.txt > foo.txt.temp. The script as shown 'works' on both Linux (Tcl 8.5) and Cygwin (Tcl 8.6).
Thanks.
#!/usr/bin/env tclsh
proc cygwin_prefix { file } {
global cygwin
if {$cygwin} {
set status [catch { set fpath [eval exec which $file] } result ]
if { $status != 0 } {
puts "which error: '$result'"
exit 1
}
set file "/usr/bin/env tclsh $fpath"
}
set file
}
set cygwin 1
set filein foo.txt
set command [cygwin_prefix filter_g]
set command "$command < $filein > $filein.temp"
set status [catch { eval exec $command } result ]
if { $status != 0 } {
puts "filter error: '$result'"
exit 1
}
exit 0

The key to your question is two-fold.
If a procedure doesn't finish with return (or error, of course) the result of the procedure is the result of the last command executed in that procedure's body.
(Or the empty string, if no commands were executed. Doesn't apply in this case.)
This is useful for things like procedures that just wrap commands:
proc randomPick {list} {
lindex $list [expr { int(rand() * [llength $list]) }]
}
Yes, you could add in return […] but it just adds clutter for something so short.
The set command, with one argument, reads the named variable and produces the value inside the var as its result.
A very long time ago (around 30 years now) this was how all variables were read. Fortunately for us, the $… syntax was added which is much more convenient in 99.99% of all cases. The only place left where it's sometimes sensible is with computed variable names, but most of the time there's a better option even there too.
The form you see with set file at the end of a procedure instead of return $file had currency for a while because it produced slightly shorter bytecode. By one unreachable opcode. The difference in bytecode is gone now. There's also no performance difference, and never was (especially by comparison with the weight of exec which launches subprocesses and generally does a lot of system calls!)

It's not required to use eval for exec. Building up a command as a list will protect you from, for example, path items that contain a space. Here's a quick rewrite to demonstrate:
proc cygwin_prefix { file } {
if {$::cygwin} {
set status [catch { set fpath [exec which $file] } result]
if { $status != 0 } {
error "which error: '$result'"
}
set file [list /usr/bin/env tclsh $fpath]
}
return $file
}
set cygwin 1
set filein foo.txt
set command [cygwin_prefix filter_g]
lappend command "<" $filein ">" $filein.temp
set status [catch { exec {*}$command } result]
if { $status != 0 } {
error "filter error: '$result'"
}
This uses {*} to explode the list into individual words to pass to exec.

Related

How to prevent tcl script from exiting?

I am running tclsh some.tcl and it exits after it hits eof. I want it not to exit and gives control to user for interaction. Note that we can do this by invoking shell and sourcing script but that doesn't solve my problem as it cannot be used in automation.
If you can load the TclX package (old but still useful) then you can do:
package require Tclx; # Lower case at the end for historical reasons
# Your stuff here
commandloop
That's very much like how Tcl's own interactive command line works.
Otherwise, here's a scripted version that does most of what an interactive command session does:
if {![info exists tcl_prompt1]} {
set tcl_prompt1 {puts -nonewline "% ";flush stdout}
}
if {![info exists tcl_prompt2]} {
# Note that tclsh actually defaults to not printing anything for this prompt
set tcl_prompt2 {puts -nonewline "> ";flush stdout}
}
set script ""
set prompt $tcl_prompt1
while {![eof stdin]} {
eval $prompt; # Print the prompt by running its script
if {[gets stdin line] >= 0} {
append script $line "\n"; # The newline is important
if {[info complete $script]} { # Magic! Parse for syntactic completeness
if {[catch $script msg]} { # Evaluates the script and catches the result
puts stderr $msg
} elseif {$msg ne ""} { # Don't print empty results
puts stdout $msg
}
# Accumulate the next command
set script ""
set prompt $tcl_prompt1
} else {
# We have a continuation line
set prompt $tcl_prompt2
}
}
}
Getting the remaining bits right (e.g., the interaction with the event loop when the Tk package is loaded) would require quite a bit more complexity...

Assigning value to a variable only if argv specified in TCL

I am new to the TCL scripting .I have a script called "Sample.tcl". In the Sample.tcl I have a variable called $name. How can I assign a value to the variable if there exist a specific argv i.e.
Sample.tcl -step xyz
Only if I specify -step then $name should be xyz.
I'm not sure what $name might be in this context (it's a really unusual name for a variable, and using variable variable names is typically a bad idea) but under the guess that you're trying to set step to xyz in this case, you can put this in your script:
apply {{} {
# For each pair of values in the arguments (after the script name)
global argv
foreach {key value} $argv {
# Safety-check: if the key starts with a hyphen...
if {[string match -* $key]} {
# ... strip the leading hyphen(s)
set varname [string trimleft $key "-"]
# ... bind that global var name to a local name
upvar 1 $varname var
# ... and set the variable to the value we've got.
set var $value
}
}
}}
It's done in an apply so that we don't pollute the global namespace with all our working variables (key, value, varname and var) and because we don't really need to make a procedure for something we're only going to do once.
This isn't a safe piece of code, not by any means, but it is a useful and flexible way to get something working.
In general, parsing command line arguments can take quite a bit of thought to get perfectly right and there's various packages to help out, but that's only really important when writing code for other people to run. When it's just for yourself, you can be a lot sloppier and get the job done in a few minutes.
Using the cmdline package from tcllib you could write:
#!/usr/bin/env tclsh
package require cmdline
set options {
{step.arg "" "Set the step value"}
}
try {
array set params [cmdline::getoptions argv $options]
} on error e {
puts stderr $e
exit 1
}
if {$params(step) ne ""} {
set name $params(step)
}
if {[info exists name]} {
puts "name = $name"
} else {
puts "name is not set"
}

Why can't I access errorInfo and errorCode

I have the following code:
$ cat ~/tmp/2.tcl
set zero 0
proc p1 {} {
if {[catch {expr 1/$zero} err]} {
puts "errorCode=$errorCode"
puts "errorInfo=$errorInfo"
}
}
p1
When I source it, I get error accessing errorCode:
$ tclsh ~/tmp/2.tcl
can't read "errorCode": no such variable
while executing
"puts "errorCode=$errorCode""
(procedure "p1" line 3)
invoked from within
"p1"
(file "~/tmp/2.tcl" line 9)
I tried changing to $::errorCode, but did not help.
Can you see what is wrong?
The errorInfo and errorCode variables are globals. You should either use the global command to bring them into scope or use their fully-qualified names (i.e., precede with ::).
It might be easier to pick the information out of the result options dictionary (a new feature in 8.5).
Starting from Tcl 8.5 [catch] doesn't set the errorCode and errorInfo global variables. (As Donal has pointed out, it still does, so they can be accessed as $::errorCode and $::errorInfo). And in addition it puts their values into a dictionary which name is to be specified as the third argument. The following code
#!/usr/bin/tclsh
set zero 0
proc p1 {} {
if {[catch {expr 1/$zero} err opts] == 1} {
puts "errorCode=[dict get $opts -errorcode]"
puts "errorInfo=[dict get $opts -errorinfo]"
}
}
p1
prints
errorCode=NONE
errorInfo=can't read "zero": no such variable
while executing
"expr 1/$zero"
in Tcl 8.5.19, and
errorCode=TCL READ VARNAME
errorInfo=can't read "zero": no such variable
while executing
"expr 1/$zero"
in Tcl8.6.6.
You'd probably want to use $::zero in the division after which the result would be
errorCode=ARITH DIVZERO {divide by zero}
errorInfo=divide by zero
while executing
"expr 1/$::zero"

Code that works in 8.4 is causing crash in 8.6, is there a better way to implement the functionality

I have a Tcl utility that makes it easy to ensure a snippet of code run at the time control flow leaves the current scope (of the proc). It crashes in Tcl 8.6.6, so I'm wondering if there is a "better" way to implement the functionality in Tcl 8.6?
An example usage is:
proc test {file} {
set fh [open $file]
::Util::Defer [list close $fh]
# ... do a bunch of stuff
# and even if we hit an error
# [close $fh] will be evaluated as we return
# from the proc
}
It's worked great in Tcl 8.4, and I use it all over my code.
As I'm still coming up to speed on all the functionality available in Tcl 8.6, I'm asking how should the ::Util::Defer proc be written to best take advantage of Tcl 8.6?
Here is the 8.4 implementation:
namespace eval ::Util {}
proc ::Util::Defer_impl {cmd args} {
uplevel 1 $cmd
}
proc ::Util::Defer {cmd} {
set vname _u_defer_var
# look for a unique variable name
while {[uplevel 1 [list info vars $vname]] != ""} {
set vname ${vname}_
}
uplevel 1 [list set $vname $cmd]
# when the variable is unset, trigger a call to the command
uplevel 1 [list trace add variable $vname unset [list ::Util::Defer_impl $cmd]]
# return a chunk of code enabling the user to cancel this if desired
return [list variable $vname unset [list ::Util::Defer_impl $cmd]]
}
Edited to add:
I appreciate the answers. To be honest, I already have other syntactic sugar for a file handle, this:
proc test {file} {
set fh [::Util::LocalFileHandle $file]
# do stuff
}
I was just hoping more for a generic solution to the ::Util::Defer - because I occasionally have two or three uses (at different locations) in the same proc. Yes, I'm leaving out the error handling if the doesn't exist or isn't readable.
Note: I have reported the bug to ActiveState and filed a bug at core.tcl.tk.
Edited to add buggy code: This is the Tcl code that causes a crash for me, it is slightly pared down to the essence (as opposed to being the full-blown ::Util::Defer).
# ---------------begin script-------------------
package require Itcl
proc ::try_uplevel {} {
return [uplevel 1 [list ::info vars _u_defer_var]]
}
itcl::class ::test_class {
constructor {} {}
public proc test_via_proc {} {
::try_uplevel
}
}
::test_class::test_via_proc
# ---------------end script-------------------
The pattern you describe is a supported one; it shouldn't crash (and indeed I can't reproduce the crash with 8.6.3 or the tip of the 8.6 support branch). The only problem it has is that if you have an error during the close (or any other deferred script) it won't report it, as you can see from this snippet (% is prompt):
% apply {{} {
::Util::Defer [list error boo]
puts hi
}}
hi
%
This is part of why I went to quite a bit of effort to provide a try command in 8.6. With that, you can do this:
proc test {filename} {
set f [open $filename]
try {
# Do stuff with $f
} finally {
close $f
}
}
It also takes care of tricky things like stitching errors thrown inside the body and the finally clause together (the body exception info is in the -during option of the finally clause's error exception info) so that if both places error you can find out about both.
% catch {
try {
error a
} finally {
error b
}
} x y
1
% puts $x
b
% puts $y
-errorstack {INNER {returnImm b {}}} -errorcode NONE -errorinfo {b
while executing
"error b"} -errorline 5 -during {-code 1 -level 0 -errorstack {INNER {returnImm a {}}} -errorcode NONE -errorinfo {a
while executing
"error a"} -errorline 3} -code 1 -level 0
Personally, I'd be more inclined to write this:
proc withreadfile {varName filename body} {
upvar 1 $varName f
set f [open $filename]
try {
return [uplevel 1 $body]
} finally {
close $f
}
}
proc test {file} {
withreadfile fh $file {
# Do stuff with $fh
}
}
Your mileage may vary.
Untested code (this exact snippet, I've used this pattern many times):
proc test file {
try {
open $file
} on ok fh {
# do stuff with fh
# more stuff
} finally {
catch {close $fh}
}
}
should be about the same. Regardless of whether you handle errors with the try structure or not, (or whether you get errors or not) the code in the finally clause is run when it ends. If you want to be able to cancel the action, use a simple if inside the clause.
Edit
In case one wants to see any errors generated when the channel is closed, it's a bad idea to just wrap it in a catch, which is necessary if the file couldn't be opened and the channel-id variable wasn't created. Alternatives include:
Checking for existence: if {[info exists fh]} {close $fh}
Propagate the closing error: using the result and options variable name arguments to catch.
Over the weekend this heavyweight solution came to mind. It leverages the itcl::local functionality to achieve the same effect. It does depend on Itcl - but since the problem is an interaction with Itcl, that seems a reasonable solution, even though it is not purely Tcl.
itcl::class Defer_impl {
constructor {cmd} {} {
set _to_eval $cmd
}
destructor {
uplevel 1 $_to_eval
}
private variable _to_eval {}
}
proc ::Util::Defer {cmd} {
uplevel 1 [list itcl::local ::Defer_impl #auto $cmd]
}

How to suppress a proc's return value in tcl prompt

I'm relatively new in TCL, in TCL prompt, when we invoke a proc with some return value, the proc's return value is echoed back by tcl. Is there a way to stop it (without affecting puts or similar functionality) as an example
bash$ tclsh
% proc a {} { puts "hello"; return 34; }
% a
hello
34
%
Now how do i suppress the 34 coming to the screen? Any help is appreciated.
Update:
Actually the proc is a part of another tool, earlier it did not have any return value, but now conditionally it can return a value.
it can be called from a script and there won't be any problem (as Bryan pointed out). and it can be called from interactive prompt, then after all the necessary outputs, the return value is getting printed unnecessarily.
So 1) I don't have the facility of changing a user's tclshrc 2) existing scripts should continue to work.
And it seems strange that every time the proc is called, after all the necessary outputs, a number gets printed. To a user, this is a needless information unless he has caught the value and wants to do something. So i wanted the value to be delivered to user, but without getting printed to prompt/UI (hope i'm clear )
The interactive shell code in tclsh and wish will print any non-empty result. To get nothing printed, you have to have the last command on the “line” produce an empty result. But which command to use?
Many commands will produce an empty result:
if 1 {}
subst ""
format ""
However, the shortest is probably:
list
Thus, you could write your code like:
a;list
Of course, this only really becomes useful when your command actually produces a large result that you don't want to see. In those cases, I often find that it is most useful to use something that measures the size of the result, such as:
set tmp [something_which_produces a_gigantic result]; string length $tmp
The most useful commands I find for that are string length, llength and dict size.
If you absolutely must not print the result of the command, you have to write your own interactive loop. There are two ways to do this, depending on whether you are running inside the event loop or not:
Without the event loop
This simplistic version just checks to see if the command name is in what the user typed. It's probably not a good idea to arbitrarily throw away results otherwise!
set accum ""
while {[gets stdin line] >= 0} {
append accum $line "\n"
if {[info complete $accum]} {
if {[catch $accum msg]} {
puts stderr $msg
} elseif {$msg ne "" && ![string match *TheSpecialCommand* $accum]} {
puts $msg
}
set accum ""
}
}
With the event loop
This is just handling the blocking IO case; that's the correct thing when input is from a cooked terminal (i.e., the default)
fileevent stdin readable handleInput
set accum ""
proc handleInput {} {
global accum
if {[gets stdin line] < 0} {
exit; # Or whatever
}
append accum $line "\n"
if {[info complete $accum]} {
if {[catch {uplevel "#0" $accum} msg]} {
puts stderr $msg
} elseif {$msg ne "" && ![string match *TheSpecialCommand* $accum]} {
puts $msg
}
set accum ""
}
}
vwait forever; # Assuming you're not in wish or have some other event loop...
How to detect the command is being executed
The code above uses ![string match *TheSpecialCommand* $accum] to decide whether to throw away the command results, but this is very ugly. A more elegant approach that leverages Tcl's own built-in hooks is to use an execution trace to detect whether the command has been called (I'll just show the non-event-loop version here, for brevity). The other advantage of this is that it is simple to extend to suppressing the output from multiple commands: just add the trace to each of them.
trace add execution TheSpecialCommand enter SuppressOutput
proc SuppressOutput args {
# Important; do not suppress when it is called inside another command
if {[info level] == 1} {
set ::SuppressTheOutput 1
}
}
# Mostly very similar from here on
set accum ""
while {[gets stdin line] >= 0} {
append accum $line "\n"
if {[info complete $accum]} {
set SuppressTheOutput 0; # <<<<<< Note this!
if {[catch $accum msg]} {
puts stderr $msg
} elseif {$msg ne "" && !$SuppressTheOutput} { # <<<<<< Note this!
puts $msg
}
set accum ""
}
}
To be clear, I wouldn't ever do this in my own code! I'd just suppress the output manually if it mattered.
You could make an empty procedure in .tclshrc...
proc void {} {}
...and when you don't need a return value, end the line with ;void.
Use tcl_interactive variable to enable the return of of the value, although I'm not sure where this would be useful...
proc a {} {
puts "hello"
if { [info exist tcl_interactive] } {
return {};
} else {
return 34;
}
}