t/060_compat/003_foreign_inheritence.t

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