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.
Related
I wonder if there are possible to check what interpreter ran (procs\commands) during execution? In order in which they were running?
Background: I need to see how the script works and put some (my)code in a particular place.
You want an execution trace. In particular, the enterstep mode will give you a callback on each command being called (at some considerable performance hit) and the leavestep mode will allow you to also see the result of that command (many commands have an empty result).
A place to get started with them is by making a wrapper script that puts the trace on source and then sourceing your main script.
proc DebugStepTrace {command op args} {
puts "ENTER: $command"
}
trace add execution source enterstep DebugStepTrace
source main.tcl
In almost all practical code, that will produce a vast amount of output. In particular, you'll probably be overwhelmed by all the proc calls. Let's do a more subtle tracer that hides some information so you can look at the bigger picture.
proc DebugStepTrace {command op args} {
set trimmed [regsub {\n.*} $command "..."]
puts "ENTER: $trimmed"
}
# Apply this procedure to [source] as above, of course
You can also use info script in a procedure (not usually recommended, but right in this case) and info frame to get more information:
proc DebugStepTrace {command op args} {
# Trim off everything after the first newline for sanity
set trimmed [regsub {\n.*} $command "..."]
# Basic guess at extended info
set filename [file tail [info script]]
set line 0
# May have better information in the frame
set frame [info frame -2]
if {[dict exists $frame file]} {
set filename [file tail [dict get $frame file]]
set line [dict get $frame line]
}
# Print what we've discovered
puts "ENTER:${filename}:${line}:$trimmed"
}
info frame is a bit tricky to use, requiring both experimentation to get the right level selector and care because the interesting keys in the resulting dictionary (typically file and line for code location info) aren't guaranteed to be there if there's “clever” code generation games being played.
In a highly event-driven Tk application this probably won't be enough; you may well need to add traces to procedures so that you also follow callbacks. Or you can change the way you apply the trace so that you've got them enabled during Tk callback processing as well:
trace add execution source enterstep DebugStepTrace
trace add execution tkwait enterstep DebugStepTrace
source main.tcl
tkwait window .
That tkwait window call is basically what wish does for you after running the script you specify. We do it explicitly so that we can trace what happens while it is running.
I'm trying to create some read-only variables to use with code evaluated in a safe interp. Using trace, I can generate an error on attempts to set them, but not when using unset:
% set foo bar
bar
% trace add variable foo {unset write} {apply {{var _ op} { error "$var $op trace triggered" }}}
% set foo bar
can't set "foo": foo write trace triggered
% unset foo
%
Indeed, I eventually noticed the documentation even says in passing:
Any errors in unset traces are ignored.
Playing around with different return codes, including custom numbers, they all seem to be ignored. It doesn't trigger an interp bgerror handler either. Is there any other way to raise an error for an attempt to unset a particular variable?
There really isn't. The key problem is that there are times when Tcl is going to unset a variable when that variable really is going to be deleted because its containing structure (a namespace, stack frame or object, and ultimately an interpreter) is also being deleted. The variable is doomed at that point and user code cannot prevent it (except by the horrible approach of never returning from the trace, of course, which infinitely postpones the death and puts everything in a weird state; don't do that). There's simply nowhere to resurrect the variable to. Command deletion traces have the same issue; they too can be firing because their storage is vanishing. (TclOO destructors are a bit more protected against this; they try to not lose errors — there's even pitching them into interp bgerror as a last resort — but still can in some edge cases.)
What's more, there's currently nothing in the API to allow an error message to bubble out of the process of deleting a namespace or call frame. I think that would be fixable (it would require changing some public APIs) but for good reasons I think the deletion would still have to happen, especially for stack frames. Additionally, I'm not sure what should happen when you delete a namespace containing two unset-traced variables whose traces both report errors. What should the error be? I really don't know. (I know that the end result has to be that the namespace is still gone, FWIW, but the details matter and I have no idea what they should be.)
I'm trying to create some read-only variables to use with code evaluated
Schelte and Donal have already offered timely and in-depth feedback. So what comes is meant as a humble addition. Now that one knows that there variables traces are executed after the fact, the below is how I use to mimick read-only (or rather keep-re_setting-to-a-one-time-value) variables using traces (note: as Donal explains, this does not extend to proc-local variables).
The below implementation allows for the following:
namespace eval ::ns2 {}
namespace eval ::ns1 {
readOnly foo 1
readOnly ::ns2::bar 2
readOnly ::faz 3
}
Inspired by variable, but only for one variable-value pair.
proc ::readOnly {var val} {
uplevel [list variable $var $val]
if {![string match "::*" $var]} {
set var [uplevel [list namespace which -variable $var]]
}
# only proceed iff namespace is not under deletion!
if {[namespace exists [namespace qualifiers $var]]} {
set readOnlyHandler {{var val _ _ op} {
if {[namespace exists [namespace qualifiers $var]]} {
if {$op eq "unset"} {
::readOnly $var $val
} else {
set $var $val
}
# optional: use stderr as err-signalling channel?
puts stderr [list $var is read-only]
}
}}
set handlerScript [list apply $readOnlyHandler $var $val]
set traces [trace info variable $var]
set varTrace [list {write unset} $handlerScript]
if {![llength $traces] || $varTrace ni $traces} {
trace add variable $var {*}$varTrace
}
}
}
Some notes:
This is meant to work only for global or otherwise namespaced variables, not for proc-local ones;
It wraps around variable;
[namespace exists ...]: These guards protect from operations when a given parent namespace is currently under deletion (namespace delete ::ns1, or child interp deletion);
In the unset case, the handler script re-adds the trace on the well re-created variable (otherwise, any subsequent write would not be caught anymore.);
[trace info variable ...]: Helps avoid adding redundant traces;
[namespace which -variable]: Makes sure to work on a fully-qualified variable name;
Some final remarks:
Ooo, maybe I can substitute the normal unset for a custom version and
do the checking in it instead of relying on trace
Certainly one option, but it does not give you coverage of the various (indirect) paths of unsetting a variable.
[...] in a safe interp.
You may want to interp alias between a variable in your safe interp to the above readOnly in the parent interp?
Is it possible to pass between TCL threads (created with TCL command - thread::create) commands created in C (i.e. with Tcl_CreateObjCommand) and how?
Thanks.
All Tcl commands are always coupled to a specific interpreter, the interpreter passed to Tcl_CreateObjCommand as its first parameter, and Tcl interpreters are strictly bound to threads (because the Tcl implementation uses quite a few thread-specific variables internally in order to reduce the number of global locks). Instead, the implementation coordinates between threads by means of messages; the most common sort of message is “here is a Tcl script to run for me” and “here are the results of running that script” though there are others.
So no, Tcl commands can't be shared between threads. If you've written the code for them right (often by avoiding globals or adding in appropriate locks) you can use the same command implementation in multiple interpreters in multiple threads, but they're not technically the same command, but rather just look the same at first glance. For example, if you put a trace on the command in one thread, that'll only get its callbacks invoked in that one interpreter, not from any other interpreter that has a command with the same implementation and with the same name.
You can make a delegate command in the other threads that asks the main thread to run the command and send you the results back.
package require Thread
# This procedure makes delegates; this is a little messy...
proc threadDelegateCommand {thread_id command_name} {
# Relies on thread IDs always being “nice” words, which they are
thread::send $thread_id [list proc $command_name args "
thread::send [thread::id] \[list [list $command_name] {*}\$args\]
"]
}
# A very silly example; use your code here instead
proc theExampleCommand {args} {
puts "This is in [thread::id] and has [llength $args] arguments: [join $args ,]"
return [tcl::mathop::+ {*}$args]
}
# Make the thread
set tid [thread::create]
puts "This is [thread::id] and $tid has just been created"
# Make the delegate for our example
threadDelegateCommand $tid theExampleCommand
# Show normal execution in the other thread
puts [thread::send $tid {format "This is %s" [thread::id]}]
# Show that our delegate can call back. IMPORTANT! Note that we're using an asynchronous
# send here to avoid a deadlock due to the callbacks involved.
thread::send -async $tid {
after 5000
theExampleCommand 5 4 3 2 1
} foo
vwait foo
I want to create a tcl proc/ command like
[1] should return 1
[2] should return 2
.
.
[18999] should return 18999
How i should write one proc to handle all the number commands
This is very much not recommended! Also, you can't really make a single command to do all of this. However, the easiest method is to update the unknown procedure to create the commands you need on demand. Patching unknown needs a little care.
proc unknown args [concat {
if {[llength $args] == 1 && [string is entier -strict [lindex $args 0]]} {
set TheNumber [lindex $args 0]
proc ::$TheNumber {} [list return $TheNumber]
return $TheNumber
# The semicolon on the next line is required because of the [concat]
};
} [info body unknown]]
This will make trivial procedures on demand as long as their names look exactly like (full, extended) integers. (Supporting floats as well isn't too hard; it'd just be a matter of writing a slightly more complex test that also uses string is double.)
But be aware that unknown command handling is a slow way to do this; it's the mechanism that Tcl invokes immediately before it would otherwise have to throw an error because a command doesn't exist. We could have made it just return the value directly without creating the procedure, but then every time you called this you'd have the overhead of the unsuccessful search; making the procedures speeds things up.
Not using numbers as commands at all will speed your code up even more.
I want to find a way to return the name of a library of a certain path in a VHDL Design in Modelsim.
Given a VHDL Design with a path like "/mega_tb/D0". This is compiled in a library that is NOT 'work', say "libnwork".
I can of course take a look in my 'do' file to get the correct lib name. Or I can search in ModelSim's Library tab. But I want to have or create a modelsim command which I can later use in a Tcl script, to get the correct library name.
One of the easiest ways to find something in a Tcl script file – which is all a Modelsim “do” file is — is to evaluate it. Tcl's very good at that. Of course, you don't want to have the commands do all the conventional things. Instead, we'll evaluate in a context where we can make everything do nothing except for the command that produces the information we want:
# Set up our evaluation context, 'worker'
interp create worker -safe
interp eval worker {proc unknown args {}}; # Our do-nothing handler
interp alias worker theInterestingCommand {} ourHandler
proc ourHandler args {
puts "We were called with: $args"
}
# Parse the file!
set f [open /the/file.tcl]
interp eval worker [read $f]
# Clean up
close $f
interp delete worker
Now you just have to make theInterestingCommand have the right name and extract the interesting information from the arguments. Which should be relatively easy…
Te only way I've found is to use the command
write report -tcl
This prints a long list where I have search for the lib names with regexps.
Something like
set data [ write report -tcl]
foreach_regexp { _ type lib entity} $data{
if {$type == "Entity" && $entity == [entity_of_path /mega_tb/D0] } {
....
}
}
Where I of course had to define my "foreach_regexp" procedure and my "entity_of_path" procedure. I then can use something like regsub to extract the library name.
I am still looking for a better and easier way.