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