accessors.t   [plain text]

#!perl
use strict;
use Test::More tests => 37;

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');

    {
        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');
    };

}