#!perl
use strict;
use Test::More tests => 42;
for my $class (qw(Class::Accessor Class::Accessor::Fast Class::Accessor::Faster)) {
require_ok($class);
my $silly = "Silly::$class";
{
no strict 'refs';
@{"${silly}::ISA"} = ($class);
*{"${silly}::car"} = sub { shift->_car_accessor(@_); };
*{"${silly}::mar"} = sub { return "Overloaded"; };
$silly->mk_accessors(qw( foo bar yar car mar ));
$silly->mk_ro_accessors(qw(static unchanged));
$silly->mk_wo_accessors(qw(sekret double_sekret));
}
my $test = $silly->new({
static => "variable",
unchanged => "dynamic",
});
$test->foo(42);
$test->bar('Meep');
is($test->foo, 42, "foo accessor");
is($test->{foo}, 42, "foo hash element") unless $class eq 'Class::Accessor::Faster';
is($test->static, 'variable', 'ro accessor');
eval { $test->static('foo'); };
like(scalar $@,
qr/^'main' cannot alter the value of 'static' on objects of class '$silly'/,
'ro accessor write protection');
$test->double_sekret(1001001);
is( $test->{double_sekret}, 1001001, 'wo accessor') unless $class eq 'Class::Accessor::Faster';
eval { () = $test->double_sekret; };
like(scalar $@,
qr/^'main' cannot access the value of 'double_sekret' on objects of class '$silly'/,
'wo accessor read protection' );
is($test->_foo_accessor, 42, 'accessor alias');
$test->car("AMC Javalin");
is($test->car, 'AMC Javalin', 'internal override access');
is($test->mar, 'Overloaded', 'internal override constant');
# Make sure bogus accessors die.
eval { $test->gargle() };
ok($@, 'bad accessor');
# Test that the accessor works properly in list context with a single arg.
my $test2 = $silly->new;
my @args = ($test2->foo, $test2->bar);
is(@args, 2, 'accessor get in list context');
# test array setters
$test->foo(qw(1 2 3));
is_deeply($test->foo, [qw(1 2 3)], "set an array ref via foo accessor");
$test->sekret(qw(1 2 3));
is_deeply($test->{'sekret'}, [qw(1 2 3)], "array ref")
unless $class eq 'Class::Accessor::Faster';
{
my $eeek;
local $SIG{__WARN__} = sub { $eeek = shift };
$silly->mk_accessors(qw(DESTROY));
like($eeek,
qr/a data accessor named DESTROY/i,
'mk DESTROY accessor warning');
};
}