The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use Test::More tests => 6;

BEGIN { use_ok('Attribute::Profiled') }

package Catch;
sub TIEHANDLE {
    my $class = shift;
    bless { caught => '' }, $class;
}

sub PRINTF {
    my($self, $fmt, @list) = @_;
    $self->{caught} .= sprintf $fmt, @list;
}

sub PRINT {
    my($self, @list) = @_;
    $self->{caught} .= "@list";
}


package SomeClass;

sub new {
    bless {}, shift;
}

sub method : Profiled {
    my $self = shift;
    return 'foo';
}

sub method2 : Profiled {
    my $self = shift;
    return (1, 2, 3);
}

sub method3 : Profiled {
    my $self = shift;
    return scalar caller;
}

package main;

my $catch = tie *STDERR, 'Catch';

my $foo = SomeClass->new;
is $foo->method, 'foo', 'retvalue preserved';

$foo->method for (1..10);

my @ret = $foo->method2;
ok eq_array(\@ret, [ 1, 2, 3 ]), 'wantarray check';

my $caller = $foo->method3;
is $caller, __PACKAGE__, 'caller preserved';


undef $Attribute::Profiled::_Profiler;

like $catch->{caught}, qr/11 trials of SomeClass::method/, '11 method';
like $catch->{caught}, qr/1 trial of SomeClass::method2/, '1 method2';