t/subclass.t

   1 use strict;
   2 use warnings FATAL => 'all';
   3 use Test::More;
   4 use Test::Fatal;
   5
   6 my $backcompat_called;
   7 {
   8   package RoleExtension;
   9   use base 'Role::Tiny';
  10
  11   sub apply_single_role_to_package {
  12     my $me = shift;
  13     $me->SUPER::apply_single_role_to_package(@_);
  14     $backcompat_called++;
  15   }
  16 }
  17 {
  18   package RoleExtension2;
  19   use base 'Role::Tiny';
  20
  21   sub role_application_steps {
  22     $_[0]->SUPER::role_application_steps;
  23   }
  24
  25   sub apply_single_role_to_package {
  26     my $me = shift;
  27     $me->SUPER::apply_single_role_to_package(@_);
  28     $backcompat_called++;
  29   }
  30
  31 }
  32
  33 {
  34   package Role1;
  35   $INC{'Role1.pm'} = __FILE__;
  36   use Role::Tiny;
  37   sub sub1 {}
  38 }
  39
  40 {
  41   package Role2;
  42   $INC{'Role2.pm'} = __FILE__;
  43   use Role::Tiny;
  44   sub sub2 {}
  45 }
  46
  47 {
  48   package Class1;
  49   RoleExtension->apply_roles_to_package(__PACKAGE__, 'Role1', 'Role2');
  50 }
  51
  52 is $backcompat_called, 2,
  53   'overridden apply_single_role_to_package called for backcompat';
  54
  55 $backcompat_called = 0;
  56 {
  57   package Class2;
  58   RoleExtension2->apply_roles_to_package(__PACKAGE__, 'Role1', 'Role2');
  59 }
  60 is $backcompat_called, 0,
  61   'overridden role_application_steps prevents backcompat attempt';
  62
  63 done_testing;