t/role-basic-bugs.t

   1 #!/usr/bin/env perl
   2
   3 use lib 'lib', 't/role-basic/lib';
   4 use MyTests;
   5
   6 # multiple roles with the same role
   7 {
   8     package RoleC;
   9     use Role::Tiny;
  10     sub baz { 'baz' }
  11
  12     package RoleB;
  13     use Role::Tiny;
  14     with 'RoleC';
  15     sub bar { 'bar' }
  16
  17     package RoleA;
  18     use Role::Tiny;
  19     with 'RoleC';
  20     sub foo { 'foo' }
  21
  22     package Foo;
  23     use strict;
  24     use warnings;
  25     use Role::Tiny 'with';
  26     ::is( ::exception {
  27         with 'RoleA', 'RoleB';
  28     }, undef, 'Composing multiple roles which use the same role should not have conflicts' );
  29     sub new { bless {} => shift }
  30
  31     my $object = Foo->new;
  32     foreach my $method (qw/foo bar baz/) {
  33         ::can_ok $object, $method;
  34         ::is $object->$method, $method,
  35           '... and all methods should be composed in correctly';
  36     }
  37 }
  38
  39 {
  40     no warnings 'redefine';
  41     local *UNIVERSAL::can = sub { 1 };
  42     eval <<'    END';
  43     package Can::Can;
  44     use Role::Tiny 'with';
  45     with 'A::NonExistent::Role';
  46     END
  47 }
  48
  49 {
  50     my $error = $@ || '';
  51     like $error, qr{^Can't locate A/NonExistent/Role.pm},
  52         'If ->can always returns true, we should still not think we loaded the role'
  53             or diag "Error found: $error";
  54 }
  55
  56 {
  57     package Role1;
  58     use Role::Tiny;
  59
  60     package Role2;
  61     use Role::Tiny;
  62
  63     package Frew;
  64     use strict;
  65     use warnings;
  66     sub new { bless {} => shift }
  67
  68     my $object = Frew->new;
  69
  70     ::ok(!Role::Tiny::does_role($object, 'Role1'), 'no Role1 yet');
  71     ::ok(!Role::Tiny::does_role($object, 'Role2'), 'no Role2 yet');
  72
  73     Role::Tiny->apply_roles_to_object($object, 'Role1');
  74     ::ok(Role::Tiny::does_role($object, "Role1"), 'Role1 consumed');
  75     ::ok(!Role::Tiny::does_role($object, 'Role2'), 'no Role2 yet');
  76     Role::Tiny->apply_roles_to_object($object, 'Role2');
  77     ::ok(Role::Tiny::does_role($object, "Role1"), 'Role1 consumed');
  78     ::ok(Role::Tiny::does_role($object, 'Role2'), 'Role2 consumed');
  79 }
  80 done_testing;