t/020_attributes/failing/028_no_slot_access.t

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