t/050_metaclasses/013_metaclass_traits.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More 'no_plan';
   7
   8 {
   9     package My::SimpleTrait;
  10
  11     use Moose::Role;
  12
  13     sub simple { return 5 }
  14 }
  15
  16 {
  17     package Foo;
  18
  19     use Moose -traits => [ 'My::SimpleTrait' ];
  20 }
  21
  22 can_ok( Foo->meta(), 'simple' );
  23 is( Foo->meta()->simple(), 5,
  24     'Foo->meta()->simple() returns expected value' );
  25
  26 {
  27     package My::SimpleTrait2;
  28
  29     use Moose::Role;
  30
  31     # This needs to happen at compile time so it happens before we
  32     # apply traits to Bar
  33     BEGIN {
  34         has 'attr' =>
  35             ( is      => 'ro',
  36               default => 'something',
  37             );
  38     }
  39
  40     sub simple { return 5 }
  41 }
  42
  43 {
  44     package Bar;
  45
  46     use Moose -traits => [ 'My::SimpleTrait2' ];
  47 }
  48
  49 can_ok( Bar->meta(), 'simple' );
  50 is( Bar->meta()->simple(), 5,
  51     'Bar->meta()->simple() returns expected value' );
  52 can_ok( Bar->meta(), 'attr' );
  53 is( Bar->meta()->attr(), 'something',
  54     'Bar->meta()->attr() returns expected value' );
  55
  56 {
  57     package My::SimpleTrait3;
  58
  59     use Moose::Role;
  60
  61     BEGIN {
  62         has 'attr2' =>
  63             ( is      => 'ro',
  64               default => 'something',
  65             );
  66     }
  67
  68     sub simple2 { return 55 }
  69 }
  70
  71 {
  72     package Baz;
  73
  74     use Moose -traits => [ 'My::SimpleTrait2', 'My::SimpleTrait3' ];
  75 }
  76
  77 can_ok( Baz->meta(), 'simple' );
  78 is( Baz->meta()->simple(), 5,
  79     'Baz->meta()->simple() returns expected value' );
  80 can_ok( Baz->meta(), 'attr' );
  81 is( Baz->meta()->attr(), 'something',
  82     'Baz->meta()->attr() returns expected value' );
  83 can_ok( Baz->meta(), 'simple2' );
  84 is( Baz->meta()->simple2(), 55,
  85     'Baz->meta()->simple2() returns expected value' );
  86 can_ok( Baz->meta(), 'attr2' );
  87 is( Baz->meta()->attr2(), 'something',
  88     'Baz->meta()->attr2() returns expected value' );
  89
  90 {
  91     package My::Trait::AlwaysRO;
  92
  93     use Moose::Role;
  94
  95     around '_process_new_attribute', '_process_inherited_attribute' =>
  96         sub {
  97             my $orig = shift;
  98             my ( $self, $name, %args ) = @_;
  99
 100             $args{is} = 'ro';
 101
 102             return $self->$orig( $name, %args );
 103         };
 104 }
 105
 106 {
 107     package Quux;
 108
 109     use Moose -traits => [ 'My::Trait::AlwaysRO' ];
 110
 111     has 'size' =>
 112         ( is  => 'rw',
 113           isa => 'Int',
 114         );
 115 }
 116
 117 ok( Quux->meta()->has_attribute('size'),
 118     'Quux has size attribute' );
 119 ok( ! Quux->meta()->get_attribute('size')->writer(),
 120     'size attribute does not have a writer' );
 121
 122 {
 123     package My::Class::Whatever;
 124
 125     use Moose::Role;
 126
 127     sub whatever { 42 }
 128
 129     package Moose::Meta::Class::Custom::Trait::Whatever;
 130
 131     sub register_implementation {
 132         return 'My::Class::Whatever';
 133     }
 134 }
 135
 136 {
 137     package RanOutOfNames;
 138
 139     use Moose -traits => [ 'Whatever' ];
 140 }
 141
 142 ok( RanOutOfNames->meta()->meta()->has_method('whatever'),
 143     'RanOutOfNames->meta() has whatever method' );
 144
 145 {
 146     package Role::Foo;
 147
 148     use Moose::Role -traits => [ 'My::SimpleTrait' ];
 149 }
 150
 151 can_ok( Role::Foo->meta(), 'simple' );
 152 is( Role::Foo->meta()->simple(), 5,
 153     'Role::Foo->meta()->simple() returns expected value' );