The script have sourced N number of files..,
source file 1
source file 2
.
.
source file N
when particular procedure A called ., Its actually present in most of the sourced files., anyway the last sourced file containing that proc A will do the function.,
how to find which file containing the proc is used when i call the proc ?
Any code i can use to achieve it ?
The simplest way (assuming Tcl 8.5 or 8.6) is to use an execution trace to call info frame to get the details of the call stack.
trace add execution A enter callingA
proc callingA args {
set ctxt [info frame -1]
if {[dict exists $ctxt file] && [dict exists $ctxt proc]} {
puts "Called [lindex $args 0 0] from [dict get $ctxt proc] in [dict get $ctxt file]"
} elseif {[dict exists $ctxt proc]} {
puts "Called [lindex $args 0 0] from [dict get $ctxt proc] (unknown location)"
} else {
# Fallback
puts "Called [lindex $args 0 0] from within [file normalize [info script]]"
}
}
There's quite a bit of other information in the dictionary returned by info frame.
For Tcl 8.4
In Tcl 8.4, you don't have info frame and Tcl doesn't remember where procedures are defined by default. You still have execution traces though (they were a new feature of Tcl 8.4) so that's OK then. (We have to be a bit careful with info script as that's only valid during the source and not after it finishes; procedures tend to be called later.)
To get where every procedure is defined, you have to intercept proc itself, and to do so early in your script execution! (Procedures defined before you set up the interceptor aren't noticed; Tcl's semantics are purely operational.) Fortunately, you can use an execution trace for this.
proc procCalled {cmd code args} {
if {$code==0} {
global procInFile
set procName [uplevel 1 [list namespace which [lindex $cmd 1]]]
set procInFile($procName) [file normalize [info script]]
}
}
# We use a leave trace for maximum correctness
trace add execution proc leave procCalled
Then, you use another execution trace on the command that you want to know the callers of to look up what that command is called, and hence where it was defined.
proc callingA args {
# Wrap in a catch so a lookup failure doesn't cause problems
if {[catch {
set caller [lindex [info level -1] 0]
global procInFile
set file $procInFile($caller)
puts "Calling [lindex $args 0 0] from $caller in $file"
}]} {
# Not called from procedure!
puts "Calling [lindex $args 0 0] from within [file normalize [info script]]"
}
}
trace add execution A enter callingA
Related
I was wondering how you would find the name of the test you're running in tcl from the test itself? I couldn't find this on google.
I'm calling another proc and passing the name of the test that is calling it, as an argument. So I would like to know which tcl command can do that for me.
This isn't an encouraged use case… but you can use info frame 1 to get the information if you use it directly inside the test.
proc example {contextTest} {
puts "Called from $contextTest"
return ok
}
tcltest::test foo-1.1 {testing the foo} {
example [lindex [dict get [info frame 1] cmd] 1]
} ok
This assumes that you're using Tcl 8.5 or later, but Tcl 8.5 is the oldest currently-supported Tcl version so that's a reasonable restriction.
I read your comments ("source ... instade of my test name") as follows: You seem to source the Tcl script file containing the tests (and Donal's instrumented tcltest), rather than batch-running the script from the command line: tclsh /path/to/your/file.tcl In this setting, there will be an extra ("eval") stack frame which distorts introspection.
To turn Donal's instrumentation more robust, I suggest actually walking the Tcl stack and watching out for a valid tcltest frame. This could look as follows:
package req tcltest
proc example {} {
for {set i 1} {$i<=[info frame]} {incr i} {
set frameInfo [info frame $i]
set frameType [dict get $frameInfo type]
set cmd [dict get $frameInfo cmd]
if {$frameType eq "source" && [lindex $cmd 0] eq "tcltest::test"} {
puts "Called from [lindex $cmd 1]"
return ok
}
}
return notok
}
tcltest::test foo-1.1 {testing the foo} {
example
} ok
This will return "Called from foo-1.1" both, when called as:
$ tclsh test.tcl
Called from foo-1.1
and
$ tclsh
% source test.tcl
Called from foo-1.1
% exit
The Tcl version used (8.5, 8.6) is not relevant. However, your are advised to upgrade to 8.6, 8.5 has reached its end of life.
I'm trying to run proc with new process
I'm trying to call proc1 and proc2 from main function , but each should run separately with a new process (or subprocess) and also wait till it finish
proc main { var } {
puts "main function with var: $var"
#call proc1 with new process
exec proc1 1
#wait till proc1 finish
#call proc2 with new process
exec proc2 2
#wait till proc2 finish
puts "Finished"
}
proc proc1 { var1 } {
puts "proc1 function with var: $var1"
}
proc proc2 { var2 } {
puts "proc2 function with var: $var2"
}
I tried using exec but it did not work
I tried googling it, but did not succeed to find a solution
How can I make it run ?
Thanks a lot!
The simplest mechanism is to put the procedures in a separate file (e.g., myprocs.tcl) with the following bit of extra code at the end of the file:
# Take a command from stdin, evaluate it, and write result to stdout
puts [eval [read stdin]]
Then you call those procedures using the following helper:
proc runproc {procname args} {
exec [info nameofexecutable] myprocs.tcl << [list $procname {*}$args] 2>#stderr
}
# Demonstrating
set result [runproc proc1 1]
The above isn't the most robust mechanism however. In particular, if you have a bug in your procedures, things will go quite wonky. Here's a more robust mechanism that works very well provided you change your procedures to return their results instead of putsing them:
Callee side:
set cmd [read stdin]
catch $cmd msg opts
puts [list $msg $opts]
exit
Caller side:
proc runproc {procname args} {
set cmd [list $procname {*}$args]
set pair [exec [info nameofexecutable] myprocs.tcl << $cmd 2>#stderr]
lassign $pair msg opts
return -options $opts $msg
}
Transferring a normal stdout across at the same time, or allowing the subprocess to access the caller's stdin, requires more work again to move the command-and-control channel to be other than a standard pipe, and the above is good enough for a lot of things.
how to print the line number of executing TCL script?
#! /usr/bin/tclsh
set a "100"
set b "200"
set c [expr $a + $b]
puts [info script] ;# it will display the script name which it is executing.
# similarly I need to print the script line number.
puts $c
You have to use info frame to get this done simply.
info frame ?number?
This command provides access to all frames on the stack, even those hidden from info level. If number is not specified, this command returns a number giving the frame level of the command. This is 1 if the command is invoked at top-level. If number is specified, then the result is a dictionary containing the location information for the command at the numbered level on the stack.
If number is positive (> 0) then it selects a particular stack level (1 refers to the top-most active command, i.e., info frame itself, 2 to the command it was called from, and so on); otherwise it gives a level relative to the current command (0 refers to the current command, i.e., info frame itself, -1 to its caller, and so on).
We are going to make use of the dictionary returned by the info frame command. One of the key is 'line' which contains the line number of the script.
Have a simple proc as,
proc printLine {frame_info} {
# Getting value of the key 'line' from the dictionary
# returned by 'info frame'
set result [dict get [info frame $frame_info] line]
}
In general, the resulting dictionary from [info frame $frame_info] will be something like,
type source line 17 file /home/dinesh/stackoverflow/test cmd {printLine [info frame] } proc ::B level 1
From this, we are just getting the key value 'line' with dict get
Just call this proc with the current frame number of that context which can be achieved with info frame itself.
i.e.
set lineNumber [printLine [info frame]]; #Place this line in your code.
A demonstration of this logic is as below.
printLineNumber.tcl
#!/usr/bin/tclsh
proc printLine {frame_info} {
# Getting value of the key 'line' from the dictionary
# returned by 'info frame'
set result [dict get [info frame $frame_info] line]
}
proc D {} {
puts "proc D"
puts [ printLine [info frame] ]
}
proc C {} {
puts "proc C"
puts [ printLine [info frame] ]
D
}
proc B {} {
puts "proc B"
puts [ printLine [info frame] ]
C
}
proc A {} {
puts "proc A"
puts [ printLine [info frame] ]
B
}
puts "Global"
puts [ printLine [info frame] ]
A
Documentation : info, dict
Is there any way to list all the procedures(proc) in a myFile.tcl using another tcl file or in the same file.
You can use [info procs] before and after sourcing the file in question and compare the results to determine which procs were added. For example:
proc diff {before after} {
set result [list]
foreach name $before {
set procs($name) 1
}
foreach name $after {
if { ![info exists procs($name)] } {
lappend result $name
}
}
return [lsort $result]
}
set __before [info procs]
source myFile.tcl
set __after [info procs]
puts "Added procs: [diff $__before $__after]"
One thing I like about this solution is that the diff procedure is really just a generic set differencing utility -- it's not specific to comparing lists of defined procedures.
The cheapest way is to just open the file and use regexp to pick out the names. It's not perfectly accurate, but it does a reasonably good job.
set f [open "sourcefile.tcl"]
set data [read $f]
close $f
foreach {dummy procName} [regexp -all -inline -line {^[\s:]*proc (\S+)} $data] {
puts "Found procedure $procName"
}
Does it deal with all cases? No. Does it deal with a useful subset? Yes. Is the subset large enough for you? Quite possibly.
Yes it is, although not that easy. The basic idea is to source the file in a modified slave interp that only executes some commands:
proc proc_handler {name arguments body} {
puts $name
}
set i [interp create -safe]
interp eval $i {proc unknown args {}}
interp alias $i proc {} proc_handler
interp invokehidden source yourfile.tcl
This approach will fail if the file requires other packages (package require will not work), relies on the result of some usually auto_load'ed commands etc..
It also does not take namespaces into account. (namespace eval ::foo {proc bar a {}} creates a proc with the name ::foo::bar
For a more complex implementation you could look into auto.tcl's auto_mkindex, which has a similar goal.
Here is a different approach:
Create a temporary namespace
Source (include) the script in question, then
Use the info procs command to get a list of procs
Delete the temporary namespace upon finish
Here is my script, *list_procs.tcl*:
#!/usr/bin/env tclsh
# Script to scan a Tcl script and list all the procs
proc listProcsFromFile {fileName} {
namespace eval TempNamespace {
source $fileName
set procsList [info procs]
}
set result $::TempNamespace::procsList
namespace delete TempNamespace
return $result
}
set fileName [lindex $::argv 0]
set procsList [listProcsFromFile $fileName]
puts "File $fileName contains the following procs: $procsList"
For example, if you have the following script, procs.tcl:
proc foo {a b c} {}
proc bar {a} {}
Then running the script will produce:
$ tclsh list_procs.tcl procs.tcl
File procs.tcl contains the following procs: foo bar
I have implemented many TCL extensions for a specific tool in the domain of formal methods (extensions are implemented in C but I do not want solution to rely on this fact). Thus, the users of my tool can use TCL for prototyping algorithms. Many of them are just linear list of commands (they are powerfull), e.g.:
my_read_file f
my_do_something a b c
my_do_something_else a b c
Now, I am interested in timing. It is possible to change the script to get:
puts [time [my_read_file f] 1]
puts [time [my_do_something a b c] 1]
puts [time [my_do_something_else a b c] 1]
Instead of this I want to define procedure xsource that executes a TCL script and get/write timing for all my commands. Some kind of a profiler. I wrote a naive implementation where the main idea is as follows:
set f [open [lindex $argv 0] r]
set inputLine ""
while {[gets $f line] >= 0} {
set d [expr [string length $line] - 1]
if { $d >= 0 } {
if { [string index $line 0] != "#" } {
if {[string index $line $d] == "\\"} {
set inputLine "$inputLine [string trimright [string range $line 0 [expr $d - 1]]]"
} else {
set inputLine "$inputLine $line"
set inputLine [string trimleft $inputLine]
puts $inputLine
puts [time {eval $inputLine} 1]
}
set inputLine ""
}
}
}
It works for linear list of commands and even allows comments and commands over multiple lines. But it fails if the user uses if statements, loops, and definition of procedures. Can you propose a better approach? It must be pure TCL script with as few extensions as possible.
One way of doing what you're asking for is to use execution traces. Here's a script that can do just that:
package require Tcl 8.5
# The machinery for tracking command execution times; prints the time taken
# upon termination of the command. More info is available too (e.g., did the
# command have an exception) but isn't printed here.
variable timerStack {}
proc timerEnter {cmd op} {
variable timerStack
lappend timerStack [clock microseconds]
}
proc timerLeave {cmd code result op} {
variable timerStack
set now [clock microseconds]
set then [lindex $timerStack end]
set timerStack [lrange $timerStack 0 end-1]
# Remove this length check to print everything out; could be a lot!
# Alternatively, modify the comparison to print more stack frames.
if {[llength $timerStack] < 1} {
puts "[expr {$now-$then}]: $cmd"
}
}
# Add the magic!
trace add execution source enterstep timerEnter
trace add execution source leavestep timerLeave
# And invoke the magic, magically
source [set argv [lassign $argv argv0];set argv0]
# Alternatively, if you don't want argument rewriting, just do:
# source yourScript.tcl
Then you'd call it like this (assuming you've put it in a file called timer.tcl):
tclsh8.5 timer.tcl yourScript.tcl
Be aware that this script has a considerable amount of overhead, as it inhibits many optimization strategies that are normally used. That won't matter too much for uses where you're doing the real meat in your own C code, but when it's lots of loops in Tcl then you'll notice a lot.
You can wrap your commands which you want to measure. And name wrappers exactly as the original ones (renaming original procs before). After that, when instrumented command is executed it actually executes the wrapper, which executes the original procedure and measure the time of execution. The example below (Tcl 8.5).
proc instrument {procs} {
set skip_procs {proc rename instrument puts time subst uplevel return}
foreach p $procs {
if {$p ni $skip_procs} {
uplevel [subst -nocommands {
rename $p __$p
proc $p {args} {
puts "$p: [time {set r [__$p {*}\$args]}]"
return \$r
}
}]
}
}
}
proc my_proc {a} {
set r 1
for {set i 1} {$i <= $a} {incr i} {
set r [expr {$r * $i}]
}
return $r
}
proc my_another_proc {a b} {
set r 0
for {set i $a} {$i <= $b} {incr i} {
incr r $i
}
return $r
}
instrument [info commands my_*]
puts "100 = [my_proc 100]"
puts "200 = [my_proc 100]"
puts "100 - 200 = [my_another_proc 100 200]"
You might want to look at the command "info complete". It can tell you if what you have accumulated so far looks complete from the point of view of most common Tcl syntax markers. It will deal with command input that might be spread across multiple physical lines.