Commit | Line | Data |
d500266f |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
a28e50e4 |
6 | use Test::More; |
d500266f |
7 | |
7ff56534 |
8 | |
f65cb534 |
9 | =pod |
10 | |
11 | This test demonstrates the ability to extend |
12 | Moose meta-level classes using Moose itself. |
13 | |
14 | =cut |
15 | |
d500266f |
16 | { |
17 | package My::Meta::Class; |
d500266f |
18 | use Moose; |
d03bd989 |
19 | |
d500266f |
20 | extends 'Moose::Meta::Class'; |
d03bd989 |
21 | |
f65cb534 |
22 | around 'create_anon_class' => sub { |
23 | my $next = shift; |
24 | my ($self, %options) = @_; |
25 | $options{superclasses} = [ 'Moose::Object' ] |
26 | unless exists $options{superclasses}; |
27 | $next->($self, %options); |
28 | }; |
d500266f |
29 | } |
30 | |
31 | my $anon = My::Meta::Class->create_anon_class(); |
32 | isa_ok($anon, 'My::Meta::Class'); |
33 | isa_ok($anon, 'Moose::Meta::Class'); |
34 | isa_ok($anon, 'Class::MOP::Class'); |
35 | |
f65cb534 |
36 | is_deeply( |
d03bd989 |
37 | [ $anon->superclasses ], |
38 | [ 'Moose::Object' ], |
f65cb534 |
39 | '... got the default superclasses'); |
40 | |
d500266f |
41 | { |
42 | package My::Meta::Attribute::DefaultReadOnly; |
d500266f |
43 | use Moose; |
d03bd989 |
44 | |
d500266f |
45 | extends 'Moose::Meta::Attribute'; |
d03bd989 |
46 | |
d500266f |
47 | around 'new' => sub { |
48 | my $next = shift; |
f65cb534 |
49 | my ($self, $name, %options) = @_; |
d03bd989 |
50 | $options{is} = 'ro' |
f65cb534 |
51 | unless exists $options{is}; |
52 | $next->($self, $name, %options); |
d03bd989 |
53 | }; |
d500266f |
54 | } |
55 | |
56 | { |
57 | my $attr = My::Meta::Attribute::DefaultReadOnly->new('foo'); |
58 | isa_ok($attr, 'My::Meta::Attribute::DefaultReadOnly'); |
59 | isa_ok($attr, 'Moose::Meta::Attribute'); |
60 | isa_ok($attr, 'Class::MOP::Attribute'); |
61 | |
62 | ok($attr->has_reader, '... the attribute has a reader (as expected)'); |
63 | ok(!$attr->has_writer, '... the attribute does not have a writer (as expected)'); |
64 | ok(!$attr->has_accessor, '... the attribute does not have an accessor (as expected)'); |
65 | } |
66 | |
67 | { |
68 | my $attr = My::Meta::Attribute::DefaultReadOnly->new('foo', (is => 'rw')); |
69 | isa_ok($attr, 'My::Meta::Attribute::DefaultReadOnly'); |
70 | isa_ok($attr, 'Moose::Meta::Attribute'); |
71 | isa_ok($attr, 'Class::MOP::Attribute'); |
72 | |
73 | ok(!$attr->has_reader, '... the attribute does not have a reader (as expected)'); |
74 | ok(!$attr->has_writer, '... the attribute does not have a writer (as expected)'); |
75 | ok($attr->has_accessor, '... the attribute does have an accessor (as expected)'); |
76 | } |
77 | |
a28e50e4 |
78 | done_testing; |