Posted to tcl by miguel at Mon Aug 04 17:30:51 GMT 2008view raw
- #! /usr/bin/env tclsh
- set fname [lindex $argv 0]
- set in [open $fname]
- set outleaks [open $fname.leaks w]
- set outerrs [open $fname.errors w]
- set lcount 10
- while {[gets $in line] != -1} {
- if {[string match "ยบ *" $line]} {
- set testfile [file tail [lindex $line 1]]
- continue
- } elseif {[string match "* blocks are definitely lost in loss record *" $line]} {
- upvar 0 leaks outlist nleaks outnum
- } elseif {[string match "* Conditional jump or move *" $line]
- || [string match "* Invalid read of size *" $line]} {
- upvar 0 errors outlist nerrors outnum
- } else {
- continue
- }
- set key [list]
- set new 1
- set nleaks 0
- set nerrors 0
- for {set i 0} {$i < $lcount} {incr i} {
- gets $in item
- if {![regsub {^[^:]*:} $item {} item]} {
- set new 0
- break
- }
- if {($i == 0) && $new && ![string match "* blocks *" $line]} {
- lappend key [regsub {^[^ ]* } $line {}]
- }
- lappend key " $i: $item"
- }
- if {1||$new} {
- lappend outlist($key) "-- $testfile: $line"
- }
- }
- puts "Found [llength [array names leaks]] different leaks"
- puts "Found [llength [array names errors]] different errors"
- close $in
- set num 0
- foreach {key val} [array get leaks] {
- puts $outleaks "Leak \#[incr num]"
- puts $outleaks [join $key \n]\n[join $val \n]\n
- }
- foreach {key val} [array get errors] {
- puts $outerrs "Error \#[incr num]"
- puts $outerrs [join $key \n]\n[join $val \n]\n
- }