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 {
  64   package RoleExtension3;
  65   use base 'Role::Tiny';
  66
  67   sub _composable_package_for {
  68     my ($self, $role) = @_;
  69     my $composed_name = 'Role::Tiny::_COMPOSABLE::'.$role;
  70     return $composed_name if $Role::Tiny::COMPOSED{role}{$composed_name};
  71     no strict 'refs';
  72     *{"${composed_name}::extra_sub"} = sub {};
  73     $self->SUPER::_composable_package_for($role);
  74   }
  75 }
  76
  77 {
  78   package Class2;
  79   sub foo {}
  80 }
  81 {
  82   package Role3;
  83   $INC{'Role3.pm'} = __FILE__;
  84   use Role::Tiny;
  85   requires 'extra_sub';
  86 }
  87 ok eval { RoleExtension3->create_class_with_roles('Class2', 'Role3') },
  88   'requires is satisfied by subs generated by _composable_package_for';
  89
  90 {
  91   package Role4;
  92   $INC{'Role4.pm'} = __FILE__;
  93   use Role::Tiny;
  94   requires 'extra_sub2';
  95 }
  96 ok !eval { RoleExtension3->create_class_with_roles('Class2', 'Role4'); },
  97   'requires checked properly during create_class_with_roles';
  98
  99 SKIP: {
 100   skip "Class::Method::Modifiers not installed or too old", 1
 101     unless eval "use Class::Method::Modifiers 1.05; 1";
 102   package Role5;
 103   $INC{'Role5.pm'} = __FILE__;
 104   use Role::Tiny;
 105   around extra_sub2 => sub { my $orig = shift; $orig->(@_); };
 106
 107   ::ok !eval { RoleExtension3->create_class_with_roles('Class3', 'Role4'); },
 108     'requires checked properly during create_class_with_roles';
 109 }
 110
 111 done_testing;