Commit | Line | Data |
3f137d21 |
1 | use strict; |
2 | use warnings; |
3 | use Test::More tests => 12; |
4 | use MooseX::Adopt::Class::Accessor::Fast; |
5 | { |
6 | package TestPackage; |
7 | use Moose; |
8 | with 'MooseX::Emulate::Class::Accessor::Fast'; |
9 | __PACKAGE__->mk_accessors(qw/ normal /); |
10 | __PACKAGE__->meta->make_immutable; |
11 | } |
12 | { |
13 | package TestPackage::SubClass::Accessors; |
14 | use base qw/TestPackage/; |
15 | __PACKAGE__->mk_accessors(qw/ meta /); |
16 | } |
17 | { |
18 | package TestPackage::SubClass::Readonly; |
19 | use base qw/TestPackage/; |
20 | __PACKAGE__->mk_ro_accessors(qw/ meta /); |
21 | } |
22 | { |
23 | package TestPackage::SubClass::Writeonly; |
24 | use base qw/TestPackage/; |
25 | __PACKAGE__->mk_wo_accessors(qw(sekret double_sekret)); |
26 | } |
27 | |
28 | # This setup is a _specific_ example from Catalyst. |
29 | |
30 | # CAF _will not_ replace a pre-existing symbol, but there never |
31 | # used to be a 'meta' symbol before CAF things are ported to Moose |
32 | |
33 | # Therefore, 'meta' needs to be treated as a special case, as |
34 | # code which is _not_ using the symbol already should be allowed to |
35 | # say $self->meta, and get all the Moose goodness, but code which |
36 | # makes an accessor called ->meta should still work! |
37 | |
38 | # 22:22 <@groditi> the difference is meta wasnt there as a method before, but MooseX::Adopt::CAF does have a meta method. |
39 | # 22:23 <@groditi> i guess i could namespace::clean it out. but it might create confusion |
40 | # 22:23 * t0m nod - I think we need a special case for this.. |
41 | # 22:23 <@groditi> mst: thoughts? |
42 | # 22:23 <@mst> Moose needs to not export 'meta' if you don't want it |
43 | # 22:24 <@groditi> so namespace::clean it out or what? |
44 | # 22:25 <@mst> hmm |
45 | # 22:25 <@mst> does ->mk_accessors(qw(meta)) work if you do "use base qw(...)" instead of use Moose ? |
46 | # 22:26 <@mst> if it doesn't, then it isn't a bug in CAF |
47 | # 22:27 <@groditi> its my bug. because Adopt does use Moose because Emulate is a role |
48 | # 22:27 <@groditi> so if you isa CAF then you definitely can(meta) |
49 | # 22:27 <@t0m> I think that if the user makes an accessor called 'meta', we need to remove the Moose package symbol, and |
50 | # immutable the class so the the accessor / constructor doesn't touch meta.. |
51 | # 22:27 <@t0m> and generate a warning. |
52 | # 22:28 <@t0m> which is ugly as, but kinda works. |
53 | # 22:29 <@groditi> ok ok. i'll do has_method |
54 | # 22:29 <@t0m> as you want users who aren't shitting on the moose symbol to be able to call $self->meta as they 'Moosify' |
55 | # 22:29 <@groditi> this sucks though because Emulate counts on meta being there |
56 | # 22:30 <@groditi> ok well this requires major major changes so delayed until i finish finals |
57 | |
58 | # Suggested fix - something less hacky than: |
59 | #Index: lib/MooseX/Emulate/Class/Accessor/Fast.pm |
60 | #=================================================================== |
61 | #--- lib/MooseX/Emulate/Class/Accessor/Fast.pm (revision 7035) |
62 | #+++ lib/MooseX/Emulate/Class/Accessor/Fast.pm (working copy) |
63 | #@@ -93,14 +93,15 @@ |
64 | # |
65 | # sub mk_accessors{ |
66 | # my $self = shift; |
67 | #- my $meta = $self->meta; |
68 | #+ my $meta = $self->Moose::Object::meta; |
69 | #+ $meta->make_mutable if $meta->is_immutable; |
70 | # for my $attr_name (@_){ |
71 | # my $reader = $self->accessor_name_for($attr_name); |
72 | # my $writer = $self->mutator_name_for( $attr_name); |
73 | # |
74 | # #dont overwrite existing methods |
75 | # if($reader eq $writer){ |
76 | #- my %opts = ( $self->can($reader) ? () : (accessor => $reader) ); |
77 | #+ my %opts = ( $self->can($reader) && $reader ne 'meta' ? () : (accessor => $reader) ); |
78 | # my $attr = $meta->add_attribute($attr_name, %opts); |
79 | # if($attr_name eq $reader){ |
80 | # my $alias = "_${attr_name}_accessor"; |
81 | #@@ -115,6 +116,7 @@ |
82 | # $meta->add_attribute($attr_name, @opts); |
83 | # } |
84 | # } |
85 | #+ $meta->make_immutable; |
86 | # } |
87 | |
88 | { |
89 | my $i = TestPackage::SubClass::Accessors->new({ normal => 42, meta => 66 }); |
90 | |
91 | # 1,2 |
92 | is $i->normal, 42, 'normal accessor read value from constructor'; |
93 | $i->normal(2); |
94 | is $i->normal, 2, 'normal accessor read set value'; |
95 | |
96 | TODO: { |
97 | local $TODO = 'meta method needs special case'; |
98 | |
99 | # 3,4 |
100 | is $i->meta, 66, 'meta accessor read value from constructor'; |
101 | $i->meta(9); |
102 | is $i->meta, 9, 'meta accessor read set value'; |
103 | } |
104 | } |
105 | { |
106 | my $i = TestPackage::SubClass::Readonly->new({ normal => 42, meta => 66 }); |
107 | |
108 | # 5,6 |
109 | is $i->normal, 42, 'normal accessor read value from constructor'; |
110 | $i->{normal} = 2; |
111 | is $i->normal, 2, 'normal accessor read set value'; |
112 | |
113 | TODO: { |
114 | local $TODO = 'meta method needs special case'; |
115 | |
116 | # 7,8 |
117 | is $i->meta, 66, 'meta accessor read value from constructor'; |
118 | $i->{meta} = 9; |
119 | is $i->meta, 9, 'meta accessor read set value'; |
120 | } |
121 | } |
122 | { |
123 | my $i = TestPackage::SubClass::Writeonly->new({ normal => 42, meta => 66 }); |
124 | |
125 | # 9,10 |
126 | is $i->normal, 42, 'normal accessor read value from constructor'; |
127 | $i->normal(2); |
128 | is $i->normal, 2, 'normal accessor read set value'; |
129 | |
130 | TODO: { |
131 | local $TODO = 'meta method needs special case'; |
132 | |
133 | # 11,12 |
134 | is $i->{meta}, 66, 'meta accessor read value from constructor'; |
135 | $i->meta(9); |
136 | is $i->{meta}, 9, 'meta accessor read set value'; |
137 | } |
138 | } |