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
}
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]
set addr2line addr2line
set nBytes 0 ;set nMalloc 0 ;set nPeak 0 ;set iPeak 0 ;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 {^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]} {
} elseif { [regexp $MALLOC $line dummy mallocid bytes addr] } {
set mem($addr) [list $bytes "malloc $mallocid" $stack]
set stack ""
incr ::nBytes $bytes
incr ::nMalloc
if {$::nBytes > $::nPeak} {
set ::nPeak $::nBytes
set ::iPeak $::nMalloc
}
} elseif { [regexp $FREE $line dummy bytes addr] } {
if { [lindex $mem($addr) 0] != $bytes } {
error "byte count mismatch"
}
unset mem($addr)
incr ::nBytes [expr -1 * $bytes]
} elseif { [regexp $REALLOC $line dummy mallocid ob b oa a] } {
incr ::nBytes [expr -1 * $ob]
unset mem($oa);
set mem($a) [list $b "realloc $mallocid" $stack]
incr ::nBytes $b
set stack ""
incr ::nMalloc
if {$::nBytes > $::nPeak} {
set ::nPeak $::nBytes
set ::iPeak $::nMalloc
}
} else {
}
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
}
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