如何在 Tcl/Tk 中找到内存泄漏？

Question

我的一个 Tcl/Tk (8.6.11) 程序崩溃并出现以下错误：

超出 Tcl 值的最大大小（2147483647 字节）

tcl/tk 程序执行以下操作：

1. 打开一个 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}
   }
   

2. 读取通过套接字接收到的字符串

3. 将字符串评估为 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"
         }
     }
   }
   

4. 收到的字符串类似于（\n 被适当的换行符替换）

   ::application::post {====================: 34124 hello world\n}\n
   

   而::application::post 过程为空：

   proc ::application::post {message} {}
   

5. 如果我从我的控制应用程序发送一些命令（如::application::post {====================: %d\n}\n），一切都会按预期工作。

6. 但是，如果我在短时间内发送大量命令（例如，从“无限计数器”驱动上述命令），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 代码中是否有任何明显的内存泄漏？

Answer 1

您可以从堆栈跟踪中看到它正在执行追加操作（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 命令的子解释器中运行这些命令。