t/attributes/attribute_traits_registered.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     package My::Attribute::Trait;
  12     use Moose::Role;
  13
  14     has 'alias_to' => (is => 'ro', isa => 'Str');
  15
  16     has foo => ( is => "ro", default => "blah" );
  17
  18     after 'install_accessors' => sub {
  19         my $self = shift;
  20         $self->associated_class->add_method(
  21             $self->alias_to,
  22             $self->get_read_method_ref
  23         );
  24     };
  25
  26     package Moose::Meta::Attribute::Custom::Trait::Aliased;
  27     sub register_implementation { 'My::Attribute::Trait' }
  28 }
  29
  30 {
  31     package My::Other::Attribute::Trait;
  32     use Moose::Role;
  33
  34     my $method = sub {
  35         42;
  36     };
  37
  38     has the_other_attr => ( isa => "Str", is => "rw", default => "oink" );
  39
  40     after 'install_accessors' => sub {
  41         my $self = shift;
  42         $self->associated_class->add_method(
  43             'additional_method',
  44             $method
  45         );
  46     };
  47
  48     package Moose::Meta::Attribute::Custom::Trait::Other;
  49     sub register_implementation { 'My::Other::Attribute::Trait' }
  50 }
  51
  52 {
  53     package My::Class;
  54     use Moose;
  55
  56     has 'bar' => (
  57         traits   => [qw/Aliased/],
  58         is       => 'ro',
  59         isa      => 'Int',
  60         alias_to => 'baz',
  61     );
  62 }
  63
  64 {
  65     package My::Derived::Class;
  66     use Moose;
  67
  68     extends 'My::Class';
  69
  70     has '+bar' => (
  71         traits   => [qw/Other/],
  72     );
  73 }
  74
  75 my $c = My::Class->new(bar => 100);
  76 isa_ok($c, 'My::Class');
  77
  78 is($c->bar, 100, '... got the right value for bar');
  79
  80 can_ok($c, 'baz') and
  81 is($c->baz, 100, '... got the right value for baz');
  82
  83 my $bar_attr = $c->meta->get_attribute('bar');
  84 does_ok($bar_attr, 'My::Attribute::Trait');
  85 is($bar_attr->foo, "blah", "attr initialized");
  86
  87 ok(!$bar_attr->meta->does_role('Aliased'), "does_role ignores aliases for sanity");
  88 ok($bar_attr->does('Aliased'), "attr->does uses aliases");
  89 ok(!$bar_attr->meta->does_role('Fictional'), "does_role returns false for nonexistent roles");
  90 ok(!$bar_attr->does('Fictional'), "attr->does returns false for nonexistent roles");
  91
  92 my $quux = My::Derived::Class->new(bar => 1000);
  93
  94 is($quux->bar, 1000, '... got the right value for bar');
  95
  96 can_ok($quux, 'baz');
  97 is($quux->baz, 1000, '... got the right value for baz');
  98
  99 my $derived_bar_attr = $quux->meta->get_attribute("bar");
 100 does_ok($derived_bar_attr, 'My::Attribute::Trait' );
 101
 102 is( $derived_bar_attr->foo, "blah", "attr initialized" );
 103
 104 does_ok($derived_bar_attr, 'My::Other::Attribute::Trait' );
 105
 106 is($derived_bar_attr->the_other_attr, "oink", "attr initialized" );
 107
 108 ok(!$derived_bar_attr->meta->does_role('Aliased'), "does_role ignores aliases for sanity");
 109 ok($derived_bar_attr->does('Aliased'), "attr->does uses aliases");
 110 ok(!$derived_bar_attr->meta->does_role('Fictional'), "does_role returns false for nonexistent roles");
 111 ok(!$derived_bar_attr->does('Fictional'), "attr->does returns false for nonexistent roles");
 112
 113 can_ok($quux, 'additional_method');
 114 is(eval { $quux->additional_method }, 42, '... got the right value for additional_method');
 115
 116 done_testing;