michael@0: #!/usr/bin/perl -w
michael@0: #
michael@0: # This Source Code Form is subject to the terms of the Mozilla Public
michael@0: # License, v. 2.0. If a copy of the MPL was not distributed with this
michael@0: # file, You can obtain one at http://mozilla.org/MPL/2.0/.
michael@0: 
michael@0: # Script loosely based on Chris Waterson's find-leakers.pl and make-tree.pl
michael@0: 
michael@0: use 5.004;
michael@0: use strict;
michael@0: use Getopt::Long;
michael@0: 
michael@0: # GetOption will create $opt_object, so ignore the
michael@0: # warning that gets spit out about those vbls.
michael@0: GetOptions("object=s", "list", "help");
michael@0: 
michael@0: # use $::opt_help twice to eliminate warning...
michael@0: ($::opt_help) && ($::opt_help) && die qq{
michael@0: usage: find-comptr-leakers.pl < logfile
michael@0:   --object <obj>		 Examine only object <obj>
michael@0:   --list				 Only list leaked objects
michael@0:   --help				 This message :-)
michael@0: };
michael@0: 
michael@0: if ($::opt_object) {
michael@0: 	warn "Examining only object $::opt_object (THIS IS BROKEN)\n";
michael@0: } else {
michael@0: 	warn "Examining all objects\n";
michael@0: }
michael@0: 
michael@0: my %allocs = ( );
michael@0: my %counter;
michael@0: my $id = 0;
michael@0: 
michael@0: my $accumulating = 0;
michael@0: my $savedata = 0;
michael@0: my $class;
michael@0: my $obj;
michael@0: my $sno;
michael@0: my $op;
michael@0: my $cnt;
michael@0: my $ptr;
michael@0: my $strace;
michael@0: 
michael@0: sub save_data {
michael@0: 	# save the data
michael@0: 	if ($op eq 'nsCOMPtrAddRef') {
michael@0: 		push @{ $allocs{$sno}->{$ptr} }, [ +1, $strace ];
michael@0: 	}
michael@0: 	elsif ($op eq 'nsCOMPtrRelease') {
michael@0: 		push @{ $allocs{$sno}->{$ptr} }, [ -1, $strace ];
michael@0: 		my $sum = 0;
michael@0: 		my @ptrallocs = @{ $allocs{$sno}->{$ptr} };
michael@0: 		foreach my $alloc (@ptrallocs) {
michael@0: 			$sum += @$alloc[0];
michael@0: 		}
michael@0: 		if ( $sum == 0 ) {
michael@0: 			delete($allocs{$sno}{$ptr});
michael@0: 		}
michael@0: 	}
michael@0: }
michael@0: 
michael@0: LINE: while (<>) {
michael@0: 	if (/^</) {
michael@0: 		chop; # avoid \n in $ptr
michael@0: 		my @fields = split(/ /, $_);
michael@0: 
michael@0: 		($class, $obj, $sno, $op, $cnt, $ptr) = @fields;
michael@0: 
michael@0: 		$strace = "";
michael@0: 
michael@0: 		if ($::opt_list) {
michael@0: 			save_data();
michael@0: 		} elsif (!($::opt_object) || ($::opt_object eq $obj)) {
michael@0: 			$accumulating = 1;
michael@0: 		}
michael@0: 	} elsif ( $accumulating == 1 ) {
michael@0: 		if ( /^$/ ) {
michael@0: 			# if line is empty
michael@0: 			$accumulating = 0;
michael@0: 			save_data();
michael@0: 		} else {
michael@0: 			$strace = $strace . $_;
michael@0: 		}
michael@0: 	}
michael@0: }
michael@0: if ( $accumulating == 1) {
michael@0: 	save_data();
michael@0: }
michael@0: 
michael@0: foreach my $serial (keys(%allocs)) {
michael@0: 	foreach my $comptr (keys( %{$allocs{$serial}} )) {
michael@0: 		my $sum = 0;
michael@0: 		my @ptrallocs = @{ $allocs{$serial}->{$comptr} };
michael@0: 		foreach my $alloc (@ptrallocs) {
michael@0: 			$sum += @$alloc[0];
michael@0: 		}
michael@0: 		print "Object ", $serial, " held by ", $comptr, " is ", $sum, " out of balance.\n";
michael@0: 		unless ($::opt_list) {
michael@0: 			print "\n";
michael@0: 			foreach my $alloc (@ptrallocs) {
michael@0: 				if (@$alloc[0] == +1) {
michael@0: 					print "Put into nsCOMPtr at:\n";
michael@0: 				} elsif (@$alloc[0] == -1) {
michael@0: 					print "Released from nsCOMPtr at:\n";
michael@0: 				}
michael@0: 				print @$alloc[1]; # the stack trace
michael@0: 				print "\n";
michael@0: 			}
michael@0: 			print "\n\n";
michael@0: 		}
michael@0: 	}
michael@0: }
michael@0: