The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!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";