diff options
Diffstat (limited to 'ext/pdo_sqlite/sqlite/tool/memleak3.tcl')
| -rw-r--r-- | ext/pdo_sqlite/sqlite/tool/memleak3.tcl | 233 |
1 files changed, 0 insertions, 233 deletions
diff --git a/ext/pdo_sqlite/sqlite/tool/memleak3.tcl b/ext/pdo_sqlite/sqlite/tool/memleak3.tcl deleted file mode 100644 index 3c6e9b9c56..0000000000 --- a/ext/pdo_sqlite/sqlite/tool/memleak3.tcl +++ /dev/null @@ -1,233 +0,0 @@ -#/bin/sh -# \ -exec `which tclsh` $0 "$@" -# -# The author disclaims copyright to this source code. In place of -# a legal notice, here is a blessing: -# -# May you do good and not evil. -# May you find forgiveness for yourself and forgive others. -# May you share freely, never taking more than you give. -###################################################################### - -set doco " -This script is a tool to help track down memory leaks in the sqlite -library. The library must be compiled with the preprocessor symbol -SQLITE_MEMDEBUG set to at least 2. It must be set to 3 to enable stack -traces. - -To use, run the leaky application and save the standard error output. -Then, execute this program with the first argument the name of the -application binary (or interpreter) and the second argument the name of the -text file that contains the collected stderr output. - -If all goes well a summary of unfreed allocations is printed out. If the -GNU C library is in use and SQLITE_DEBUG is 3 or greater a stack trace is -printed out for each unmatched allocation. - -If the \"-r <n>\" option is passed, then the program stops and prints out -the state of the heap immediately after the <n>th call to malloc() or -realloc(). - -Example: - -$ ./testfixture ../sqlite/test/select1.test 2> memtrace.out -$ tclsh $argv0 ?-r <malloc-number>? ./testfixture memtrace.out -" - - -proc usage {} { - set prg [file tail $::argv0] - puts "Usage: $prg ?-r <malloc-number>? <binary file> <mem trace file>" - puts "" - puts [string trim $::doco] - exit -1 -} - -proc shift {listvar} { - upvar $listvar l - set ret [lindex $l 0] - set l [lrange $l 1 end] - return $ret -} - -# Argument handling. The following vars are set: -# -# $exe - the name of the executable (i.e. "testfixture" or "./sqlite3") -# $memfile - the name of the file containing the trace output. -# $report_at - The malloc number to stop and report at. Or -1 to read -# all of $memfile. -# -set report_at -1 -while {[llength $argv]>2} { - set arg [shift argv] - switch -- $arg { - "-r" { - set report_at [shift argv] - } - default { - usage - } - } -} -if {[llength $argv]!=2} usage -set exe [lindex $argv 0] -set memfile [lindex $argv 1] - -# If stack traces are enabled, the 'addr2line' program is called to -# translate a binary stack address into a human-readable form. -set addr2line addr2line - -# When the SQLITE_MEMDEBUG is set as described above, SQLite prints -# out a line for each malloc(), realloc() or free() call that the -# library makes. If SQLITE_MEMDEBUG is 3, then a stack trace is printed -# out before each malloc() and realloc() line. -# -# This program parses each line the SQLite library outputs and updates -# the following global Tcl variables to reflect the "current" state of -# the heap used by SQLite. -# -set nBytes 0 ;# Total number of bytes currently allocated. -set nMalloc 0 ;# Total number of malloc()/realloc() calls. -set nPeak 0 ;# Peak of nBytes. -set iPeak 0 ;# nMalloc when nPeak was set. -# -# More detailed state information is stored in the $memmap array. -# Each key in the memmap array is the address of a chunk of memory -# currently allocated from the heap. The value is a list of the -# following form -# -# {<number-of-bytes> <malloc id> <stack trace>} -# -array unset memmap - -proc process_input {input_file array_name} { - upvar $array_name mem - set input [open $input_file] - - set MALLOC {([[:digit:]]+) malloc ([[:digit:]]+) bytes at 0x([[:xdigit:]]+)} - # set STACK {^[[:digit:]]+: STACK: (.*)$} - set STACK {^STACK: (.*)$} - set FREE {[[:digit:]]+ free ([[:digit:]]+) bytes at 0x([[:xdigit:]]+)} - set REALLOC {([[:digit:]]+) realloc ([[:digit:]]+) to ([[:digit:]]+)} - append REALLOC { bytes at 0x([[:xdigit:]]+) to 0x([[:xdigit:]]+)} - - set stack "" - while { ![eof $input] } { - set line [gets $input] - if {[regexp $STACK $line dummy stack]} { - # Do nothing. The variable $stack now stores the hexadecimal stack dump - # for the next malloc() or realloc(). - - } elseif { [regexp $MALLOC $line dummy mallocid bytes addr] } { - # If this is a 'malloc' line, set an entry in the mem array. Each entry - # is a list of length three, the number of bytes allocated , the malloc - # number and the stack dump when it was allocated. - set mem($addr) [list $bytes "malloc $mallocid" $stack] - set stack "" - - # Increase the current heap usage - incr ::nBytes $bytes - - # Increase the number of malloc() calls - incr ::nMalloc - - if {$::nBytes > $::nPeak} { - set ::nPeak $::nBytes - set ::iPeak $::nMalloc - } - - } elseif { [regexp $FREE $line dummy bytes addr] } { - # If this is a 'free' line, remove the entry from the mem array. If the - # entry does not exist, or is the wrong number of bytes, announce a - # problem. This is more likely a bug in the regular expressions for - # this script than an SQLite defect. - if { [lindex $mem($addr) 0] != $bytes } { - error "byte count mismatch" - } - unset mem($addr) - - # Decrease the current heap usage - incr ::nBytes [expr -1 * $bytes] - - } elseif { [regexp $REALLOC $line dummy mallocid ob b oa a] } { - # "free" the old allocation in the internal model: - incr ::nBytes [expr -1 * $ob] - unset mem($oa); - - # "malloc" the new allocation - set mem($a) [list $b "realloc $mallocid" $stack] - incr ::nBytes $b - set stack "" - - # Increase the number of malloc() calls - incr ::nMalloc - - if {$::nBytes > $::nPeak} { - set ::nPeak $::nBytes - set ::iPeak $::nMalloc - } - - } else { - # puts "REJECT: $line" - } - - if {$::nMalloc==$::report_at} report - } - - close $input -} - -proc printstack {stack} { - set fcount 10 - if {[llength $stack]<10} { - set fcount [llength $stack] - } - foreach frame [lrange $stack 1 $fcount] { - foreach {f l} [split [exec $::addr2line -f --exe=$::exe $frame] \n] {} - puts [format "%-30s %s" $f $l] - } - if {[llength $stack]>0 } {puts ""} -} - -proc report {} { - - foreach key [array names ::memmap] { - set stack [lindex $::memmap($key) 2] - set bytes [lindex $::memmap($key) 0] - lappend summarymap($stack) $bytes - } - - set sorted [list] - foreach stack [array names summarymap] { - set allocs $summarymap($stack) - set sum 0 - foreach a $allocs { - incr sum $a - } - lappend sorted [list $sum $stack] - } - - set sorted [lsort -integer -index 0 $sorted] - foreach s $sorted { - set sum [lindex $s 0] - set stack [lindex $s 1] - set allocs $summarymap($stack) - puts "$sum bytes in [llength $allocs] chunks ($allocs)" - printstack $stack - } - - # Print out summary statistics - puts "Total allocations : $::nMalloc" - puts "Total outstanding allocations: [array size ::memmap]" - puts "Current heap usage : $::nBytes bytes" - puts "Peak heap usage : $::nPeak bytes (malloc #$::iPeak)" - - exit -} - -process_input $memfile memmap -report - - - |