Commit | Line | Data |
---|---|---|
e522431d | 1 | #!/usr/bin/perl |
2 | ||
3 | use strict; | |
4 | use warnings; | |
5 | ||
a28e50e4 | 6 | use Test::More; |
53a4d826 | 7 | use Test::Exception; |
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 | ||
73 | my $foo_moose = Foo::Moose->new(); | |
8b8fa50d | 74 | isa_ok( $foo_moose, 'Foo::Moose' ); |
75 | isa_ok( $foo_moose, 'Elk' ); | |
e522431d | 76 | |
8b8fa50d | 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 | ||
53a4d826 | 82 | lives_ok { |
8b8fa50d | 83 | Old::Bucket::Nose->meta->make_immutable( debug => 0 ); |
53a4d826 | 84 | } |
8b8fa50d | 85 | 'Immutability on Moose class extending Class::MOP class ok'; |
b43a4bca | 86 | |
53a4d826 | 87 | lives_ok { |
635b9d7e | 88 | SubClass2->meta->superclasses('MyBase'); |
53a4d826 | 89 | } |
8b8fa50d | 90 | 'Can subclass the same non-Moose class twice with different metaclasses'; |
ab76842e | 91 | |
a28e50e4 | 92 | done_testing; |