#!/usr/bin/perl
#
#	Copyright (C) 2000, Andrew Arensburger.
#	You may distribute this file under the terms of the Artistic
#	License, as specified in the README file.
#
# $Id: find-leaks,v 2.2 2000/12/15 06:09:38 arensb Exp $

# This script helps implement a very primitive form of memory allocation.
# See the comments in "config.h.in". Basically, if you configure ColdSync
# with "--with-leak-detection", it'll print a message each time malloc() or
# free() is called. You then run the output of 'coldsync' through this
# script, and it'll (hopefully) give you some clue as to what's being
# leaked where.

# XXX - When adding to the leaks, ought to also mention where it was
# allocated

%alloc = ();
@leaks = ();
while (<>)
{
	if (m{MEM: ([^:]+): (\d+): malloc\((\d+)\) returns (0x[0-9a-fA-F]+)})
	{
		# malloc()
		($file, $line, $size, $ptr) = ($1, $2, $3, $4);

		if (defined($alloc{$ptr}))
		{
			push @leaks, $alloc{$ptr};
		}
		$alloc{$ptr} = [$file, $line, $size];
	} elsif (m{MEM: ([^:]+): (\d+): calloc\((\d+), (\d+)\) returns (0x[0-9a-fA-F]+)})
	{
		# calloc()
		($file, $line, $num, $size, $ptr) = ($1, $2, $3, $4, $5);

		if (defined($alloc{$ptr}))
		{
			push @leaks, $alloc{$ptr};
		}
		$alloc{$ptr} = [$file, $line, $num * $size];
	} elsif (m{MEM: ([^:]+): (\d+): realloc\((0x[0-9a-fA-F]+), (\d+)\) returns (0x[0-9a-fA-F]+)})
	{
		# realloc(). Note that realloc() might not return the
		# pointer that it was passed, but this does not constitute
		# a leak.
		delete $alloc{$3};
		$alloc{$5} = [$1, $2, $4];
	} elsif (m{MEM: ([^:]+): (\d+): strdup\(([^\)]*)\) returns (0x[0-9a-fA-F]+)})
	{
		if (defined($alloc{$4}))
		{
			push @leaks, $alloc{$4};
		}
		$alloc{$4} = [$1, $2, length($3)];
	} elsif (m{MEM: ([^:]+): (\d+): free\((0x[0-9a-fA-F]+)\)})
	{
		# free()
		if (!defined($alloc{$3}))
		{
			print "Freeing unallocated memory: $1: $2 ($3)\n";
		}
		delete $alloc{$3};
	}
}

print "Leaks:\n";
for $value (@leaks)
{
	($file, $line, $size) = @$value;

	print "$size bytes at $file: $line\n";
}
while (($key, $value) = each %alloc)
{
	($file, $line, $size) = @$value;

	print "$size bytes at $file: $line\n";
}

# This is for Emacs's benefit:
# Local Variables:	***
# fill-column:	75	***
# End:			***
#