t/meta.t

   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 }