t/049_augment_and_inner_in_roles.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 15;
   7
   8 {
   9     package Base;
  10     use Moose::Role;
  11
  12     sub method {
  13         "outer( " .( eval { inner() } || "" ). ")";
  14     };
  15
  16     package SubRole;
  17     use Moose::Role;
  18
  19     with "Base";
  20
  21     eval {
  22         augment method => sub {
  23             "inner from role";
  24         };
  25     };
  26
  27     ::ok( !$@, "can call augment in a role that has the parent method" );
  28
  29     package ClassWithRole;
  30     use Moose;
  31     with "SubRole";
  32
  33     package ClassWithoutRole;
  34     use Moose;
  35     with "Base";
  36
  37     eval {
  38         augment method => sub {
  39             "inner from class";
  40         };
  41     };
  42
  43     ::ok( !$@, "class can augment a method that comes from a role" );
  44
  45     package UnrelatedRole;
  46     use Moose::Role;
  47
  48     eval {
  49         augment method => sub {
  50             "inner from unrelated role";
  51         };
  52     };
  53
  54     ::ok( !$@, "can call augment in a role that has does not have the parent method" );
  55
  56     package ClassWithTwoRoles;
  57     use Moose;
  58
  59     with qw/Base UnrelatedRole/;
  60 }
  61
  62 foreach my $class (qw/ClassWithoutRole ClassWithRole ClassWithTwoRoles/) {
  63     can_ok( $class, "method" );
  64
  65     ok( $class->does("Base"), "$class does Base" );
  66
  67     like( $class->method, qr/^outer\( .* \)$/, "outer method invoked" );
  68 }
  69
  70 is( ClassWithoutRole->method, "outer( inner from class )", "composition of class + base role" );
  71 is( ClassWithRole->method, "outer( inner from role )", "composition of class + base role + related role" );
  72 is( ClassWithTwoRoles->method, "outer( inner from unrelated role )", "composition of class + base role + mixin role" );
  73