t/attributes/attribute_traits_n_meta.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Moose;
   8
   9
  10
  11 {
  12     package My::Meta::Attribute::DefaultReadOnly;
  13     use Moose;
  14
  15     extends 'Moose::Meta::Attribute';
  16
  17     around 'new' => sub {
  18         my $next = shift;
  19         my ($self, $name, %options) = @_;
  20         $options{is} = 'ro'
  21             unless exists $options{is};
  22         $next->($self, $name, %options);
  23     };
  24 }
  25
  26 {
  27     package My::Attribute::Trait;
  28     use Moose::Role;
  29
  30     has 'alias_to' => (is => 'ro', isa => 'Str');
  31
  32     after 'install_accessors' => sub {
  33         my $self = shift;
  34         $self->associated_class->add_method(
  35             $self->alias_to,
  36             $self->get_read_method_ref
  37         );
  38     };
  39 }
  40
  41 {
  42     package My::Class;
  43     use Moose;
  44
  45     has 'bar' => (
  46         metaclass => 'My::Meta::Attribute::DefaultReadOnly',
  47         traits    => [qw/My::Attribute::Trait/],
  48         isa       => 'Int',
  49         alias_to  => 'baz',
  50     );
  51 }
  52
  53 my $c = My::Class->new(bar => 100);
  54 isa_ok($c, 'My::Class');
  55
  56 is($c->bar, 100, '... got the right value for bar');
  57
  58 can_ok($c, 'baz');
  59 is($c->baz, 100, '... got the right value for baz');
  60
  61 isa_ok($c->meta->get_attribute('bar'), 'My::Meta::Attribute::DefaultReadOnly');
  62 does_ok($c->meta->get_attribute('bar'), 'My::Attribute::Trait');
  63 is($c->meta->get_attribute('bar')->_is_metadata, 'ro', '... got the right metaclass customization');
  64
  65 done_testing;