version bump
[gitmo/Moose.git] / t / compat / foreign_inheritence.t
1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5
6 use Test::More;
7 use Test::Fatal;
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( inline_constructor => 0, debug => 0 );
37
38     package Bucket;
39     use metaclass 'Class::MOP::Class';
40
41     __PACKAGE__->meta->add_attribute(
42         'squeegee' => ( accessor => 'squeegee' ) );
43
44     package Old::Bucket::Nose;
45
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',
78     '... got the right value from the Elk method' );
79 is( $foo_moose->moose, 'Foo',
80     '... got the right value from the Foo::Moose method' );
81
82 is( exception {
83     Old::Bucket::Nose->meta->make_immutable( debug => 0 );
84 }, undef, 'Immutability on Moose class extending Class::MOP class ok' );
85
86 is( exception {
87     SubClass2->meta->superclasses('MyBase');
88 }, undef, 'Can subclass the same non-Moose class twice with different metaclasses' );
89
90 done_testing;