t/050_metaclasses/013_metaclass_traits.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 28;
   7 use Test::Exception;
   8
   9 {
  10     package My::SimpleTrait;
  11
  12     use Moose::Role;
  13
  14     sub simple { return 5 }
  15 }
  16
  17 {
  18     package Foo;
  19
  20     use Moose -traits => [ 'My::SimpleTrait' ];
  21 }
  22
  23 can_ok( Foo->meta(), 'simple' );
  24 is( Foo->meta()->simple(), 5,
  25     'Foo->meta()->simple() returns expected value' );
  26
  27 {
  28     package Bar;
  29
  30     use Moose -traits => 'My::SimpleTrait';
  31 }
  32
  33 can_ok( Bar->meta(), 'simple' );
  34 is( Bar->meta()->simple(), 5,
  35     'Foo->meta()->simple() returns expected value' );
  36
  37 {
  38     package My::SimpleTrait2;
  39
  40     use Moose::Role;
  41
  42     # This needs to happen at compile time so it happens before we
  43     # apply traits to Bar
  44     BEGIN {
  45         has 'attr' =>
  46             ( is      => 'ro',
  47               default => 'something',
  48             );
  49     }
  50
  51     sub simple { return 5 }
  52 }
  53
  54 {
  55     package Bar;
  56
  57     use Moose -traits => [ 'My::SimpleTrait2' ];
  58 }
  59
  60 can_ok( Bar->meta(), 'simple' );
  61 is( Bar->meta()->simple(), 5,
  62     'Bar->meta()->simple() returns expected value' );
  63 can_ok( Bar->meta(), 'attr' );
  64 is( Bar->meta()->attr(), 'something',
  65     'Bar->meta()->attr() returns expected value' );
  66
  67 {
  68     package My::SimpleTrait3;
  69
  70     use Moose::Role;
  71
  72     BEGIN {
  73         has 'attr2' =>
  74             ( is      => 'ro',
  75               default => 'something',
  76             );
  77     }
  78
  79     sub simple2 { return 55 }
  80 }
  81
  82 {
  83     package Baz;
  84
  85     use Moose -traits => [ 'My::SimpleTrait2', 'My::SimpleTrait3' ];
  86 }
  87
  88 can_ok( Baz->meta(), 'simple' );
  89 is( Baz->meta()->simple(), 5,
  90     'Baz->meta()->simple() returns expected value' );
  91 can_ok( Baz->meta(), 'attr' );
  92 is( Baz->meta()->attr(), 'something',
  93     'Baz->meta()->attr() returns expected value' );
  94 can_ok( Baz->meta(), 'simple2' );
  95 is( Baz->meta()->simple2(), 55,
  96     'Baz->meta()->simple2() returns expected value' );
  97 can_ok( Baz->meta(), 'attr2' );
  98 is( Baz->meta()->attr2(), 'something',
  99     'Baz->meta()->attr2() returns expected value' );
 100
 101 {
 102     package My::Trait::AlwaysRO;
 103
 104     use Moose::Role;
 105
 106     around '_process_new_attribute', '_process_inherited_attribute' =>
 107         sub {
 108             my $orig = shift;
 109             my ( $self, $name, %args ) = @_;
 110
 111             $args{is} = 'ro';
 112
 113             return $self->$orig( $name, %args );
 114         };
 115 }
 116
 117 {
 118     package Quux;
 119
 120     use Moose -traits => [ 'My::Trait::AlwaysRO' ];
 121
 122     has 'size' =>
 123         ( is  => 'rw',
 124           isa => 'Int',
 125         );
 126 }
 127
 128 ok( Quux->meta()->has_attribute('size'),
 129     'Quux has size attribute' );
 130 ok( ! Quux->meta()->get_attribute('size')->writer(),
 131     'size attribute does not have a writer' );
 132
 133 {
 134     package My::Class::Whatever;
 135
 136     use Moose::Role;
 137
 138     sub whatever { 42 }
 139
 140     package Moose::Meta::Class::Custom::Trait::Whatever;
 141
 142     sub register_implementation {
 143         return 'My::Class::Whatever';
 144     }
 145 }
 146
 147 {
 148     package RanOutOfNames;
 149
 150     use Moose -traits => [ 'Whatever' ];
 151 }
 152
 153 ok( RanOutOfNames->meta()->meta()->has_method('whatever'),
 154     'RanOutOfNames->meta() has whatever method' );
 155
 156 {
 157     package Role::Foo;
 158
 159     use Moose::Role -traits => [ 'My::SimpleTrait' ];
 160 }
 161
 162 can_ok( Role::Foo->meta(), 'simple' );
 163 is( Role::Foo->meta()->simple(), 5,
 164     'Role::Foo->meta()->simple() returns expected value' );
 165
 166 {
 167     require Moose::Util::TypeConstraints;
 168     dies_ok( sub { Moose::Util::TypeConstraints->import( -traits => 'My::SimpleTrait' ) },
 169              'cannot provide -traits to an exporting module that does not init_meta' );
 170     like( $@, qr/does not have an init_meta/,
 171           '... and error provides a useful explanation' );
 172 }
 173
 174 SKIP:
 175 {
 176     skip 'This will blow up until Moose::Meta::Class->_fix_metaclass_incompatibility understands roles', 5;
 177 {
 178     package Foo::Subclass;
 179
 180     use Moose -traits => [ 'My::SimpleTrait3' ];
 181
 182     extends 'Foo';
 183 }
 184
 185 can_ok( Foo::Subclass->meta(), 'simple' );
 186 is( Foo::Subclass->meta()->simple(), 5,
 187     'Foo::Subclass->meta()->simple() returns expected value' );
 188 is( Foo::Subclass->meta()->simple2(), 55,
 189     'Foo::Subclass->meta()->simple2() returns expected value' );
 190 can_ok( Foo::Subclass->meta(), 'attr2' );
 191 is( Foo::Subclass->meta()->attr2(), 'something',
 192     'Foo::Subclass->meta()->attr2() returns expected value' );
 193 }