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