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
Related
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"
I need to get invocation line number of tcl proc inside it’s body.
Starting from 8.5 tcl have info frame command which allows following:
proc printLine {} {
set lineNum [dict get [info frame 1] line]
}
I need the same for 8.4
It's not available in 8.4; the data wasn't collected at all. I guess you could search for a unique token in the line, but that'd be about all.
proc lineNumber {uniqueToken} {
set name [lindex [info level 1] 0]
set body [uplevel 2 [list info body $name]]
set num 0
foreach line [split $body \n] {
incr num
if {[string first $uniqueToken $line] >= 0} {
return $num
}
}
error "could not find token '$uniqueToken'"
}
Note that 8.4 is not supported any more. Upgrade.
I'm using tcl 8.5, but it should work on version 8.4. here is:
#!/usr/bin/tclsh
puts "tcl version: $tcl_version"
proc linum {} {
if {![string equal -nocase precompiled [lindex [info frame -1] 1]]} {
return [lindex [info frame -1] 3]
} else {
return Unknown
}
}
puts "call proc #line:[linum]"
and the result is:
tcl version: 8.5
call proc #line:13
you can reference info frame for more details
I have a file like this:
set position {0.50 0.50}
set visibility false
set text {ID: {entity.id}\n Value: {entity.contour_val}}
And I want to do something similar to source, but I want to use a file handle only.
My current attempt looks like this:
proc readArray {fileHandle arrayName} {
upvar $arrayName arr
set cl 0
while {! [eof $fileHandle]} {
set cl [expr "$cl + 1"]
set line [gets $fileHandle]
if [$line eq {}] continue
puts $line
namespace eval ::__esg_priv "
uplevel 1 {*}$line
"
info vars ::__esg_priv::*
foreach varPath [info vars ::__esg_priv::*] {
set varName [string map { ::__esg_priv:: "" } $varPath]
puts "Setting arr($varName) -> [set $varPath]"
set arr($varName) [set $varPath]
}
namespace delete __esg_priv
}
puts "$cl number of lines read"
}
In place of uplevel I tried many combinations of eval and quoting.
My problem is, it either fails on the lines with lists or it does not actuall set the variables.
What is the right way to do it, if the executed commands are expected to be any valid code.
An extra question would be how to properly apply error checking, which I haven't tried yet.
After a call to
readArray [open "myFile.tcl" r] arr
I expect that
parray arr
issues something like:
arr(position) = 0.50 0.50
arr(text) = ID: {entity.id}\n Value: {entity.contour_val}
arr(visibility) = false
BTW: The last line contains internal {}, which are supposed to make it into the string variables. And there is no intent to make this a dict.
This code works, but there are still some problems with it:
proc readArray {fileHandle arrayName} {
upvar $arrayName arr
set cl 0
while {! [eof $fileHandle]} {
incr cl ;# !
set line [gets $fileHandle]
if {$line eq {}} continue ;# !
puts $line
namespace eval ::__esg_priv $line ;# !
foreach varPath [info vars ::__esg_priv::*] {
set varName [string map { ::__esg_priv:: "" } $varPath]
puts "Setting arr($varName) -> [set $varPath]"
set arr($varName) [set $varPath]
}
namespace delete __esg_priv
}
puts "$cl number of lines read"
}
I've taken out a couple of lines that didn't seem necessary, and changed some lines a bit.
You don't need set cl [expr "$cl + 1"]: incr cl will do.
if [$line eq {}] continue will fail because the [...] is a command substitution. if {$line eq {}} continue (braces instead of brackets) does what you intend.
Unless you are accessing variables in another scope, you won't need uplevel. namespace eval ::__esg_priv $line will evaluate one line in the designated namespace.
I didn't change the following, but maybe you should:
set varName [string map { ::__esg_priv:: "" } $varPath] works as intended, but set varName [namespace tail $varPath] is cleaner.
Be aware that if there exists a global variable with the same name as one of the variables in your file, no namespace variable will be created; the global variable will be updated instead.
If you intend to use the value in the text variable as a dictionary, you need to remove either the \n or the braces.
According to your question title, you want to evaluate the file line by line. If that requirement can be lifted, your code could be simplified by reading the whole script in one operation and then evaluating it with a single namespace eval.
ETA
This solution is a lot more robust in that it reads the script in a sandbox (always a good idea when writing code that will execute arbitrary external code) and redefines (within that sandbox) the set command to create members in your array instead of regular variables.
proc readArray {fileHandle arrayName} {
upvar 1 $arrayName arr
set int [interp create -safe]
$int alias set apply {{name value} {
uplevel 1 [list set arr($name) $value]
}}
$int eval [read $fileHandle]
interp delete $int
}
To make it even more safe against unexpected interaction with global variables etc, look at the interp package in the Tcllib. It lets you create an interpreter that is completely empty.
Documentation: apply, continue, eof, foreach, gets, if, incr, info, interp package, interp, list, namespace, proc, puts, set, string, uplevel, upvar, while
Im searching all over the internet , i guess im searching not the right keywords
i tried most of them :)
i want to create in tcl/bash a proc with hyphen flags to get arguments with flags from the user
ex.
proc_name -color red -somethingselse black
It's very easy to do, actually. This code allows abbreviated option names, flag options (-quxwoo in the example) and the ability to stop reading options either with a -- token or with a non-option argument appearing. In the example, unknown option names raise errors. After passing the option-parsing loop, args contains the remaining command-line arguments (not including the -- token if it was used).
proc foo args {
array set options {-bargle {} -bazout vampires -quxwoo 0}
while {[llength $args]} {
switch -glob -- [lindex $args 0] {
-bar* {set args [lassign $args - options(-bargle)]}
-baz* {set args [lassign $args - options(-bazout)]}
-qux* {set options(-quxwoo) 1 ; set args [lrange $args 1 end]}
-- {set args [lrange $args 1 end] ; break}
-* {error "unknown option [lindex $args 0]"}
default break
}
}
puts "options: [array get options]"
puts "other args: $args"
}
foo -barg 94 -quxwoo -- abc def
# => options: -quxwoo 1 -bazout vampires -bargle 94
# => other args: abc def
This is how it works. First set default values for the options:
array set options {-bargle {} -bazout vampires -quxwoo 0}
Then enter a loop that processes the arguments, if there are any (left).
while {[llength $args]} {
During each iteration, look at the first element in the argument list:
switch -glob -- [lindex $args 0] {
String-match ("glob") matching is used to make it possible to have abbreviated option names.
If a value option is found, use lassign to copy the value to the corresponding member of the options array and to remove the first two elements in the argument list.
-bar* {set args [lassign $args - options(-bargle)]}
If a flag option is found, set the corresponding member of the options array to 1 and remove the first element in the argument list.
-qux* {set options(-quxwoo) 1 ; set args [lrange $args 1 end]}
If the special -- token is found, remove it from the argument list and exit the option-processing loop.
-- {set args [lrange $args 1 end] ; break}
If an option name is found that hasn't already been dealt with, raise an error.
-* {error "unknown option [lindex $args 0]"}
If the first argument doesn't match any of the above, we seem to have run out of option arguments: just exit the loop.
default break
Documentation: array, break, error, lassign, lindex, llength, proc, puts, set, switch, while
With array set, we can assign the parameters and their values into an array.
proc getInfo {args} {
# Assigning key-value pair into array
# If odd number of arguments passed, then it should throw error
if {[catch {array set aInfo $args} msg]} {
return $msg
}
parray aInfo; # Just printing for your info
}
puts [getInfo -name Dinesh -age 25 -id 974155]
will produce the following output
aInfo(-age) = 25
aInfo(-id) = 974155
aInfo(-name) = Dinesh
The usual way to handle this in Tcl is by slurping the values into an array or dictionary and then picking them out of that. It doesn't offer the greatest amount of error checking, but it's so easy to get working.
proc myExample args {
# Set the defaults
array set options {-foo 0 -bar "xyz"}
# Read in the arguments
array set options $args
# Use them
puts "the foo option is $options(-foo) and the bar option is $options(-bar)"
}
myExample -bar abc -foo [expr {1+2+3}]
# the foo option is 6 and the bar option is abc
Doing error checking takes more effort. Here's a simple version
proc myExample args {
array set options {-foo 0 -bar "xyz"}
if {[llength $args] & 1} {
return -code error "must have even number of arguments in opt/val pairs"
}
foreach {opt val} $args {
if {![info exist options($opt)]} {
return -code error "unknown option \"$opt\""
}
set options($opt) $val
}
# As before...
puts "the foo option is $options(-foo) and the bar option is $options(-bar)"
}
myExample -bar abc -foo [expr {1+2+3}]
# the foo option is 6 and the bar option is abc
# And here are the errors it spits out...
myExample -spregr sgkjfd
# unknown option "-spregr"
myExample -foo
# must have even number of arguments in opt/val pairs
#flag defaults
set level 1
set inst ""
# Parse Flags
while {[llength $args]} {
set flag [lindex $args 0]
#puts "flag: ($flag)"
switch -glob $flag {
-level {
set level [lindex $args 1]
set args [lrange $args 2 end]
puts "level:($level) args($args)"
} -inst {
set autoname 0
set inst [lindex $args 1]
set args [lrange $args 2 end]
puts "inst:($inst) args($args)"
} -h* {
#help
puts "USAGE:"
exit 1
} -* {
# unknown option
error "unknown option [lindex $args 0]"
} default break
}
}
# remaining arguments
set filename "$args"
puts "filename: $args"
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