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