t/020_attributes/016_attribute_traits_registered.t

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