t/attributes/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 MooseX::SomeAwesomeDBFields;
  16
  17     # implementation of methods not called in the example deliberately
  18     # omitted
  19
  20     use Moose::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 Moose;
  61     use Moose::Util::MetaRole;
  62
  63     use Test::More;
  64     use Test::Fatal;
  65
  66     Moose::Util::MetaRole::apply_metaroles(
  67         for             => __PACKAGE__,
  68         class_metaroles => { instance => ['MooseX::SomeAwesomeDBFields'] },
  69     );
  70
  71     is( exception {
  72         has lazy_attr => (
  73             is      => 'ro',
  74             isa     => 'Bool',
  75             lazy    => 1,
  76             default => sub {0},
  77         );
  78     }, undef, "Adding lazy accessor does not use inline_slot_access" );
  79
  80     is( exception {
  81         has rw_attr => (
  82             is => 'rw',
  83         );
  84     }, undef, "Adding read-write accessor does not use inline_slot_access" );
  85
  86     is( exception { __PACKAGE__->meta->make_immutable; }, undef, "Inling constructor does not use inline_slot_access" );
  87
  88     done_testing;
  89 }