tools/rb/find-leakers.pl

changeset 0
6474c204b198
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/tools/rb/find-leakers.pl	Wed Dec 31 06:09:35 2014 +0100
     1.3 @@ -0,0 +1,62 @@
     1.4 +#!/usr/bin/perl -w
     1.5 +#
     1.6 +# This Source Code Form is subject to the terms of the Mozilla Public
     1.7 +# License, v. 2.0. If a copy of the MPL was not distributed with this
     1.8 +# file, You can obtain one at http://mozilla.org/MPL/2.0/.
     1.9 +
    1.10 +use strict;
    1.11 +
    1.12 +my %allocs;
    1.13 +my %classes;
    1.14 +my %counter;
    1.15 +
    1.16 +LINE: while (<>) {
    1.17 +    next LINE if (! /^</);
    1.18 +
    1.19 +    my @fields = split(/ /, $_);
    1.20 +    my $class = shift(@fields);
    1.21 +    my $obj   = shift(@fields);
    1.22 +    my $sno   = shift(@fields);
    1.23 +    my $op    = shift(@fields);
    1.24 +    my $cnt   = shift(@fields);
    1.25 +
    1.26 +    # for AddRef/Release $cnt is the refcount, for Ctor/Dtor it's the size
    1.27 +
    1.28 +    if ($op eq 'AddRef' && $cnt == 1) {
    1.29 +        # Example: <nsStringBuffer> 0x01AFD3B8 1 AddRef 1
    1.30 +
    1.31 +        $allocs{$obj} = ++$counter{$class}; # the order of allocation
    1.32 +        $classes{$obj} = $class;
    1.33 +    }
    1.34 +    elsif ($op eq 'Release' && $cnt == 0) {
    1.35 +        # Example: <nsStringBuffer> 0x01AFD3B8 1 Release 0
    1.36 +
    1.37 +        delete($allocs{$obj});
    1.38 +        delete($classes{$obj});
    1.39 +    }
    1.40 +    elsif ($op eq 'Ctor') {
    1.41 +        # Example: <PStreamNotifyParent> 0x08880BD0 8 Ctor (20)
    1.42 +
    1.43 +        $allocs{$obj} = ++$counter{$class};
    1.44 +        $classes{$obj} = $class;
    1.45 +    }
    1.46 +    elsif ($op eq 'Dtor') {
    1.47 +        # Example: <PStreamNotifyParent> 0x08880BD0 8 Dtor (20)
    1.48 +
    1.49 +        delete($allocs{$obj});
    1.50 +        delete($classes{$obj});
    1.51 +    }
    1.52 +}
    1.53 +
    1.54 +
    1.55 +sub sort_by_value {
    1.56 +    my %x = @_;
    1.57 +    sub _by_value($) { my %x = @_; $x{$a} cmp $x{$b}; } 
    1.58 +    sort _by_value keys(%x);
    1.59 +} 
    1.60 +
    1.61 +
    1.62 +foreach my $key (&sort_by_value(%allocs)) {
    1.63 +    # Example: 0x03F1D818 (2078) @ <nsStringBuffer>
    1.64 +    print "$key (", $allocs{$key}, ") @ ", $classes{$key}, "\n";
    1.65 +}

mercurial