changelog
[gitmo/Moose.git] / t / compat / foreign_inheritence.t
CommitLineData
e522431d 1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
a28e50e4 6use Test::More;
b10dde3a 7use Test::Fatal;
e522431d 8
7ff56534 9
e522431d 10{
8b8fa50d 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
77ed022c 36 __PACKAGE__->meta->make_immutable( inline_constructor => 0, debug => 0 );
b43a4bca 37
0305961b 38 package Bucket;
39 use metaclass 'Class::MOP::Class';
8b8fa50d 40
41 __PACKAGE__->meta->add_attribute(
42 'squeegee' => ( accessor => 'squeegee' ) );
43
0305961b 44 package Old::Bucket::Nose;
8b8fa50d 45
0305961b 46 # see http://www.moosefoundation.org/moose_facts.htm
47 use Moose;
8b8fa50d 48
0305961b 49 extends 'Bucket';
2f9e53fb 50
cdeb30dc 51 package MyBase;
cdeb30dc 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
8b8fa50d 70 # XXX FIXME subclassing meta-attrs and immutable-ing the subclass fails
e522431d 71}
72
73my $foo_moose = Foo::Moose->new();
8b8fa50d 74isa_ok( $foo_moose, 'Foo::Moose' );
75isa_ok( $foo_moose, 'Elk' );
e522431d 76
8b8fa50d 77is( $foo_moose->no_moose, 'Elk',
78 '... got the right value from the Elk method' );
79is( $foo_moose->moose, 'Foo',
80 '... got the right value from the Foo::Moose method' );
81
b10dde3a 82is( exception {
8b8fa50d 83 Old::Bucket::Nose->meta->make_immutable( debug => 0 );
b10dde3a 84}, undef, 'Immutability on Moose class extending Class::MOP class ok' );
b43a4bca 85
b10dde3a 86is( exception {
635b9d7e 87 SubClass2->meta->superclasses('MyBase');
b10dde3a 88}, undef, 'Can subclass the same non-Moose class twice with different metaclasses' );
ab76842e 89
a28e50e4 90done_testing;