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

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

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

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

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,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 ()

现在我怀疑 append rcvd_cmds [read $my_socket] 过程的 ::application::readsocket 出现问题。

有没有办法在 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 中找到内存泄漏？

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

解决方法

相关推荐