| 1 | #!/usr/bin/perl |
| 2 | # |
| 3 | # Reads a log file, containing lines of the four types |
| 4 | # <file> <line> malloc(<number>) returns <pointer> |
| 5 | # <file> <line> strdup(<number>) returns <pointer> |
| 6 | # <file> <line> calloc(<number>*<number>) returns <pointer> |
| 7 | # <file> <line> realloc(<pointer>,<number>) returns <pointer> |
| 8 | # <file> <line> free(<pointer>) |
| 9 | # |
| 10 | # with optional line on the front saying |
| 11 | # null pointer is <pointer> |
| 12 | # |
| 13 | # and produces a list of free()s and realloc()s of wrong pointers, |
| 14 | # and also of malloc()s, calloc()s and realloc()s that never get free()d. |
| 15 | |
| 16 | $errors=0; |
| 17 | |
| 18 | while (<>) { |
| 19 | $in=$out=""; |
| 20 | ($file, $line, $call, $in, $out)=($1,$2,$3,"",$4) |
| 21 | if /^(\S+) (\S+) (malloc|strdup)\(\S+\) returns (\S+)$/; |
| 22 | ($file, $line, $call, $in, $out)=($1,$2,"calloc","",$5) |
| 23 | if /^(\S+) (\S+) calloc\(\S+\*\S+\) returns (\S+)$/; |
| 24 | ($file, $line, $call, $in, $out)=($1,$2,"realloc",$3,$4) |
| 25 | if /^(\S+) (\S+) realloc\((\S+),\S+\) returns (\S+)$/; |
| 26 | ($file, $line, $call, $in, $out)=($1,$2,"free",$3,"") |
| 27 | if /^(\S+) (\S+) free\((\S+)\)$/; |
| 28 | $null = $1, next if /^null pointer is (\S+)$/; |
| 29 | if ($in ne "") { |
| 30 | if (&null($in)) { |
| 31 | $bad = "null pointer"; |
| 32 | } elsif (defined $lastalloc{$in}) { |
| 33 | $bad = "already-freed pointer (last alloc $lastalloc{$in}, last free $lastfree{$in})"; |
| 34 | } else { |
| 35 | $bad = "bad pointer"; |
| 36 | } |
| 37 | $errors=1, print "($.) $file:$line: $call() $bad\n" |
| 38 | if $record{$in} eq ""; |
| 39 | $lastfree{$in}="($.) $file:$line"; |
| 40 | $record{$in}=""; |
| 41 | } |
| 42 | if ($out ne "" && !&null($out)) { |
| 43 | $errors=1, print "($.) $file:$line: $call() returned already ". |
| 44 | "allocated pointer\n" if $record{$out} ne ""; |
| 45 | $record{$out}="($.) $file:$line: $call()"; |
| 46 | $lastalloc{$out}="($.) $file:$line"; |
| 47 | } |
| 48 | } |
| 49 | |
| 50 | foreach $i (keys %record) { |
| 51 | $errors=1, print "$record{$i} never got freed\n" |
| 52 | if $record{$i} ne ""; |
| 53 | } |
| 54 | |
| 55 | print "no problems\n" if !$errors; |
| 56 | |
| 57 | # determine if a string refers to a null pointer |
| 58 | sub null { |
| 59 | local ($_) = @_; |
| 60 | $null ? $_ eq $null : /^((0x)?0+|\(nil\))$/; |
| 61 | } |