Changes for avoiding inline_slot_access

[gitmo/Moose.git] / t / 020_attributes / 028_no_slot_access.t

#!/usr/bin/perl

package SomeAwesomeDB;

sub new_row { }
sub read { }
sub write { }

package MooseX::SomeAwesomeDBFields;

use Moose::Role;

sub inline_create_instance {
    my ($self, $classvar) = @_;

    "bless SomeAwesomeDB::new_row(), $classvar";
}

sub inline_get_slot_value {
    my ($self, $invar, $slot) = @_;

    "SomeAwesomeDB::read($invar, \"$slot\")";
}

sub inline_set_slot_value {
    my ($self, $invar, $slot, $valexp) = @_;

    "SomeAwesomeDB::write($invar, \"$slot\", $valexp)";
}

sub inline_is_slot_initialized {
    my ($self, $invar, $slot) = @_;

    "1";
}

sub inline_initialize_slot {
    my ($self, $invar, $slot) = @_;

    "";
}

sub inline_slot_access {
    die "inline_slot_access should not have been used";
}

# implementation of methods not called in the example deliberately
# omitted

package Toy;

use Moose;
use Moose::Util::MetaRole;

use Test::More tests => 3;
use Test::Exception;

Moose::Util::MetaRole::apply_metaclass_roles
    (for_class  => __PACKAGE__,
     instance_metaclass_roles => [ 'MooseX::SomeAwesomeDBFields' ]);

lives_ok {
    has lazy_attr => (
        is  => 'ro',
        isa => 'Bool',
        lazy => 1,
        default => sub { 0 },
    );
} "Adding lazy accessor does not use inline_slot_access";

lives_ok {
    has rw_attr => (
        is => 'rw',
    );
} "Adding read-write accessor does not use inline_slot_access";

lives_ok { __PACKAGE__->meta->make_immutable; }
    "Inling constructor does not use inline_slot_access";