File: memdebug

package info (click to toggle)
gpsbabel 1.2.4-2
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 5,660 kB
  • ctags: 3,780
  • sloc: ansic: 38,884; makefile: 333; pascal: 302; perl: 212; xml: 84; tcl: 74; sh: 20; objc: 7
file content (71 lines) | stat: -rwxr-xr-x 1,722 bytes parent folder | download
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
62
63
64
65
66
67
68
69
70
71
#!/usr/bin/perl

sub alloc {
    my $addr = shift;
    my $file = shift;
    my $line = shift;

    if ( $arena{$addr} ) {
        ($ofile,$oline) = @{$arena{$addr}};
        print( "duplicate allocation $addr at $file $line\n  allocated at $ofile $oline\n" );
    }
    $arena{$addr} = [$file,$line];
}

sub free {
    my $addr = shift;
    my $file = shift;
    my $line = shift;
    
    if ( $arena{$addr} ) {
        $freed{$addr} = [$arena{$addr}->[0], $arena{$addr}->[1], $file, $line];
        delete $arena{$addr};
    }
    else {
        if ($freed{$addr}) {
            ($afile,$aline,$ffile,$fline) = @{$freed{$addr}};
            print( "double free $addr at $file $line\n  allocated at $afile $aline\n  last freed at $ffile $fline\n" );
        }
        else {
            print( "freeing unallocated $addr at $file $line\n" );
        }
    }
}

sub unfreed {
    for $addr (keys %arena) {
        ($file,$line)=@{$arena{$addr}};
        print( "unfreed $addr allocated at $file $line\n" );
    }
    undef %arena;
    undef %freed;
}

open(FILE, "</tmp/gpsbabel.debug");

while (<FILE>) {
    chomp; 
    @args = split(', ',$_);
    if ($args[0] eq 'malloc') {
        &alloc($args[1], $args[3], $args[4]);
    }
    if ($args[0] eq 'calloc') {
        &alloc($args[1], $args[4], $args[5]);
    }
    if ($args[0] eq 'strdup') {
        &alloc($args[1], $args[3], $args[4]);
    }
    if ($args[0] eq 'realloc') {
        &free($args[2], $args[4], $args[5]);
        &alloc($args[1], $args[4], $args[5]);
    }
    if ($args[0] eq 'free') {
        &free($args[1], $args[2], $args[3]);
    }
    if ($args[0] =~ m/^command/) {
        &unfreed;
        print "$args[0]\n";
    }
}
&unfreed;
close(FILE);