t/metaclasses/metaclass_traits.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use lib 't/lib', 'lib';
   7
   8 use Test::More;
   9 use Test::Fatal;
  10
  11 {
  12     package My::SimpleTrait;
  13
  14     use Moose::Role;
  15
  16     sub simple { return 5 }
  17 }
  18
  19 {
  20     package Foo;
  21
  22     use Moose -traits => [ 'My::SimpleTrait' ];
  23 }
  24
  25 can_ok( Foo->meta(), 'simple' );
  26 is( Foo->meta()->simple(), 5,
  27     'Foo->meta()->simple() returns expected value' );
  28
  29 {
  30     package Bar;
  31
  32     use Moose -traits => 'My::SimpleTrait';
  33 }
  34
  35 can_ok( Bar->meta(), 'simple' );
  36 is( Bar->meta()->simple(), 5,
  37     'Foo->meta()->simple() returns expected value' );
  38
  39 {
  40     package My::SimpleTrait2;
  41
  42     use Moose::Role;
  43
  44     # This needs to happen at compile time so it happens before we
  45     # apply traits to Bar
  46     BEGIN {
  47         has 'attr' =>
  48             ( is      => 'ro',
  49               default => 'something',
  50             );
  51     }
  52
  53     sub simple { return 5 }
  54 }
  55
  56 {
  57     package Bar;
  58
  59     use Moose -traits => [ 'My::SimpleTrait2' ];
  60 }
  61
  62 can_ok( Bar->meta(), 'simple' );
  63 is( Bar->meta()->simple(), 5,
  64     'Bar->meta()->simple() returns expected value' );
  65 can_ok( Bar->meta(), 'attr' );
  66 is( Bar->meta()->attr(), 'something',
  67     'Bar->meta()->attr() returns expected value' );
  68
  69 {
  70     package My::SimpleTrait3;
  71
  72     use Moose::Role;
  73
  74     BEGIN {
  75         has 'attr2' =>
  76             ( is      => 'ro',
  77               default => 'something',
  78             );
  79     }
  80
  81     sub simple2 { return 55 }
  82 }
  83
  84 {
  85     package Baz;
  86
  87     use Moose -traits => [ 'My::SimpleTrait2', 'My::SimpleTrait3' ];
  88 }
  89
  90 can_ok( Baz->meta(), 'simple' );
  91 is( Baz->meta()->simple(), 5,
  92     'Baz->meta()->simple() returns expected value' );
  93 can_ok( Baz->meta(), 'attr' );
  94 is( Baz->meta()->attr(), 'something',
  95     'Baz->meta()->attr() returns expected value' );
  96 can_ok( Baz->meta(), 'simple2' );
  97 is( Baz->meta()->simple2(), 55,
  98     'Baz->meta()->simple2() returns expected value' );
  99 can_ok( Baz->meta(), 'attr2' );
 100 is( Baz->meta()->attr2(), 'something',
 101     'Baz->meta()->attr2() returns expected value' );
 102
 103 {
 104     package My::Trait::AlwaysRO;
 105
 106     use Moose::Role;
 107
 108     around '_process_new_attribute', '_process_inherited_attribute' =>
 109         sub {
 110             my $orig = shift;
 111             my ( $self, $name, %args ) = @_;
 112
 113             $args{is} = 'ro';
 114
 115             return $self->$orig( $name, %args );
 116         };
 117 }
 118
 119 {
 120     package Quux;
 121
 122     use Moose -traits => [ 'My::Trait::AlwaysRO' ];
 123
 124     has 'size' =>
 125         ( is  => 'rw',
 126           isa => 'Int',
 127         );
 128 }
 129
 130 ok( Quux->meta()->has_attribute('size'),
 131     'Quux has size attribute' );
 132 ok( ! Quux->meta()->get_attribute('size')->writer(),
 133     'size attribute does not have a writer' );
 134
 135 {
 136     package My::Class::Whatever;
 137
 138     use Moose::Role;
 139
 140     sub whatever { 42 }
 141
 142     package Moose::Meta::Class::Custom::Trait::Whatever;
 143
 144     sub register_implementation {
 145         return 'My::Class::Whatever';
 146     }
 147 }
 148
 149 {
 150     package RanOutOfNames;
 151
 152     use Moose -traits => [ 'Whatever' ];
 153 }
 154
 155 ok( RanOutOfNames->meta()->meta()->has_method('whatever'),
 156     'RanOutOfNames->meta() has whatever method' );
 157
 158 {
 159     package Role::Foo;
 160
 161     use Moose::Role -traits => [ 'My::SimpleTrait' ];
 162 }
 163
 164 can_ok( Role::Foo->meta(), 'simple' );
 165 is( Role::Foo->meta()->simple(), 5,
 166     'Role::Foo->meta()->simple() returns expected value' );
 167
 168 {
 169     require Moose::Util::TypeConstraints;
 170     like(
 171         exception {
 172             Moose::Util::TypeConstraints->import(
 173                 -traits => 'My::SimpleTrait' );
 174         },
 175         qr/does not have an init_meta/,
 176         'cannot provide -traits to an exporting module that does not init_meta'
 177     );
 178 }
 179
 180 {
 181     package Foo::Subclass;
 182
 183     use Moose -traits => [ 'My::SimpleTrait3' ];
 184
 185     extends 'Foo';
 186 }
 187
 188 can_ok( Foo::Subclass->meta(), 'simple' );
 189 is( Foo::Subclass->meta()->simple(), 5,
 190     'Foo::Subclass->meta()->simple() returns expected value' );
 191 is( Foo::Subclass->meta()->simple2(), 55,
 192     'Foo::Subclass->meta()->simple2() returns expected value' );
 193 can_ok( Foo::Subclass->meta(), 'attr2' );
 194 is( Foo::Subclass->meta()->attr2(), 'something',
 195     'Foo::Subclass->meta()->attr2() returns expected value' );
 196
 197 {
 198
 199     package Class::WithAlreadyPresentTrait;
 200     use Moose -traits => 'My::SimpleTrait';
 201
 202     has an_attr => ( is => 'ro' );
 203 }
 204
 205 is( exception {
 206     my $instance = Class::WithAlreadyPresentTrait->new( an_attr => 'value' );
 207     is( $instance->an_attr, 'value', 'Can get value' );
 208 }, undef, 'Can create instance and access attributes' );
 209
 210 {
 211
 212     package Class::WhichLoadsATraitFromDisk;
 213
 214     # Any role you like here, the only important bit is that it gets
 215     # loaded from disk and has not already been defined.
 216     use Moose -traits => 'Role::Parent';
 217
 218     has an_attr => ( is => 'ro' );
 219 }
 220
 221 is( exception {
 222     my $instance = Class::WhichLoadsATraitFromDisk->new( an_attr => 'value' );
 223     is( $instance->an_attr, 'value', 'Can get value' );
 224 }, undef, 'Can create instance and access attributes' );
 225
 226 done_testing;