File: logalloc

package info (click to toggle)
halibut 1.3-5
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 4,060 kB
  • sloc: ansic: 59,012; perl: 197; lisp: 76; makefile: 50; sh: 1
file content (61 lines) | stat: -rwxr-xr-x 2,025 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
#!/usr/bin/perl
#
# Reads a log file, containing lines of the four types
#    <file> <line> malloc(<number>) returns <pointer>
#    <file> <line> strdup(<number>) returns <pointer>
#    <file> <line> calloc(<number>*<number>) returns <pointer>
#    <file> <line> realloc(<pointer>,<number>) returns <pointer>
#    <file> <line> free(<pointer>)
#
# with optional line on the front saying
#    null pointer is <pointer>
#
# and produces a list of free()s and realloc()s of wrong pointers,
# and also of malloc()s, calloc()s and realloc()s that never get free()d.

$errors=0;

while (<<>>) {
  $in=$out="";
  ($file, $line, $call, $in, $out)=($1,$2,$3,"",$4)
      if /^(\S+) (\S+) (malloc|strdup)\(\S+\) returns (\S+)$/;
  ($file, $line, $call, $in, $out)=($1,$2,"calloc","",$5)
      if /^(\S+) (\S+) calloc\(\S+\*\S+\) returns (\S+)$/;
  ($file, $line, $call, $in, $out)=($1,$2,"realloc",$3,$4)
      if /^(\S+) (\S+) realloc\((\S+),\S+\) returns (\S+)$/;
  ($file, $line, $call, $in, $out)=($1,$2,"free",$3,"")
      if /^(\S+) (\S+) free\((\S+)\)$/;
  $null = $1, next if /^null pointer is (\S+)$/;
  if ($in ne "") {
    if (&null($in)) {
      $bad = "null pointer";
    } elsif (defined $lastalloc{$in}) {
      $bad = "already-freed pointer (last alloc $lastalloc{$in}, last free $lastfree{$in})";
    } else {
      $bad = "bad pointer";
    }
    $errors=1, print "($.) $file:$line: $call() $bad\n"
      if $record{$in} eq "";
    $lastfree{$in}="($.) $file:$line";
    $record{$in}="";
  }
  if ($out ne "" && !&null($out)) {
    $errors=1, print "($.) $file:$line: $call() returned already ".
      "allocated pointer\n" if $record{$out} ne "";
    $record{$out}="($.) $file:$line: $call()";
    $lastalloc{$out}="($.) $file:$line";
  }
}

foreach $i (keys %record) {
  $errors=1, print "$record{$i} never got freed\n"
      if $record{$i} ne "";
}

print "no problems\n" if !$errors;

# determine if a string refers to a null pointer
sub null {
  local ($_) = @_;
  $null ? $_ eq $null : /^((0x)?0+|\(nil\))$/;
}