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