Commit | Line | Data |
a88576d4 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
09eff61e |
6 | use Test::More tests => 12; |
a88576d4 |
7 | |
8 | BEGIN { |
9 | use_ok('Moose::Policy'); |
10 | } |
11 | |
12 | BEGIN { |
13 | package My::Plain::Attribute; |
14 | use Moose; |
15 | extends 'Moose::Meta::Attribute'; |
16 | } |
17 | BEGIN { |
18 | package My::Bar::Attribute; |
19 | use Moose; |
20 | extends 'Moose::Meta::Attribute'; |
21 | } |
22 | BEGIN { |
23 | package My::Plain::Class; |
24 | use Moose; |
25 | extends 'Moose::Meta::Class'; |
26 | } |
27 | BEGIN { |
28 | package My::Bar::Class; |
29 | use Moose; |
30 | extends 'Moose::Meta::Class'; |
31 | } |
32 | BEGIN { |
33 | package My::Moose::Policy; |
34 | # because writing subs is hard |
35 | my %pkg_map = ( |
36 | qw(metaclass Class), |
37 | qw(attribute_metaclass Attribute), |
38 | # TODO these: |
39 | # qw(method_metaclass Method), |
40 | # qw(instance_metaclass Instance), |
41 | ); |
42 | foreach my $subname (keys(%pkg_map)) { |
43 | my $pkg = $pkg_map{$subname}; |
44 | my $sub = sub { |
45 | my $self = shift; |
46 | my ($caller) = @_; |
47 | return('My::Bar::' . $pkg) |
48 | if($caller =~ m/^Bar(?:::|$)/); |
49 | return 'My::Plain::' . $pkg; |
50 | }; |
51 | no strict 'refs'; |
52 | *{$subname} = $sub; |
53 | } |
54 | } |
55 | { |
56 | package Foo; |
57 | use Moose::Policy 'My::Moose::Policy'; |
58 | } |
59 | { |
60 | package Bar; |
61 | use Moose::Policy 'My::Moose::Policy'; |
62 | } |
63 | { |
64 | package Bars; |
65 | use Moose::Policy 'My::Moose::Policy'; |
66 | } |
67 | { |
68 | package Bar::None; |
69 | use Moose::Policy 'My::Moose::Policy'; |
70 | } |
71 | |
72 | isa_ok(Foo->meta, 'Moose::Meta::Class'); |
73 | is(Foo->meta->attribute_metaclass, 'My::Plain::Attribute', |
74 | '... got our custom attr metaclass'); |
75 | |
76 | isa_ok(Bar->meta, 'Moose::Meta::Class'); |
77 | isa_ok(Bar->meta, 'My::Bar::Class'); |
78 | is(Bar->meta->attribute_metaclass, 'My::Bar::Attribute', |
79 | '... got our custom attr metaclass'); |
80 | |
81 | isa_ok(Bars->meta, 'Moose::Meta::Class'); |
82 | isa_ok(Bars->meta, 'My::Plain::Class'); |
83 | is(Bars->meta->attribute_metaclass, 'My::Plain::Attribute', |
84 | '... got our custom attr metaclass'); |
85 | |
86 | isa_ok(Bar::None->meta, 'Moose::Meta::Class'); |
87 | isa_ok(Bar::None->meta, 'My::Bar::Class'); |
88 | is(Bar::None->meta->attribute_metaclass, 'My::Bar::Attribute', |
89 | '... got our custom attr metaclass'); |