t/020_attributes/028_no_slot_access.t

   1 #!/usr/bin/perl
   2
   3 package SomeAwesomeDB;
   4
   5 sub new_row { }
   6 sub read { }
   7 sub write { }
   8
   9 package MooseX::SomeAwesomeDBFields;
  10
  11 use Moose::Role;
  12
  13 sub inline_create_instance {
  14     my ($self, $classvar) = @_;
  15
  16     "bless SomeAwesomeDB::new_row(), $classvar";
  17 }
  18
  19 sub inline_get_slot_value {
  20     my ($self, $invar, $slot) = @_;
  21
  22     "SomeAwesomeDB::read($invar, \"$slot\")";
  23 }
  24
  25 sub inline_set_slot_value {
  26     my ($self, $invar, $slot, $valexp) = @_;
  27
  28     "SomeAwesomeDB::write($invar, \"$slot\", $valexp)";
  29 }
  30
  31 sub inline_is_slot_initialized {
  32     my ($self, $invar, $slot) = @_;
  33
  34     "1";
  35 }
  36
  37 sub inline_initialize_slot {
  38     my ($self, $invar, $slot) = @_;
  39
  40     "";
  41 }
  42
  43 sub inline_slot_access {
  44     die "inline_slot_access should not have been used";
  45 }
  46
  47 # implementation of methods not called in the example deliberately
  48 # omitted
  49
  50 package Toy;
  51
  52 use Moose;
  53 use Moose::Util::MetaRole;
  54
  55 use Test::More tests => 3;
  56 use Test::Exception;
  57
  58 Moose::Util::MetaRole::apply_metaclass_roles
  59     (for_class  => __PACKAGE__,
  60      instance_metaclass_roles => [ 'MooseX::SomeAwesomeDBFields' ]);
  61
  62 lives_ok {
  63     has lazy_attr => (
  64         is  => 'ro',
  65         isa => 'Bool',
  66         lazy => 1,
  67         default => sub { 0 },
  68     );
  69 } "Adding lazy accessor does not use inline_slot_access";
  70
  71 lives_ok {
  72     has rw_attr => (
  73         is => 'rw',
  74     );
  75 } "Adding read-write accessor does not use inline_slot_access";
  76
  77 lives_ok { __PACKAGE__->meta->make_immutable; }
  78     "Inling constructor does not use inline_slot_access";