Commit | Line | Data |
c47cf415 |
1 | #!/usr/bin/perl |
2 | # This is automatically generated by author/import-moose-test.pl. |
3 | # DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! |
4 | use t::lib::MooseCompat; |
5 | |
6 | use strict; |
7 | use warnings; |
8 | |
9 | use Test::More; |
10 | $TODO = q{Mouse is not yet completed}; |
11 | use Test::Exception; |
12 | |
13 | |
14 | { |
15 | |
16 | package Elk; |
17 | use strict; |
18 | use warnings; |
19 | |
20 | sub new { |
21 | my $class = shift; |
22 | bless { no_moose => "Elk" } => $class; |
23 | } |
24 | |
25 | sub no_moose { $_[0]->{no_moose} } |
26 | |
27 | package Foo::Mouse; |
28 | use Mouse; |
29 | |
30 | extends 'Elk'; |
31 | |
32 | has 'moose' => ( is => 'ro', default => 'Foo' ); |
33 | |
34 | sub new { |
35 | my $class = shift; |
36 | my $super = $class->SUPER::new(@_); |
37 | return $class->meta->new_object( '__INSTANCE__' => $super, @_ ); |
38 | } |
39 | |
40 | __PACKAGE__->meta->make_immutable( inline_constructor => 0, debug => 0 ); |
41 | |
42 | package Bucket; |
43 | use metaclass 'Mouse::Meta::Class'; |
44 | |
45 | __PACKAGE__->meta->add_attribute( |
46 | 'squeegee' => ( accessor => 'squeegee' ) ); |
47 | |
48 | package Old::Bucket::Nose; |
49 | |
50 | # see http://www.moosefoundation.org/moose_facts.htm |
51 | use Mouse; |
52 | |
53 | extends 'Bucket'; |
54 | |
55 | package MyBase; |
56 | sub foo { } |
57 | |
58 | package Custom::Meta1; |
59 | use base qw(Mouse::Meta::Class); |
60 | |
61 | package Custom::Meta2; |
62 | use base qw(Mouse::Meta::Class); |
63 | |
64 | package SubClass1; |
65 | use metaclass 'Custom::Meta1'; |
66 | use Mouse; |
67 | |
68 | extends 'MyBase'; |
69 | |
70 | package SubClass2; |
71 | use metaclass 'Custom::Meta2'; |
72 | use Mouse; |
73 | |
74 | # XXX FIXME subclassing meta-attrs and immutable-ing the subclass fails |
75 | } |
76 | |
77 | my $foo_moose = Foo::Mouse->new(); |
78 | isa_ok( $foo_moose, 'Foo::Mouse' ); |
79 | isa_ok( $foo_moose, 'Elk' ); |
80 | |
81 | is( $foo_moose->no_moose, 'Elk', |
82 | '... got the right value from the Elk method' ); |
83 | is( $foo_moose->moose, 'Foo', |
84 | '... got the right value from the Foo::Mouse method' ); |
85 | |
86 | lives_ok { |
87 | Old::Bucket::Nose->meta->make_immutable( debug => 0 ); |
88 | } |
89 | 'Immutability on Mouse class extending Mouse::Meta class ok'; |
90 | |
91 | lives_ok { |
92 | SubClass2->meta->superclasses('MyBase'); |
93 | } |
94 | 'Can subclass the same non-Mouse class twice with different metaclasses'; |
95 | |
96 | done_testing; |