Attachment "Tcl_Obj.leaks" to
ticket [989093ffff]
added by
mistachkin
2004-07-12 05:48:19.
active 80e8ca0 1 2 @ ./../generic/tclLiteral.c 270 - none -- !!
active 80f10a0 1 5 @ ./../generic/tclLiteral.c 270 - cmdName -- lsort
active 80e45a0 1 5 @ ./../generic/tclLiteral.c 270 - none -- range
active 80e0e20 1 15 @ ./../generic/tclLiteral.c 270 - none -- UnknownPending(
active 80ec520 2 4 @ ./../generic/tclLiteral.c 270 - index -- -all
active 80de620 1 11 @ ./../generic/tclLiteral.c 270 - parsedVarName -- auto_noload
active 80e8da0 1 5 @ ./../generic/tclLiteral.c 270 - none -- event
active 80efda0 1 0 @ ./../generic/tclObj.c 901 - dict --
active 80e28a0 1 2 @ ./../generic/tclLiteral.c 270 - none -- ")
active 80803a0 4 0 @ ./../generic/tclBasic.c 327 - int --
active 80e8920 1 8 @ ./../generic/tclLiteral.c 270 - index -- commands
active 81042a0 1 1 @ ./../generic/tclLiteral.c 270 - none -- x
active 80e2e20 1 14 @ ./../generic/tclLiteral.c 270 - localVarName -- UnknownPending
active 80de720 1 15 @ ./../generic/tclLiteral.c 270 - parsedVarName -- tcl_interactive
active 80e6b20 1 7 @ ./../generic/tclLiteral.c 270 - none -- UNKNOWN
active 80f12a0 1 0 @ ./../generic/tclObj.c 901 - dict --
active 80ec1a0 1 23 @ ./../generic/tclLiteral.c 270 - regexp -- ^\^([^^]*)\^([^^]*)\^?$
active 80efea0 1 0 @ ./../generic/tclCmdMZ.c 1032 - int --
active 80de2a0 1 8 @ ./../generic/tclLiteral.c 270 - cmdName -- variable
active 80e8a20 1 17 @ ./../generic/tclLiteral.c 270 - none -- >&@stdout <@stdin
active 80e4320 1 6 @ ./../generic/tclLiteral.c 270 - cmdName -- string
active 80efa20 1 0 @ ./../generic/tclObj.c 901 - dict --
active 80de820 1 9 @ ./../generic/tclLiteral.c 270 - parsedVarName -- errorInfo
active 80e0ba0 1 4 @ ./../generic/tclLiteral.c 270 - cmdName -- info
active 80e8fa0 1 5 @ ./../generic/tclLiteral.c 270 - none -- dummy
active 80f13a0 1 0 @ ./../generic/tclCmdMZ.c 1032 - int --
active 80e01a0 1 7 @ ./../generic/tclLiteral.c 270 - cmdName -- uplevel
active 80e85a0 1 11 @ ./../generic/tclLiteral.c 270 - cmdName -- auto_execok
active 80ec2a0 1 3 @ ./../generic/tclLiteral.c 270 - none -- old
active 80deda0 1 1 @ ./../generic/tclLiteral.c 270 - int -- 4
active 80e0720 1 10 @ ./../generic/tclLiteral.c 270 - none -- -errorcode
active 80de3a0 1 21 @ ./../generic/tclLiteral.c 270 - parsedVarName -- ::tcl::UnknownPending
active 80e4420 1 10 @ ./../generic/tclLiteral.c 270 - none -- bytelength
active 80ec820 1 6 @ ./../generic/tclLiteral.c 270 - cmdName -- tclLog
active 80efb20 1 0 @ ./../generic/tclCmdMZ.c 1032 - int --
active 80de920 2 1 @ ./../generic/tclLiteral.c 270 - int -- 0
active 80e0ca0 1 6 @ ./../generic/tclLiteral.c 270 - index -- exists
active 80e2620 1 5 @ ./../generic/tclLiteral.c 270 - cmdName -- unset
active 80e49a0 1 3 @ ./../generic/tclLiteral.c 270 - int -- 150
active 8080120 4 6 @ ./../generic/tclBasic.c 319 - none -- -level
active 80e02a0 2 2 @ ./../generic/tclLiteral.c 270 - string -- ::
active 8104020 1 3 @ ./../generic/tclLiteral.c 270 - regexp -- ::+
active 80e6320 1 26 @ ./../generic/tclLiteral.c 270 - none --
invoked from within
"
active 80ec3a0 1 2 @ ./../generic/tclLiteral.c 270 - int -- -1
active 80e0820 2 0 @ ./../generic/tclLiteral.c 270 - list --
active 80de4a0 1 6 @ ./../generic/tclLiteral.c 270 - cmdName -- global
active 80f1020 1 3 @ ./../generic/tclLiteral.c 270 - none -- ":
active 80e21a0 1 53 @ ./../generic/tclLiteral.c 270 - none -- self-referential recursion in "unknown" for command "
active 80ec920 1 6 @ ./../generic/tclLiteral.c 270 - none -- change
active 80e8220 1 5 @ ./../generic/tclLiteral.c 270 - index -- level
active 80e4aa0 1 29 @ ./../generic/tclLiteral.c 270 - none -- "
("uplevel" body line 1)
active 80de020 1 7 @ ./../generic/tclLiteral.c 270 - parsedVarName -- history
active 80ecea0 1 36 @ ./../generic/tclLiteral.c 270 - none -- error in unknown while checking if "
active 80e2ca0 1 5 @ ./../generic/tclLiteral.c 270 - cmdName -- array
active 80de5a0 1 11 @ ./../generic/tclLiteral.c 270 - parsedVarName -- auto_noexec
active 80e4620 1 3 @ ./../generic/tclLiteral.c 270 - int -- 152
active 80e69a0 1 44 @ ./../generic/tclLiteral.c 270 - none -- Tcl bug: unexpected stack trace in "unknown"
active 80e22a0 1 1 @ ./../generic/tclLiteral.c 270 - none -- "
active 80eca20 1 1 @ ./../generic/tclLiteral.c 270 - none -- *
active 80e8320 1 6 @ ./../generic/tclLiteral.c 270 - index -- script
active 80e0ea0 1 1 @ ./../generic/tclLiteral.c 270 - none -- )
active 80deb20 2 6 @ ./../generic/tclLiteral.c 270 - cmdName -- regexp
active 80e4ba0 1 24 @ ./../generic/tclLiteral.c 270 - none --
invoked from within
active 80e2820 1 19 @ ./../generic/tclLiteral.c 270 - none --
(autoloading "
active 80ecfa0 1 36 @ ./../generic/tclLiteral.c 270 - none -- " is a unique command abbreviation:
active 8104220 1 8 @ ./../generic/tclLiteral.c 270 - regexp -- ^::(.*)$
active 80ec5a0 1 2 @ ./../generic/tclLiteral.c 270 - none -- --
active 80e2da0 1 4 @ ./../generic/tclLiteral.c 270 - index -- size
active 80de6a0 1 3 @ ./../generic/tclLiteral.c 270 - parsedVarName -- env
active 80e6aa0 1 4 @ ./../generic/tclLiteral.c 270 - none -- CORE
active 80e0020 1 3 @ ./../generic/tclLiteral.c 270 - none -- end
active 80e23a0 1 7 @ ./../generic/tclLiteral.c 270 - none -- pending
active 80dec20 1 25 @ ./../generic/tclLiteral.c 270 - regexp -- ^:*namespace[
]+inscope
active 80e4ca0 1 18 @ ./../generic/tclLiteral.c 270 - none --
"uplevel 1 $args"
active 80e05a0 1 6 @ ./../generic/tclLiteral.c 270 - cmdName -- return
active 80e89a0 1 7 @ ./../generic/tclLiteral.c 270 - none -- console
active 8104320 1 4 @ ./../generic/tclLiteral.c 270 - none -- tail
active 80ec6a0 1 6 @ ./../generic/tclLiteral.c 270 - none -- newcmd
active 80de7a0 1 9 @ ./../generic/tclLiteral.c 270 - parsedVarName -- errorCode
active 8079f20 4 5 @ ./../generic/tclBasic.c 311 - none -- -code
active 80e8f20 1 7 @ ./../generic/tclLiteral.c 270 - regexp -- ^!(.+)$
active 80e6ba0 1 8 @ ./../generic/tclLiteral.c 270 - none -- BADTRACE
active 80e24a0 1 9 @ ./../generic/tclLiteral.c 270 - cmdName -- auto_load
active 80e4820 1 5 @ ./../generic/tclLiteral.c 270 - none -- end-1
active 809af20 1 26 @ ./../generic/tclIOUtil.c 652 - none -- /home/phantom/tcl/tcl/unix
active 80eff20 1 24 @ ./../generic/tclLiteral.c 270 - none -- ambiguous command name "
active 80e4da0 1 22 @ ./../generic/tclLiteral.c 270 - none --
while executing
"
active 80e06a0 1 5 @ ./../generic/tclLiteral.c 270 - none -- -code
active 80e8aa0 1 4 @ ./../generic/tclLiteral.c 270 - none -- exec
active 80e2020 1 0 @ ./../generic/tclObj.c 901 - dict --
active 80e25a0 1 19 @ ./../generic/tclLiteral.c 270 - none -- ::namespace current
active 80f1420 1 22 @ ./../generic/tclLiteral.c 270 - none -- invalid command name "
active 80e62a0 1 5 @ ./../generic/tclLiteral.c 270 - cmdName -- error
active 80ec320 1 3 @ ./../generic/tclLiteral.c 270 - none -- new
active 80dee20 2 1 @ ./../generic/tclLiteral.c 270 - int -- 1
active 80e2b20 1 10 @ ./../generic/tclLiteral.c 270 - none -- -errorinfo
active 80ef620 1 8 @ ./../generic/tclLiteral.c 270 - cmdName -- lreplace
active 80e44a0 1 3 @ ./../generic/tclLiteral.c 270 - int -- 153
active 80e2120 1 0 @ ./../generic/tclCmdMZ.c 1032 - int --
active 80efba0 1 21 @ ./../generic/tclLiteral.c 270 - none -- empty command name ""
active 80e4a20 1 3 @ ./../generic/tclLiteral.c 270 - none -- ...
active 81040a0 1 3 @ ./../generic/tclLiteral.c 270 - localVarName -- cmd
active 80c3fa0 1 5069 @ ./../generic/tclParse.c 2069 - bytecode --
variable ::tcl::UnknownPending
global auto_noexec auto_noload env tcl_interactive
global errorCode errorInfo
# If the command word has the form "namespace inscope ns cmd"
# then concatenate its arguments onto the end and evaluate it.
set cmd [lindex $args 0]
if {[regexp "^:*namespace\[ \t\n\]+inscope" $cmd] && [llength $cmd] == 4} {
set arglist [lrange $args 1 end]
set ret [catch {uplevel 1 ::$cmd $arglist} result]
if {$ret == 0} {
return $result
} else {
return -code $ret -errorcode $errorCode $result
}
}
# Save the values of errorCode and errorInfo variables, since they
# may get modified if caught errors occur below. The variables will
# be restored just before re-executing the missing command.
set savedErrorCode $errorCode
set savedErrorInfo $errorInfo
set name [lindex $args 0]
if {![info exists auto_noload]} {
#
# Make sure we're not trying to load the same proc twice.
#
if {[info exists UnknownPending($name)]} {
return -code error "self-referential recursion in \"unknown\" for command \"$name\"";
}
set UnknownPending($name) pending;
set ret [catch {auto_load $name [uplevel 1 {::namespace current}]} msg]
unset UnknownPending($name);
if {$ret != 0} {
append errorInfo "\n (autoloading \"$name\")"
return -code $ret -errorcode $errorCode -errorinfo $errorInfo $msg
}
if {![array size UnknownPending]} {
unset UnknownPending
}
if {$msg} {
set errorCode $savedErrorCode
set errorInfo $savedErrorInfo
set code [catch {uplevel 1 $args} msg]
if {$code == 1} {
#
# Compute stack trace contribution from the [uplevel].
# Note the dependence on how Tcl_AddErrorInfo, etc.
# construct the stack trace.
#
set cinfo $args
if {[string bytelength $cinfo] > 153} {
set cinfo [string range $cinfo 0 152]
while {[string bytelength $cinfo] > 150} {
set cinfo [string range $cinfo 0 end-1]
}
append cinfo ...
}
append cinfo "\"\n (\"uplevel\" body line 1)"
append cinfo "\n invoked from within"
append cinfo "\n\"uplevel 1 \$args\""
#
# Try each possible form of the stack trace
# and trim the extra contribution from the matching case
#
set expect "$msg\n while executing\n\"$cinfo"
if {$errorInfo eq $expect} {
#
# The stack has only the eval from the expanded command
# Do not generate any stack trace here.
#
return -code error -errorcode $errorCode $msg
}
#
# Stack trace is nested, trim off just the contribution
# from the extra "eval" of $args due to the "catch" above.
#
set expect "\n invoked from within\n\"$cinfo"
set exlen [string length $expect]
set eilen [string length $errorInfo]
set i [expr {$eilen - $exlen - 1}]
set einfo [string range $errorInfo 0 $i]
#
# For now verify that $errorInfo consists of what we are about
# to return plus what we expected to trim off.
#
if {$errorInfo ne "$einfo$expect"} {
error "Tcl bug: unexpected stack trace in \"unknown\"" {} [list CORE UNKNOWN BADTRACE $einfo $expect $errorInfo]
}
return -code error -errorcode $errorCode -errorinfo $einfo $msg
} else {
return -code $code $msg
}
}
}
if {([info level] == 1) && [string equal [info script] ""] && [info exists tcl_interactive] && $tcl_interactive} {
if {![info exists auto_noexec]} {
set new [auto_execok $name]
if {$new != ""} {
set errorCode $savedErrorCode
set errorInfo $savedErrorInfo
set redir ""
if {[string equal [info commands console] ""]} {
set redir ">&@stdout <@stdin"
}
return [uplevel 1 exec $redir $new [lrange $args 1 end]]
}
}
set errorCode $savedErrorCode
set errorInfo $savedErrorInfo
if {[string equal $name "!!"]} {
set newcmd [history event]
} elseif {[regexp {^!(.+)$} $name dummy event]} {
set newcmd [history event $event]
} elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $name dummy old new]} {
set newcmd [history event -1]
catch {regsub -all -- $old $newcmd $new newcmd}
}
if {[info exists newcmd]} {
tclLog $newcmd
history change $newcmd 0
return [uplevel 1 $newcmd]
}
set ret [catch {set candidates [info commands $name*]} msg]
if {[string equal $name "::"]} {
set name ""
}
if {$ret != 0} {
return -code $ret -errorcode $errorCode "error in unknown while checking if \"$name\" is a unique command abbreviation:\n$msg"
}
# Filter out bogus matches when $name contained
# a glob-special char [Bug 946952]
set cmds [list]
foreach x $candidates {
if {[string range $x 0 [expr [string length $name]-1]] eq $name} {
lappend cmds $x
}
}
if {[llength $cmds] == 1} {
return [uplevel 1 [lreplace $args 0 0 $cmds]]
}
if {[llength $cmds]} {
if {[string equal $name ""]} {
return -code error "empty command name \"\""
} else {
return -code error "ambiguous command name \"$name\": [lsort $cmds]"
}
}
}
return -code error "invalid command name \"$name\""
active 80ec420 2 6 @ ./../generic/tclLiteral.c 270 - cmdName -- regsub
active 80ca020 1 1154 @ ./../generic/tclParse.c 2069 - bytecode --
# count separators and clean them up
# (making sure that foo:::::bar will be treated as foo::bar)
set n [regsub -all {::+} $cmd :: cmd]
# Ignore namespace if the name starts with ::
# Handle special case of only leading ::
# Before each return case we give an example of which category it is
# with the following form :
# ( inputCmd, inputNameSpace) -> output
if {[regexp {^::(.*)$} $cmd x tail]} {
if {$n > 1} {
# ( ::foo::bar , * ) -> ::foo::bar
return [list $cmd]
} else {
# ( ::global , * ) -> global
return [list $tail]
}
}
# Potentially returning 2 elements to try :
# (if the current namespace is not the global one)
if {$n == 0} {
if {[string equal $namespace ::]} {
# ( nocolons , :: ) -> nocolons
return [list $cmd]
} else {
# ( nocolons , ::sub ) -> ::sub::nocolons nocolons
return [list ${namespace}::$cmd $cmd]
}
} elseif {[string equal $namespace ::]} {
# ( foo::bar , :: ) -> ::foo::bar
return [list ::$cmd]
} else {
# ( foo::bar , ::sub ) -> ::sub::foo::bar ::foo::bar
return [list ${namespace}::$cmd ::$cmd]
}
active 80def20 1 6 @ ./../generic/tclLiteral.c 270 - cmdName -- lrange
