t/060_compat/003_foreign_inheritence.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 6;
   7 use Test::Exception;
   8
   9
  10
  11 {
  12         package Elk;
  13         use strict;
  14         use warnings;
  15
  16         sub new {
  17                 my $class = shift;
  18                 bless { no_moose => "Elk" } => $class;
  19         }
  20
  21         sub no_moose { $_[0]->{no_moose} }
  22
  23         package Foo::Moose;
  24         use Moose;
  25
  26         extends 'Elk';
  27
  28         has 'moose' => (is => 'ro', default => 'Foo');
  29
  30         sub new {
  31                 my $class = shift;
  32                 my $super = $class->SUPER::new(@_);
  33                 return $class->meta->new_object('__INSTANCE__' => $super, @_);
  34         }
  35
  36         __PACKAGE__->meta->make_immutable(debug => 0);
  37
  38     package Bucket;
  39     use metaclass 'Class::MOP::Class';
  40
  41     __PACKAGE__->meta->add_attribute('squeegee' => (accessor => 'squeegee'));
  42
  43     package Old::Bucket::Nose;
  44     # see http://www.moosefoundation.org/moose_facts.htm
  45     use Moose;
  46
  47     extends 'Bucket';
  48
  49     package MyBase;
  50     sub foo { }
  51
  52     package Custom::Meta1;
  53     use base qw(Moose::Meta::Class);
  54
  55     package Custom::Meta2;
  56     use base qw(Moose::Meta::Class);
  57
  58     package SubClass1;
  59     use metaclass 'Custom::Meta1';
  60     use Moose;
  61
  62     extends 'MyBase';
  63
  64     package SubClass2;
  65     use metaclass 'Custom::Meta2';
  66     use Moose;
  67
  68   # XXX FIXME subclassing meta-attrs and immutable-ing the subclass fails
  69 }
  70
  71 my $foo_moose = Foo::Moose->new();
  72 isa_ok($foo_moose, 'Foo::Moose');
  73 isa_ok($foo_moose, 'Elk');
  74
  75 is($foo_moose->no_moose, 'Elk', '... got the right value from the Elk method');
  76 is($foo_moose->moose, 'Foo', '... got the right value from the Foo::Moose method');
  77
  78 lives_ok {
  79     Old::Bucket::Nose->meta->make_immutable(debug => 0);
  80 } 'Immutability on Moose class extending Class::MOP class ok';
  81
  82 lives_ok {
  83     SubClass2->meta->superclasses([ 'MyBase' ]);
  84 } 'Can subclass the same non-Moose class twice with different metaclasses';
  85