t/030_roles/011_overriding.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More no_plan => 1; #skip_all => "provisional test";
   7 use Test::Exception;
   8
   9 BEGIN {
  10     use_ok('Moose');
  11 }
  12
  13 {
  14     # no conflicts, this doesn't actually test the new behavior, it's just an example
  15
  16     lives_ok {
  17         package Role::A;
  18         use Moose::Role;
  19
  20         use constant;
  21         BEGIN { constant->import($_ => __PACKAGE__ . "::$_") for qw(bar) };
  22     } "define role A";
  23
  24     lives_ok {
  25         package Role::B;
  26         use Moose::Role;
  27
  28         use constant;
  29         BEGIN { constant->import($_ => __PACKAGE__ . "::$_") for qw(xxy) };
  30     } "define role B";
  31
  32     lives_ok {
  33         package Role::C;
  34         use Moose::Role;
  35
  36         with qw(Role::A Role::B); # conflict between 'foo's here
  37
  38         use constant;
  39         BEGIN { constant->import($_ => __PACKAGE__ . "::$_") for qw(foo zot) };
  40     } "define role C";
  41
  42     lives_ok {
  43         package Class::A;
  44         use Moose;
  45
  46         with qw(Role::C);
  47
  48         use constant;
  49         BEGIN { constant->import($_ => __PACKAGE__ . "::$_") for qw(zot) };
  50     } "define class A";
  51
  52     can_ok( Class::A->new, qw(foo bar xxy zot) );
  53
  54     is( eval { Class::A->new->foo }, "Role::C::foo", "foo" );
  55     is( eval { Class::A->new->zot }, "Class::A::zot", "zot" );
  56     is( eval { Class::A->new->bar }, "Role::A::bar", "bar" );
  57     is( eval { Class::A->new->xxy }, "Role::B::xxy", "xxy" );
  58
  59 }
  60
  61 {
  62     # conflict resolved by role, same result as prev
  63
  64     lives_ok {
  65         package Role::D;
  66         use Moose::Role;
  67
  68         use constant;
  69         BEGIN { constant->import($_ => __PACKAGE__ . "::$_") for qw(foo bar) };
  70     } "define role Role::D";
  71
  72     lives_ok {
  73         package Role::E;
  74         use Moose::Role;
  75
  76         use constant;
  77         BEGIN { constant->import($_ => __PACKAGE__ . "::$_") for qw(foo xxy) };
  78     } "define role Role::E";
  79
  80     lives_ok {
  81         package Role::F;
  82         use Moose::Role;
  83
  84         with qw(Role::D Role::E); # conflict between 'foo's here
  85
  86         use constant;
  87         BEGIN { constant->import($_ => __PACKAGE__ . "::$_") for qw(foo zot) };
  88     } "define role Role::F";
  89
  90     lives_ok {
  91         package Class::B;
  92         use Moose;
  93
  94         with qw(Role::F);
  95
  96         use constant;
  97         BEGIN { constant->import($_ => __PACKAGE__ . "::$_") for qw(zot) };
  98     } "define class Class::B";
  99
 100     can_ok( Class::B->new, qw(foo bar xxy zot) );
 101
 102     is( eval { Class::B->new->foo }, "Role::F::foo", "foo" );
 103     is( eval { Class::B->new->zot }, "Class::B::zot", "zot" );
 104     is( eval { Class::B->new->bar }, "Role::D::bar", "bar" );
 105     is( eval { Class::B->new->xxy }, "Role::E::xxy", "xxy" );
 106
 107 }
 108
 109 {
 110     # conflict propagation
 111
 112     lives_ok {
 113         package Role::H;
 114         use Moose::Role;
 115
 116         use constant;
 117         BEGIN { constant->import($_ => __PACKAGE__ . "::$_") for qw(foo bar) };
 118     } "define role Role::H";
 119
 120     lives_ok {
 121         package Role::J;
 122         use Moose::Role;
 123
 124         use constant;
 125         BEGIN { constant->import($_ => __PACKAGE__ . "::$_") for qw(foo xxy) };
 126     } "define role Role::J";
 127
 128     lives_ok {
 129         package Role::I;
 130         use Moose::Role;
 131
 132         with qw(Role::J Role::H); # conflict between 'foo's here
 133
 134         use constant;
 135         BEGIN { constant->import($_ => __PACKAGE__ . "::$_") for qw(zot) };
 136     } "define role Role::I";
 137
 138     throws_ok {
 139         package Class::C;
 140         use Moose;
 141
 142         with qw(Role::I);
 143
 144         use constant;
 145         BEGIN { constant->import($_ => __PACKAGE__ . "::$_") for qw(zot) };
 146     } qr/requires.*'foo'/, "defining class Class::C fails";
 147
 148     lives_ok {
 149         package Class::E;
 150         use Moose;
 151
 152         with qw(Role::I);
 153
 154         use constant;
 155         BEGIN { constant->import($_ => __PACKAGE__ . "::$_") for qw(foo zot) };
 156     } "resolved with method";
 157
 158     # fix these later ...
 159     TODO: {
 160           local $TODO = "TODO: add support for attribute methods fufilling reqs";
 161
 162         lives_ok {
 163             package Class::D;
 164             use Moose;
 165
 166             has foo => ( default => __PACKAGE__ . "::foo", is => "rw" );
 167
 168             use constant;
 169             BEGIN { constant->import($_ => __PACKAGE__ . "::$_") for qw(zot) };
 170
 171             with qw(Role::I);
 172         } "resolved with attr";
 173
 174         can_ok( Class::D->new, qw(foo bar xxy zot) );
 175         is( eval { Class::D->new->bar }, "Role::H::bar", "bar" );
 176         is( eval { Class::D->new->xxy }, "Role::I::xxy", "xxy" );
 177     }
 178
 179     is( eval { Class::D->new->foo }, "Class::D::foo", "foo" );
 180     is( eval { Class::D->new->zot }, "Class::D::zot", "zot" );
 181
 182     can_ok( Class::E->new, qw(foo bar xxy zot) );
 183
 184     is( eval { Class::E->new->foo }, "Class::E::foo", "foo" );
 185     is( eval { Class::E->new->zot }, "Class::E::zot", "zot" );
 186     is( eval { Class::E->new->bar }, "Role::H::bar", "bar" );
 187     is( eval { Class::E->new->xxy }, "Role::J::xxy", "xxy" );
 188
 189 }
 190