Posted to tcl by miguel at Mon Aug 04 17:30:51 GMT 2008view raw

  1. #! /usr/bin/env tclsh
  2.  
  3. set fname [lindex $argv 0]
  4. set in [open $fname]
  5. set outleaks [open $fname.leaks w]
  6. set outerrs [open $fname.errors w]
  7.  
  8. set lcount 10
  9.  
  10. while {[gets $in line] != -1} {
  11. if {[string match "ยบ *" $line]} {
  12. set testfile [file tail [lindex $line 1]]
  13. continue
  14. } elseif {[string match "* blocks are definitely lost in loss record *" $line]} {
  15. upvar 0 leaks outlist nleaks outnum
  16. } elseif {[string match "* Conditional jump or move *" $line]
  17. || [string match "* Invalid read of size *" $line]} {
  18. upvar 0 errors outlist nerrors outnum
  19. } else {
  20. continue
  21. }
  22.  
  23. set key [list]
  24. set new 1
  25. set nleaks 0
  26. set nerrors 0
  27. for {set i 0} {$i < $lcount} {incr i} {
  28. gets $in item
  29. if {![regsub {^[^:]*:} $item {} item]} {
  30. set new 0
  31. break
  32. }
  33. if {($i == 0) && $new && ![string match "* blocks *" $line]} {
  34. lappend key [regsub {^[^ ]* } $line {}]
  35. }
  36. lappend key " $i: $item"
  37. }
  38. if {1||$new} {
  39. lappend outlist($key) "-- $testfile: $line"
  40. }
  41. }
  42. puts "Found [llength [array names leaks]] different leaks"
  43. puts "Found [llength [array names errors]] different errors"
  44. close $in
  45.  
  46.  
  47. set num 0
  48. foreach {key val} [array get leaks] {
  49. puts $outleaks "Leak \#[incr num]"
  50. puts $outleaks [join $key \n]\n[join $val \n]\n
  51. }
  52. foreach {key val} [array get errors] {
  53. puts $outerrs "Error \#[incr num]"
  54. puts $outerrs [join $key \n]\n[join $val \n]\n
  55. }