如何在 Tcl/Tk 中查找内存泄漏？
how to find memory leak in Tcl/Tk?
我的 Tcl/Tk (8.6.11) 程序崩溃并出现以下错误：
max size for a Tcl value (2147483647 bytes) exceeded
tcl/tk 程序执行以下操作：
打开一个TCP/IP套接字
proc ::application::create_socket {} {
variable my_socket
if {[catch {set my_socket [socket -server ::application::configure_socket -myaddr localhost 0]}]} {
puts stderr "ERROR: failed to allocate port, exiting!"
exit 3
}
return [lindex [fconfigure $sock -sockname] 2]
}
proc ::application::configure_socket {sock client_addr client_port} {
fconfigure $sock -blocking 0 -buffering none -encoding utf-8;
fileevent $sock readable {::application::readsocket}
}
读取通过套接字接收到的字符串
将字符串计算为 Tcl/Tk 命令：
proc ::application::readsocket {} {
variable my_socket
variable rcvd_cmds
if {[eof $my_socket]} {
close $my_socket
exit
}
append rcvd_cmds [read $my_socket]
if {[string index $rcvd_cmds end] ne "\n" || \
![info complete $rcvd_cmds]} {
# the block is incomplete, wait for the next block of data
return
} else {
set docmds $rcvd_cmds
set rcvd_cmds ""
if {![catch {uplevel #0 $docmds} errorname]} {
} else {
# oops, error, alert the user:
global errorInfo
::application::fatal "oops: $errInfo\n"
}
}
}
收到的字符串类似于（\n 被适当的换行符替换）
::application::post {====================: 34124 hello world\n}\n
并且 ::application::post 过程为空：
proc ::application::post {message} {}
如果我从我的控制应用程序发送一些命令（如 ::application::post {====================: %d\n}\n），一切都会按预期工作。
但是，如果我在短时间内发送大量命令（例如从“无限计数器”驱动上述命令）Tcl/Tk应用程序最终会崩溃。
运行 通过 gdb 的 tcl/tk 脚本，我得到一个没有告诉我任何信息的回溯：
(gdb) run
Starting program: /usr/bin/wish8.6 application.tcl
[Thread debugging using libthread_db enabled]
Using host libthread_db library "/lib/x86_64-linux-gnu/libthread_db.so.1".
[New Thread 0x7ffff67e9700 (LWP 1445236)]
[Detaching after fork from child process 1445237]
input channels = 0, output channels = 0
app output pipe: Connection reset by peer
max size for a Tcl value (2147483647 bytes) exceeded
Thread 1 "wish8.6" received signal SIGABRT, Aborted.
__GI_raise (sig=sig@entry=6) at ../sysdeps/unix/sysv/linux/raise.c:50
50 ../sysdeps/unix/sysv/linux/raise.c: No such file or directory.
(gdb) bt
#0 __GI_raise (sig=sig@entry=6) at ../sysdeps/unix/sysv/linux/raise.c:50
#1 0x00007ffff7aaf537 in __GI_abort () at abort.c:79
#2 0x00007ffff7d60690 in Tcl_PanicVA (format=<optimized out>, argList=argList@entry=0x7fffffffd700) at ./generic/tclPanic.c:123
#3 0x00007ffff7d60759 in Tcl_Panic (format=format@entry=0x7ffff7dbec30 "max size for a Tcl value (%d bytes) exceeded") at ./generic/tclPanic.c:160
#4 0x00007ffff7d77c41 in AppendUtfToUtfRep (objPtr=objPtr@entry=0x555555cacaf0,
bytes=0x7ffef58ca020 "::application::post {1.04045e+07}\n::application::post { }\n::application::post {hello}\n::application::post { }\n::application::post {world}\n::application::post {\n}\n::application::post {", '=' <repeats 20 times>, ": }\n::pdwindow::po"..., numBytes=2147450230) at ./generic/tclStringObj.c:1727
#5 0x00007ffff7d74d2b in AppendUtfToUtfRep (numBytes=<optimized out>, bytes=<optimized out>, objPtr=0x555555cacaf0) at ./generic/tclStringObj.c:1394
#6 Tcl_AppendObjToObj (objPtr=0x555555cacaf0, appendObjPtr=appendObjPtr@entry=0x555555cacdf0) at ./generic/tclStringObj.c:1509
#7 0x00007ffff7d8beab in TclPtrSetVarIdx (interp=interp@entry=0x555555574990, varPtr=0x55555564d3e0, arrayPtr=0x0, part1Ptr=part1Ptr@entry=0x0, part2Ptr=<optimized out>,
newValuePtr=0x555555cacdf0, flags=516, index=1) at ./generic/tclVar.c:1976
#8 0x00007ffff7d1e196 in TEBCresume (data=0x555555cad008, interp=<optimized out>, result=0) at ./generic/tclExecute.c:3629
#9 0x00007ffff7c914a2 in TclNRRunCallbacks (interp=interp@entry=0x555555574990, result=0, rootPtr=0x0) at ./generic/tclBasic.c:4493
#10 0x00007ffff7c933de in TclEvalObjEx (interp=interp@entry=0x555555574990, objPtr=<optimized out>, flags=flags@entry=131072, invoker=invoker@entry=0x0, word=word@entry=0)
at ./generic/tclBasic.c:6059
#11 0x00007ffff7c933aa in Tcl_EvalObjEx (interp=interp@entry=0x555555574990, objPtr=<optimized out>, flags=flags@entry=131072) at ./generic/tclBasic.c:6040
#12 0x00007ffff7d40203 in TclChannelEventScriptInvoker (clientData=0x5555558a8740, mask=2) at ./generic/tclIO.c:8945
#13 0x00007ffff7d3fc3b in Tcl_NotifyChannel (channel=0x555555949770, mask=2) at ./generic/tclIO.c:8426
#14 0x00007ffff7da1d0e in FileHandlerEventProc (flags=-3, evPtr=0x555555d21e80) at ./unix/tclUnixNotfy.c:808
#15 FileHandlerEventProc (evPtr=evPtr@entry=0x555555d21e80, flags=flags@entry=-3) at ./unix/tclUnixNotfy.c:764
#16 0x00007ffff7d5c8f9 in Tcl_ServiceEvent (flags=flags@entry=-3) at ./generic/tclNotify.c:670
#17 0x00007ffff7d5cc09 in Tcl_DoOneEvent (flags=-3) at ./generic/tclNotify.c:967
#18 0x00007ffff7e608b2 in Tk_MainLoop () at ./unix/../generic/tkEvent.c:2109
#19 0x00007ffff7e6f8d0 in Tk_MainEx (argc=<optimized out>, argv=0x7fffffffe008, appInitProc=0x5555555551e0, interp=0x555555574990) at ./unix/../generic/tkMain.c:377
#20 0x00005555555550df in ?? ()
#21 0x00007ffff7ab0d0a in __libc_start_main (main=0x5555555550b0, argc=2, argv=0x7fffffffdff8, init=<optimized out>, fini=<optimized out>, rtld_fini=<optimized out>,
stack_end=0x7fffffffdfe8) at ../csu/libc-start.c:308
#22 0x000055555555511a in _start ()
现在我怀疑 ::application::readsocket 过程的 append rcvd_cmds [read $my_socket] 出了点问题。
有没有办法检查 Tcl/Tk 中的给定变量以查看它消耗了多少内存？
除此之外：Tcl/Tk 代码中是否存在任何明显的内存泄漏？
您可以从堆栈跟踪中看到它正在执行追加（AppendUtfToUtfRep 失败；名称具有暗示性）并且您只有一个地方可以执行此操作。直接的问题是你在那个变量中积累了太多。 但为什么呢？幸运的是，在这种情况下我们可以很好地猜测原因。
您似乎没有检测到每个命令的结束，因此从不将它们发送到评估路径并清除累积变量。因为您的块基本上是面向行的，所以您应该使用 gets 而不是 read。您还应该做一些小事，例如跟踪您积累了多少数据，以确保您不会一次性积累太多。 chan pending 命令对此有很大帮助。
proc ::application::readsocket {} {
variable my_socket
variable rcvd_cmds
set MAX_LENGTH 1000000
# Consume whole lines out of the received message
while {[gets $my_socket line] >= 0} {
append rcvd_cmds $line "\n"
if {[info complete $rcvd_cmds]} {
try {
uplevel #0 $rcvd_cmds
} on error {} {
# oops, error, alert the user:
::application::fatal "oops: $::errorInfo\n"
} finally {
set rcvd_cmds ""
}
} elseif {[string length $rcvd_cmds] > $MAX_LENGTH} {
# Too much in one command!
close $my_socket
exit
}
}
# No whole lines remain; can be for several reasons:
# * Simple end of message (normal case!)
# * Socket closed
# * Data there not finished by newline; check for over-length in this case
if {[chan eof $my_socket]} {
close $my_socket
exit
} elseif {[chan blocked $my_socket]} {
if {[chan pending input $my_socket] > $MAX_LENGTH} {
# Too much in one line!
close $my_socket
exit
}
}
}
您可能想考虑 运行 子解释器中的那些命令，您已经删除了 update 和 vwait 命令。
我的 Tcl/Tk (8.6.11) 程序崩溃并出现以下错误：
max size for a Tcl value (2147483647 bytes) exceeded
tcl/tk 程序执行以下操作：
打开一个TCP/IP套接字
proc ::application::create_socket {} { variable my_socket if {[catch {set my_socket [socket -server ::application::configure_socket -myaddr localhost 0]}]} { puts stderr "ERROR: failed to allocate port, exiting!" exit 3 } return [lindex [fconfigure $sock -sockname] 2] } proc ::application::configure_socket {sock client_addr client_port} { fconfigure $sock -blocking 0 -buffering none -encoding utf-8; fileevent $sock readable {::application::readsocket} }读取通过套接字接收到的字符串
将字符串计算为 Tcl/Tk 命令：
proc ::application::readsocket {} { variable my_socket variable rcvd_cmds if {[eof $my_socket]} { close $my_socket exit } append rcvd_cmds [read $my_socket] if {[string index $rcvd_cmds end] ne "\n" || \ ![info complete $rcvd_cmds]} { # the block is incomplete, wait for the next block of data return } else { set docmds $rcvd_cmds set rcvd_cmds "" if {![catch {uplevel #0 $docmds} errorname]} { } else { # oops, error, alert the user: global errorInfo ::application::fatal "oops: $errInfo\n" } } }收到的字符串类似于（
\n被适当的换行符替换）::application::post {====================: 34124 hello world\n}\n并且
::application::post过程为空：proc ::application::post {message} {}如果我从我的控制应用程序发送一些命令（如
::application::post {====================: %d\n}\n），一切都会按预期工作。但是，如果我在短时间内发送大量命令（例如从“无限计数器”驱动上述命令）Tcl/Tk应用程序最终会崩溃。
运行 通过 gdb 的 tcl/tk 脚本，我得到一个没有告诉我任何信息的回溯：
(gdb) run
Starting program: /usr/bin/wish8.6 application.tcl
[Thread debugging using libthread_db enabled]
Using host libthread_db library "/lib/x86_64-linux-gnu/libthread_db.so.1".
[New Thread 0x7ffff67e9700 (LWP 1445236)]
[Detaching after fork from child process 1445237]
input channels = 0, output channels = 0
app output pipe: Connection reset by peer
max size for a Tcl value (2147483647 bytes) exceeded
Thread 1 "wish8.6" received signal SIGABRT, Aborted.
__GI_raise (sig=sig@entry=6) at ../sysdeps/unix/sysv/linux/raise.c:50
50 ../sysdeps/unix/sysv/linux/raise.c: No such file or directory.
(gdb) bt
#0 __GI_raise (sig=sig@entry=6) at ../sysdeps/unix/sysv/linux/raise.c:50
#1 0x00007ffff7aaf537 in __GI_abort () at abort.c:79
#2 0x00007ffff7d60690 in Tcl_PanicVA (format=<optimized out>, argList=argList@entry=0x7fffffffd700) at ./generic/tclPanic.c:123
#3 0x00007ffff7d60759 in Tcl_Panic (format=format@entry=0x7ffff7dbec30 "max size for a Tcl value (%d bytes) exceeded") at ./generic/tclPanic.c:160
#4 0x00007ffff7d77c41 in AppendUtfToUtfRep (objPtr=objPtr@entry=0x555555cacaf0,
bytes=0x7ffef58ca020 "::application::post {1.04045e+07}\n::application::post { }\n::application::post {hello}\n::application::post { }\n::application::post {world}\n::application::post {\n}\n::application::post {", '=' <repeats 20 times>, ": }\n::pdwindow::po"..., numBytes=2147450230) at ./generic/tclStringObj.c:1727
#5 0x00007ffff7d74d2b in AppendUtfToUtfRep (numBytes=<optimized out>, bytes=<optimized out>, objPtr=0x555555cacaf0) at ./generic/tclStringObj.c:1394
#6 Tcl_AppendObjToObj (objPtr=0x555555cacaf0, appendObjPtr=appendObjPtr@entry=0x555555cacdf0) at ./generic/tclStringObj.c:1509
#7 0x00007ffff7d8beab in TclPtrSetVarIdx (interp=interp@entry=0x555555574990, varPtr=0x55555564d3e0, arrayPtr=0x0, part1Ptr=part1Ptr@entry=0x0, part2Ptr=<optimized out>,
newValuePtr=0x555555cacdf0, flags=516, index=1) at ./generic/tclVar.c:1976
#8 0x00007ffff7d1e196 in TEBCresume (data=0x555555cad008, interp=<optimized out>, result=0) at ./generic/tclExecute.c:3629
#9 0x00007ffff7c914a2 in TclNRRunCallbacks (interp=interp@entry=0x555555574990, result=0, rootPtr=0x0) at ./generic/tclBasic.c:4493
#10 0x00007ffff7c933de in TclEvalObjEx (interp=interp@entry=0x555555574990, objPtr=<optimized out>, flags=flags@entry=131072, invoker=invoker@entry=0x0, word=word@entry=0)
at ./generic/tclBasic.c:6059
#11 0x00007ffff7c933aa in Tcl_EvalObjEx (interp=interp@entry=0x555555574990, objPtr=<optimized out>, flags=flags@entry=131072) at ./generic/tclBasic.c:6040
#12 0x00007ffff7d40203 in TclChannelEventScriptInvoker (clientData=0x5555558a8740, mask=2) at ./generic/tclIO.c:8945
#13 0x00007ffff7d3fc3b in Tcl_NotifyChannel (channel=0x555555949770, mask=2) at ./generic/tclIO.c:8426
#14 0x00007ffff7da1d0e in FileHandlerEventProc (flags=-3, evPtr=0x555555d21e80) at ./unix/tclUnixNotfy.c:808
#15 FileHandlerEventProc (evPtr=evPtr@entry=0x555555d21e80, flags=flags@entry=-3) at ./unix/tclUnixNotfy.c:764
#16 0x00007ffff7d5c8f9 in Tcl_ServiceEvent (flags=flags@entry=-3) at ./generic/tclNotify.c:670
#17 0x00007ffff7d5cc09 in Tcl_DoOneEvent (flags=-3) at ./generic/tclNotify.c:967
#18 0x00007ffff7e608b2 in Tk_MainLoop () at ./unix/../generic/tkEvent.c:2109
#19 0x00007ffff7e6f8d0 in Tk_MainEx (argc=<optimized out>, argv=0x7fffffffe008, appInitProc=0x5555555551e0, interp=0x555555574990) at ./unix/../generic/tkMain.c:377
#20 0x00005555555550df in ?? ()
#21 0x00007ffff7ab0d0a in __libc_start_main (main=0x5555555550b0, argc=2, argv=0x7fffffffdff8, init=<optimized out>, fini=<optimized out>, rtld_fini=<optimized out>,
stack_end=0x7fffffffdfe8) at ../csu/libc-start.c:308
#22 0x000055555555511a in _start ()
现在我怀疑 ::application::readsocket 过程的 append rcvd_cmds [read $my_socket] 出了点问题。
有没有办法检查 Tcl/Tk 中的给定变量以查看它消耗了多少内存？
除此之外：Tcl/Tk 代码中是否存在任何明显的内存泄漏？
您可以从堆栈跟踪中看到它正在执行追加（AppendUtfToUtfRep 失败；名称具有暗示性）并且您只有一个地方可以执行此操作。直接的问题是你在那个变量中积累了太多。 但为什么呢？幸运的是，在这种情况下我们可以很好地猜测原因。
您似乎没有检测到每个命令的结束，因此从不将它们发送到评估路径并清除累积变量。因为您的块基本上是面向行的，所以您应该使用 gets 而不是 read。您还应该做一些小事，例如跟踪您积累了多少数据，以确保您不会一次性积累太多。 chan pending 命令对此有很大帮助。
proc ::application::readsocket {} {
variable my_socket
variable rcvd_cmds
set MAX_LENGTH 1000000
# Consume whole lines out of the received message
while {[gets $my_socket line] >= 0} {
append rcvd_cmds $line "\n"
if {[info complete $rcvd_cmds]} {
try {
uplevel #0 $rcvd_cmds
} on error {} {
# oops, error, alert the user:
::application::fatal "oops: $::errorInfo\n"
} finally {
set rcvd_cmds ""
}
} elseif {[string length $rcvd_cmds] > $MAX_LENGTH} {
# Too much in one command!
close $my_socket
exit
}
}
# No whole lines remain; can be for several reasons:
# * Simple end of message (normal case!)
# * Socket closed
# * Data there not finished by newline; check for over-length in this case
if {[chan eof $my_socket]} {
close $my_socket
exit
} elseif {[chan blocked $my_socket]} {
if {[chan pending input $my_socket] > $MAX_LENGTH} {
# Too much in one line!
close $my_socket
exit
}
}
}
您可能想考虑 运行 子解释器中的那些命令，您已经删除了 update 和 vwait 命令。