t/050_metaclasses/013_metaclass_traits.t

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