File Coverage

blib/lib/Memchmark.pm

Criterion	Covered	Total	%
statement	21	54	38.8
branch	0	14	0.0
condition	0	8	0.0
subroutine	7	11	63.6
pod	2	2	100.0
total	30	89	33.7

package Memchmark;

our $VERSION = '0.01';

use 5.008;

use strict;
use warnings;

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(memchmark cmpthese);

use Carp;
use Proc::ProcessTable;
use POSIX qw(:sys_wait_h);
use Time::HiRes qw(usleep);

sub _find_process {
    my $pid = shift || $$;
    my $p=Proc::ProcessTable->new;
    for (@{$p->table}) {
	return $_ if $_->pid == $pid;
    }
}

sub memchmark (&) {
    my $sub = shift;
    ref $sub eq 'CODE'
	or croak "invalid type for memchmark arg ($sub), CODE ref expected";
    my $size0 = _find_process->size;
    my $pid = fork;

    if (defined $pid and $pid==0) {
	eval { &$sub() };
	$@ and print STDERR $@;
	sleep 1;
	exit(0);
    }
    defined $pid or croak "unable to fork";

    my $ecode;
    my $size1 = $size0;
    do {
	usleep(100000);
	my $size = _find_process($pid)->size;
	$size1 = $size if $size > $size1;
	$ecode = waitpid($pid, WNOHANG);
    } until $ecode > 0;
    return $size1-$size0;
}

sub cmpthese {
    my %test = @_;
    my $init = delete $test{-init} || sub {};
    my $size0 = &memchmark($init);
    my %size;
    for my $test (sort keys %test) {
	$test=~/^-/ and croak "invalid test name";
	$size{$test} = &memchmark($test{$test}) - $size0;
	print "test: $test, memory used: $size{$test} bytes\n";
    }
}

1;

__END__