diff options
Diffstat (limited to 't/compat/foreign_inheritence.t')
-rw-r--r-- | t/compat/foreign_inheritence.t | 88 |
1 files changed, 88 insertions, 0 deletions
diff --git a/t/compat/foreign_inheritence.t b/t/compat/foreign_inheritence.t new file mode 100644 index 0000000..1d3b0d8 --- /dev/null +++ b/t/compat/foreign_inheritence.t @@ -0,0 +1,88 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + + +{ + + package Elk; + use strict; + use warnings; + + sub new { + my $class = shift; + bless { no_moose => "Elk" } => $class; + } + + sub no_moose { $_[0]->{no_moose} } + + package Foo::Moose; + use Moose; + + extends 'Elk'; + + has 'moose' => ( is => 'ro', default => 'Foo' ); + + sub new { + my $class = shift; + my $super = $class->SUPER::new(@_); + return $class->meta->new_object( '__INSTANCE__' => $super, @_ ); + } + + __PACKAGE__->meta->make_immutable( inline_constructor => 0, debug => 0 ); + + package Bucket; + use metaclass 'Class::MOP::Class'; + + __PACKAGE__->meta->add_attribute( + 'squeegee' => ( accessor => 'squeegee' ) ); + + package Old::Bucket::Nose; + + # see http://www.moosefoundation.org/moose_facts.htm + use Moose; + + extends 'Bucket'; + + package MyBase; + sub foo { } + + package Custom::Meta1; + use parent 'Moose::Meta::Class'; + + package Custom::Meta2; + use parent 'Moose::Meta::Class'; + + package SubClass1; + use metaclass 'Custom::Meta1'; + use Moose; + + extends 'MyBase'; + + package SubClass2; + use metaclass 'Custom::Meta2'; + use Moose; + + # XXX FIXME subclassing meta-attrs and immutable-ing the subclass fails +} + +my $foo_moose = Foo::Moose->new(); +isa_ok( $foo_moose, 'Foo::Moose' ); +isa_ok( $foo_moose, 'Elk' ); + +is( $foo_moose->no_moose, 'Elk', + '... got the right value from the Elk method' ); +is( $foo_moose->moose, 'Foo', + '... got the right value from the Foo::Moose method' ); + +is( exception { + Old::Bucket::Nose->meta->make_immutable( debug => 0 ); +}, undef, 'Immutability on Moose class extending Class::MOP class ok' ); + +is( exception { + SubClass2->meta->superclasses('MyBase'); +}, undef, 'Can subclass the same non-Moose class twice with different metaclasses' ); + +done_testing; |