t/bugs/apply_role_to_one_instance_only.t

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4 use Test::More;
   5 use Test::Fatal;
   6
   7 {
   8     package MyRole1;
   9     use Moose::Role;
  10
  11     sub a_role_method { 'foo' }
  12 }
  13
  14 {
  15     package MyRole2;
  16     use Moose::Role;
  17     # empty
  18 }
  19
  20 {
  21     package Foo;
  22     use Moose;
  23 }
  24
  25 my $instance_with_role1 = Foo->new;
  26 MyRole1->meta->apply($instance_with_role1);
  27
  28 my $instance_with_role2 = Foo->new;
  29 MyRole2->meta->apply($instance_with_role2);
  30
  31 ok ((not $instance_with_role2->does('MyRole1')),
  32     'instance does not have the wrong role');
  33
  34 ok ((not $instance_with_role2->can('a_role_method')),
  35     'instance does not have methods from the wrong role');
  36
  37 ok (($instance_with_role1->does('MyRole1')),
  38     'role was applied to the correct instance');
  39
  40 is( exception {
  41     is $instance_with_role1->a_role_method, 'foo'
  42 }, undef, 'instance has correct role method' );
  43
  44 done_testing;