What is this line getting from a different file (TCL)? - tcl

I am including the relevant code below, and I can explain what I know it is doing up to this point:
proc rshm {where {i 0}} {
global ob
set what "???"
set ob(last_rshm_failed) "yes"
if {![info exists ob(shm)]} {
return "0.0"
}
if {[info exists ob(shm_puts_exist_in_progress)]} {
return "0.0"
}
shm_puts "g $where $i"
gets $ob(shm) istr
set what [lindex $istr 0]
set ob(last_rshm_failed) "no"
if {[string equal $what "?"]} {
set ob(last_rshm_failed) "yes"
puts stderr $istr
return "0.0"
}
set what [lindex $istr 3]
return $what
}
From looking at the rest of the program, I have concluded that the first two if statements are checking for errors elsewhere and are designed to terminate the procedure if the errors trigger.
Elsewhere in the program, the place (of interest) that the function gets called is in the form: rshm ft_xdev
Using print statements, I found that ft_xdev passes into the procedure as shm_puts "g ft_xdev 0".
The line that is throwing me off is the line: gets $ob(shm) istr
The call to $ob(shm) is another file (originally a binary program, but the readable version is in C...), but upon looking at this file, there is no reference to anything called "istr".
Would someone mind helping me out with what this line is getting from the other file? If needed, I can provide more code from the program.

The code:
gets $ob(shm) istr
will pass the contents of the ob(shm) variable (which should be a channel handle that is at least open for reading) and the string istr (which is used to name a variable in this case) into the gets command. The istr will be a local variable in this case because it hasn't been explicitly stated to be otherwise.
The gets command, when given two arguments, will read a line of text from the channel (first arg) and write that line of text to the variable (second arg). It then yields as result the number of characters read or -1 if there was a recoverable error condition such as end-of-file. You're ignoring the result. (Critical errors would become exceptions.) This is all documented on the manual page for gets.
tl;dr: Reads a line of text from the $ob(shm) channel and stores it in istr.

This procedure will return the 3rd index of $istr ([lindex $istr 3]) if its not empty or does not fail on the prior checks.
The contents of $istr are obtained from grabbing the next line of the open file channel $ob(shm) (if the channel is already open and $ob(shm_puts_exist_in_progress) does not exist).
If shm_puts "g $where $i" impacts the $ob in any way, it would be important to include the procedure shm_puts since it may impact $istr, but I suspect the contents of shm_puts are not relevant to $istr.
Finally if $istr starts with a ? then it aborts this procedure displaying the contents of $istr to stderr. That is, if a line of the file starts with ?, then the procedure aborts.
All procedure aborts (ie IF checks) do not retain the contents of $istr, since its a local variable not a global one, so checking the contents of $istr must be done within this procedure and after the gets command.

Related

Tcl hang in proc return

I write 2 script to do somting like this:
#script1, to dump info:
proc script1 {} {
puts $file "set a 123"
puts $file "set b 456"
.....
}
(The file size I dump is 8GB)
#And use script2 to source it and do data category:
while { [get $file_wrtie_out_by_script1 line] != -1 } {
eval $line
}
close $file_wrtie_out_by_script1
Do the job....
return
In this case, the script is hang in return, how to solve the issue... stuck 3+ days, thnaks
Update:
Thanks for Colin, now I use source instead of eval, but even remove the "Do the job...", just keep return, still hang
The gets command will return the number of characters in the line that it just read from the file channel.
When all the lines of the file have been read, then gets will return -1.
Your problem is that you have a while loop that is never ending. Your while loop will terminate when gets returns 1. You need to change the condition to -1 for the while loop to terminate.
I agree with the comment from Colin that you should just use source instead of eval for each line. Using eval line-by-line will fail if you have a multi-line command (but that might not be the case in your example).

How do I get the contents of list sent into a procedure in Tcl?

I have a TCL procedure that makes a function call to a loaded package that returns a list. When I query the list with llindex for the number of entries, it is accurate. But, when I send that list to a procedure that populates a Tk Listbox, the list has no entries; the llindex function states the number of entires in the list is zero. For a piece of code, in my main code there is:
set ents [pw::Grid getAll -type pw::Connector]
makeWindow . $ents
The $ents has 17 elements in it. Then in my makeWindow procedure, I have:
makeWindow {root args} {
label $base.targetDeltaTxt -text "Target Cell:"
entry $base.targetDelta -cursor {} -textvariable entry
...
set num_cons [expr ([llength $args]-1)]
...
}
The $num_cons is 1, though when it was sent it has 17. It seems that in TCL, sending a list to a procedure concatenates all list elements into a single line of text. Why?
You are running into the fact that having the last parameter of a proc named "args" causes special behaviour. See https://www.tcl.tk/man/tcl8.6/TclCmd/proc.htm for the details. Renaming the parameter from args to anything else, e.g. ents should fix the problem.

How to check if the value of file handle is not null in tcl

I have this snippet in my script:
puts "Enter Filename:"
set file_name [gets stdin]
set fh [open $file_name r]
#Read from the file ....
close $fh
Now, this snippet asks user for a file name.. which is then set as an input file and then read. But when the file with the name $file_name doesn't exists, it shows error saying
illegal file character
How do i check if fh is not null (I don't think there is a concept of NULL in tcl being "everyting is a string" language!), so that if an invalid file_name is given, i can throw a print saying file doesn't exists!
Short answer:
try {
open $file_name
} on ok f {
# do stuff with the open channel using the handle $f
} on error {} {
error {file doesn't exist!}
}
This solution attempts to open the file inside an exception handler. If open is successful, the handler runs the code you give it inside the on ok clause. If open failed, the handler deals with that error by raising a new error with the message you wanted (note that open might actually fail for other reasons as well).
The try command is Tcl 8.6+, for Tcl 8.5 or earlier see the long answer.
Long answer:
Opening a file can fail for several reasons, including missing files or insufficient privileges. Some languages lets the file opening function return a special value indicating failure. Others, including Tcl, signal failure by not letting open return at all but instead raise an exception. In the simplest case, this means that a script can be written without caring about this eventuality:
set f [open nosuchf.ile]
# do stuff with the open channel using the handle $f
# run other code
This script will simply terminate with an error message while executing the open command.
The script doesn't have to terminate because of this. The exception can be intercepted and the code using the file handle be made to execute only if the open command was successful:
if {![catch {open nosuchf.ile} f]} {
# do stuff with the open channel using the handle $f
}
# run other code
(The catch command is a less sophisticated exception handler used in Tcl 8.5 and earlier.)
This script will not terminate prematurely even if open fails, but it will not attempt to use $f either in that case. The "other code" will be run no matter what.
If one wants the "other code" to be aware of whether the open operation failed or succeeded, this construct can be used:
if {![catch {open nosuchf.ile} f]} {
# do stuff with the open channel using the handle $f
# run other code in the knowledge that open succeeded
} else {
# run other code in the knowledge that open failed
}
# run code that doesn't care whether open succeeded or failed
or the state of the variable f can be examined:
catch {open nosuchf.ile} f
if {$f in [file channels $f]} {
# do stuff with the open channel using the handle $f
# run other code in the knowledge that open succeeded
} else {
# run other code in the knowledge that open failed
}
# run code that doesn't care whether open succeeded or failed
(The in operator is in Tcl 8.5+; if you have an earlier version you will need to write the test in another manner. You shouldn't be using earlier versions anyway, since they're not supported.)
This code checks if the value of f is one of the open channels that the interpreter knows about (if it isn't, the value is probably an error message). This is not an elegant solution.
Ensuring the channel is closed
This isn't really related to the question, but a good practice.
try {
open nosuchf.ile
} on ok f {
# do stuff with the open channel using the handle $f
# run other code in the knowledge that open succeeded
} on error {} {
# run other code in the knowledge that open failed
} finally {
catch {chan close $f}
}
# run code that doesn't care whether open succeeded or failed
(The chan command was added in Tcl 8.5 to group several channel-related commands as subcommands. If you're using earlier versions of Tcl, you can just call close without the chan but you will have to roll your own replacement for try ... finally.)
The finally clause ensures that whether or not the file was opened or any error occurred during the execution of the on ok or on error clauses, the channel is guaranteed to be non-existent (destroyed or never created) when we leave the try construct (the variable f will remain with an unusable value, unless we unset it. Since we don't know for sure if it exists, we need to prevent the unset operation from raising errors by using catch {unset f} or unset -nocomplain f. I usually don't bother: if I use the name f again I just set it to a fresh value.).
Documentation: catch, chan, close, error, in operator, file, if, open, set, try, unset
Old answer:
(This answer has its heart in the right place but I'm not satified with it these months later. Since it was accepted and even marked as useful by three people I am loath to delete it, but the answer above is IMHO better.)
If you attempt to open a non-existing file and assign the channel identifier to a variable, an error is raised and the contents of the variable are unchanged. If the variable didn't exist, it won't be created by the set command. So while there is no null value, you can either 1) set the variable to a value you know isn't a channel identifier before opening the file:
set fh {} ;# no channel identifier is the empty string
set fh [open foo.bar]
if {$fh eq {}} {
puts "Nope, file wasn't opened."
}
or 2) unset the variable and test it for existence afterwards (use catch to handle the error that is raised if the variable didn't exist):
catch {unset fh}
set fh [open foo.bar]
if {![info exists fh]} {
puts "Nope, file wasn't opened."
}
If you want to test if a file exists, the easiest way is to use the file exists command:
file exists $file_name
if {![file exists $file_name]} {
puts "No such file"
}
Documentation: catch, file, if, open, puts, set, unset

Procedure tracking in log with proc renaiming

I have a custom test tool written in tcl and bash (mainly in tcl, some initial config and check were done by bash). It isn't have an exact starting point, the outside bash (and sometimes the application which is tested) call specific functions which they find with a "tclIndex" file, created by auto_mkindex.
This tool create a log file, with many "puts" function, which is directed to the file location.
Most of the functions have a "trackBegin" function call at the beginning, and one "trackEnd" function at the end of it. These two get the functions name as parameter. This help us to track where is the problem.
Sadly, this tracker was forgotten in some modification in the near past, and its not even too reliable because its not going to track if there is any abnormal exit in the function. Now, i tried to remove all of them, and create a renamed _proc to override the original and place this two tracker before and after the execution of the function itself.
But i have a lots of error (some i solved, but i dont know its the best way, some are not solved at all, so i'm stuck), these are the main ones:
Because there is no exact entry point, where should i define and how, this overrided proc, to work on all of the procedures in this execution? Some of my files had to be manually modified to _proc to work (mostly the ones where there are code outside the procedures and these files as scripts were called, not functions through the tclIndex, the function called ones are all in a utils folder, and only there, maybe it can help).
In the tracker line i placed a "clock" with format, and its always cause abnormal exit.
I had problems with the returned values (if there was one, and some time when there isn't). Even when that was a return, or Exit.
So my question is in short:
How can i solve an overrided proc function, which will write into a logfile a "begin" and "end" block before and after the procedure itself (The log file location was gained from the bash side of this tool), when there is no clear entry point in this tool for the tcl side, and use an auto_mkindex generated procedure index file?
Thanks,
Roland.
Untested
Assuming your bash script does something like
tclsh file.tcl
You could do
tclsh instrumented.tcl file.tcl
where instrumented.tcl would contain
proc trackBegin {name} {...}
proc trackEnd {name output info} {...}
rename proc _proc
_proc proc {name args body} {
set new_body [format {
trackBegin %s
catch {%s} output info
trackEnd %s $output $info
} $name $body $name]
_proc $name $args $new_body
}
source [lindex $argv 0]
See the return and catch pages for what to do with the info dictionary.
You'll have to show us some of your code to provide more specific help, particularly for your clock error.
I'd be tempted to use execution tracing for this, with the addition of the execution tracing being done in an execution trace on proc (after all, it's just a regular Tcl command). In particular, we can do this:
proc addTracking {cmd args} {
set procName [lindex $cmd 1]
uplevel 1 [list trace add execution $procName enter [list trackBegin $procName]]
uplevel 1 [list trace add execution $procName leave [list trackEnd $procName]]
}
proc trackBegin {name arguments operation} {
# ignore operation, arguments might be interesting
...
}
proc trackEnd {name arguments code output operation} {
# ignore operation, arguments might be interesting
...
}
trace add execution proc leave addTracking
It doesn't give you quite the same information, but it does allow you to staple code around the outside non-invasively.

In Tcl, what is the equivalent of "set -e" in bash?

Is there a convenient way to specify in a Tcl script to immediately exit in case any error happens? Anything similar to set -e in bash?
EDIT I'm using a software that implements Tcl as its scripting language. If for example I run the package parseSomeFile fname, if the file fname does't exist, it reports it but the script execution continues. Is there a way that I stop the script there?
It's usually not needed; a command fails by throwing an error which makes the script exit with an informative message if not caught (well, depending on the host program: that's tclsh's behavior). Still, if you need to really exit immediately, you can hurry things along by putting a trace on the global variable that collects error traces:
trace add variable ::errorInfo write {puts stderr $::errorInfo;exit 1;list}
(The list at the end just traps the trace arguments so that they get ignored.)
Doing this is not recommended. Existing Tcl code, including all packages you might be using, assumes that it can catch errors and do something to handle them.
In Tcl, if you run into an error, the script will exit immediately unless you catch it. That means you don't need to specify the like of set -e.
Update
Ideally, parseSomeFile should have return an error, but looks like it does not. If you have control over it, fix it to return an error:
proc parseSomeFile {filename} {
if {![file exists $filename]} {
return -code error "ERROR: $filename does not exists"
}
# Do the parsing
return 1
}
# Demo 1: parse existing file
parseSomeFile foo
# Demo 2: parse non-existing file
parseSomeFile bar
The second option is to check for file existence before calling parseSomeFile.