t/020_attributes/016_attribute_traits_registered.t

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