#!perl
use strict;
use Test::More;
unless (eval {require Sub::Name}) {
plan skip_all => "Sub::Name is not installed";
exit 0;
}
plan tests => 6;
require_ok("Class::Accessor");
require_ok("Class::Accessor::Fast");
package Foo;
our @ISA = qw(Class::Accessor);
sub get {
my ($self, $key) = @_;
my @c = caller(1);
main::is $c[3], "Foo::$key", "correct name for Foo sub $key";
return $self->SUPER::get($key);
}
__PACKAGE__->mk_accessors(qw( foo ));
package Tricky;
require Tie::Hash;
our @ISA = qw(Tie::StdHash);
sub FETCH {
my ($self, $key) = @_;
my @c = caller(1);
main::is $c[3], "Bar::$key", "correct name for Bar sub $key";
return $self->SUPER::FETCH($key);
}
package Bar;
our @ISA = qw(Class::Accessor::Fast);
sub new {
my ($class, $init) = @_;
my %store;
tie %store, "Tricky";
%store = %$init;
bless \%store, $class;
}
__PACKAGE__->mk_accessors(qw( bar ));
package main;
my $foo = Foo->new({ foo => 12345 });
is $foo->foo, 12345, "get initial foo";
my $bar = Bar->new({ bar => 54321 });
is $bar->bar, 54321, "get initial bar";