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