t/compat/extends_nonmoose_that_isa_moose_with_metarole.t

   1 use strict;
   2 use warnings;
   3 use Test::More;
   4 use Class::MOP ();
   5
   6 {
   7     package My::Role;
   8     use Moose::Role;
   9 }
  10
  11 {
  12     package SomeClass;
  13     use Moose -traits => 'My::Role';
  14 }
  15
  16 {
  17     package SubClassUseBase;
  18     use base qw/SomeClass/;
  19 }
  20
  21 {
  22     package SubSubClassUseBase;
  23     use Moose;
  24     use Test::More;
  25     use Test::Fatal;
  26     is( exception {
  27         extends 'SubClassUseBase';
  28     }, undef, 'Can extend non-Moose class with parent class that is a Moose class with a meta role' );
  29 }
  30
  31 {
  32     ok( SubSubClassUseBase->meta->meta->can('does_role')
  33         && SubSubClassUseBase->meta->meta->does_role('My::Role'),
  34         'SubSubClassUseBase meta metaclass does the My::Role role' );
  35 }
  36
  37 # Note, remove metaclasses of the 'use base' classes after each test,
  38 # so that they have to be re-initialized - otherwise latter tests
  39 # would not demonstrate the original issue.
  40 Class::MOP::remove_metaclass_by_name('SubClassUseBase');
  41
  42 {
  43     package OtherClass;
  44     use Moose;
  45 }
  46
  47 {
  48     package OtherSubClassUseBase;
  49     use base 'OtherClass';
  50 }
  51
  52 {
  53     package MultiParent1;
  54     use Moose;
  55     use Test::More;
  56     use Test::Fatal;
  57     is( exception {
  58         extends qw( SubClassUseBase OtherSubClassUseBase );
  59     }, undef, 'Can extend two non-Moose classes with parents that are different Moose metaclasses' );
  60 }
  61
  62 {
  63     ok( MultiParent1->meta->meta->can('does_role')
  64         && MultiParent1->meta->meta->does_role('My::Role'),
  65         'MultiParent1 meta metaclass does the My::Role role' );
  66 }
  67
  68 Class::MOP::remove_metaclass_by_name($_)
  69     for qw( SubClassUseBase OtherSubClassUseBase );
  70
  71 {
  72     package MultiParent2;
  73     use Moose;
  74     use Test::More;
  75     use Test::Fatal;
  76     is( exception {
  77         extends qw( OtherSubClassUseBase SubClassUseBase );
  78     }, undef, 'Can extend two non-Moose classes with parents that are different Moose metaclasses (reverse order)' );
  79 }
  80
  81 {
  82     ok( MultiParent2->meta->meta->can('does_role')
  83         && MultiParent2->meta->meta->does_role('My::Role'),
  84         'MultiParent2 meta metaclass does the My::Role role' );
  85 }
  86
  87 Class::MOP::remove_metaclass_by_name($_)
  88     for qw( SubClassUseBase OtherSubClassUseBase );
  89
  90 {
  91     package MultiParent3;
  92     use Moose;
  93     use Test::More;
  94     use Test::Fatal;
  95     is( exception {
  96         extends qw( OtherClass SubClassUseBase );
  97     }, undef, 'Can extend one Moose class and one non-Moose class' );
  98 }
  99
 100 {
 101     ok( MultiParent3->meta->meta->can('does_role')
 102         && MultiParent3->meta->meta->does_role('My::Role'),
 103         'MultiParent3 meta metaclass does the My::Role role' );
 104 }
 105
 106 Class::MOP::remove_metaclass_by_name($_)
 107     for qw( SubClassUseBase OtherSubClassUseBase );
 108
 109 {
 110     package MultiParent4;
 111     use Moose;
 112     use Test::More;
 113     use Test::Fatal;
 114     is( exception {
 115         extends qw( SubClassUseBase OtherClass );
 116     }, undef, 'Can extend one non-Moose class and one Moose class' );
 117 }
 118
 119 {
 120     ok( MultiParent4->meta->meta->can('does_role')
 121         && MultiParent4->meta->meta->does_role('My::Role'),
 122         'MultiParent4 meta metaclass does the My::Role role' );
 123 }
 124
 125 Class::MOP::remove_metaclass_by_name($_)
 126     for qw( SubClassUseBase OtherSubClassUseBase );
 127
 128 {
 129     package MultiChild1;
 130     use Moose;
 131     use Test::More;
 132     use Test::Fatal;
 133     is( exception {
 134         extends 'MultiParent1';
 135     }, undef, 'Can extend class that itself extends two non-Moose classes with Moose parents' );
 136 }
 137
 138 {
 139     ok( MultiChild1->meta->meta->can('does_role')
 140         && MultiChild1->meta->meta->does_role('My::Role'),
 141         'MultiChild1 meta metaclass does the My::Role role' );
 142 }
 143
 144 Class::MOP::remove_metaclass_by_name($_)
 145     for qw( SubClassUseBase OtherSubClassUseBase );
 146
 147 {
 148     package MultiChild2;
 149     use Moose;
 150     use Test::More;
 151     use Test::Fatal;
 152     is( exception {
 153         extends 'MultiParent2';
 154     }, undef, 'Can extend class that itself extends two non-Moose classes with Moose parents (reverse order)' );
 155 }
 156
 157 {
 158     ok( MultiChild2->meta->meta->can('does_role')
 159         && MultiChild2->meta->meta->does_role('My::Role'),
 160         'MultiChild2 meta metaclass does the My::Role role' );
 161 }
 162
 163 Class::MOP::remove_metaclass_by_name($_)
 164     for qw( SubClassUseBase OtherSubClassUseBase );
 165
 166 {
 167     package MultiChild3;
 168     use Moose;
 169     use Test::More;
 170     use Test::Fatal;
 171     is( exception {
 172         extends 'MultiParent3';
 173     }, undef, 'Can extend class that itself extends one Moose and one non-Moose parent' );
 174 }
 175
 176 {
 177     ok( MultiChild3->meta->meta->can('does_role')
 178         && MultiChild3->meta->meta->does_role('My::Role'),
 179         'MultiChild3 meta metaclass does the My::Role role' );
 180 }
 181
 182 Class::MOP::remove_metaclass_by_name($_)
 183     for qw( SubClassUseBase OtherSubClassUseBase );
 184
 185 {
 186     package MultiChild4;
 187     use Moose;
 188     use Test::More;
 189     use Test::Fatal;
 190     is( exception {
 191         extends 'MultiParent4';
 192     }, undef, 'Can extend class that itself extends one non-Moose and one Moose parent' );
 193 }
 194
 195 {
 196     ok( MultiChild4->meta->meta->can('does_role')
 197         && MultiChild4->meta->meta->does_role('My::Role'),
 198         'MultiChild4 meta metaclass does the My::Role role' );
 199 }
 200
 201 Class::MOP::remove_metaclass_by_name($_)
 202     for qw( SubClassUseBase OtherSubClassUseBase );
 203
 204 done_testing;