From: Tomas Doran <bobtfish@bobtfish.net>
Date: Tue, 9 Dec 2008 23:08:39 +0000 (+0000)
Subject: More tests
X-Git-Tag: 0.00700~5
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3f137d21445c652a26d7ef962c272ff76c7413b5;p=gitmo%2FMooseX-Emulate-Class-Accessor-Fast.git

More tests
---

diff --git a/Changes b/Changes
index 69d1dc2..bae4593 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,8 @@
+0.00600
+          - Add test for a 'meta' accessor, which we need to treat as a 
+            special case (t0m)
+          - Add test for not replacing pre-existing accessors generally, 
+            which is behavior we don't want to lose (t0m)
 0.00500    Dec 9, 2008
           - make_accessor, make_ro_accessor, make_rw_accessor
             - tests
@@ -6,9 +11,9 @@
              on badly-written code like Data::Page. (Reported by marcus)
              - Tests for this
              - Up Moose dep to 0.31 
-0.00300    Jul XX, 2008
+0.00300    Jul 30, 2008
            - Replace around 'new' with a BUILD method. Faster and avoids Moose
-             bug with around/immutable and sub-classes.
+             bug with around/immutable and sub-classes. (t0m)
 0.00200    Mar 28, 2008
            - Extend BUILDALL to store constructor keys in the obj. hashref
            - Minor fix to make sure Adopt doesn't trip PAUSE perms
diff --git a/MANIFEST b/MANIFEST
index b0a5e85..99cf175 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -18,3 +18,5 @@ t/adopt.t
 t/construction.t
 t/getset.t
 t/lib/TestAdoptCAF.pm
+t/meta.t
+t/no_replace_existing_symbols.t
diff --git a/t/meta.t b/t/meta.t
new file mode 100644
index 0000000..71ce297
--- /dev/null
+++ b/t/meta.t
@@ -0,0 +1,138 @@
+use strict;
+use warnings;
+use Test::More tests => 12;
+use MooseX::Adopt::Class::Accessor::Fast;
+{
+  package TestPackage;
+  use Moose;
+  with 'MooseX::Emulate::Class::Accessor::Fast';
+  __PACKAGE__->mk_accessors(qw/ normal /);
+  __PACKAGE__->meta->make_immutable;
+}
+{
+  package TestPackage::SubClass::Accessors;
+  use base qw/TestPackage/;
+  __PACKAGE__->mk_accessors(qw/ meta /);
+}
+{
+  package TestPackage::SubClass::Readonly;
+  use base qw/TestPackage/;
+  __PACKAGE__->mk_ro_accessors(qw/ meta /);
+}
+{
+  package TestPackage::SubClass::Writeonly;
+  use base qw/TestPackage/;
+  __PACKAGE__->mk_wo_accessors(qw(sekret double_sekret));
+}
+
+# This setup is a _specific_ example from Catalyst.
+
+# CAF _will not_ replace a pre-existing symbol, but there never
+# used to be a 'meta' symbol before CAF things are ported to Moose
+
+# Therefore, 'meta' needs to be treated as a special case, as
+# code which is _not_ using the symbol already should be allowed to
+# say $self->meta, and get all the Moose goodness, but code which
+# makes an accessor called ->meta should still work!
+
+# 22:22 <@groditi> the difference is meta wasnt there as a method before, but MooseX::Adopt::CAF does have a meta method.
+# 22:23 <@groditi> i guess i could namespace::clean it out. but it might create confusion
+# 22:23  * t0m nod - I think we need a special case for this..
+# 22:23 <@groditi> mst: thoughts?
+# 22:23 <@mst> Moose needs to not export 'meta' if you don't want it
+# 22:24 <@groditi> so namespace::clean it out or what?
+# 22:25 <@mst> hmm
+# 22:25 <@mst> does ->mk_accessors(qw(meta)) work if you do "use base qw(...)" instead of use Moose ?
+# 22:26 <@mst> if it doesn't, then it isn't a bug in CAF
+# 22:27 <@groditi> its my bug. because Adopt does use Moose because Emulate is a role
+# 22:27 <@groditi> so if you isa CAF then you definitely can(meta)
+# 22:27 <@t0m> I think that if the user makes an accessor called 'meta', we need to remove the Moose package symbol, and 
+#              immutable the class so the the accessor / constructor doesn't touch meta..
+# 22:27 <@t0m> and generate a warning.
+# 22:28 <@t0m> which is ugly as, but kinda works.
+# 22:29 <@groditi> ok ok. i'll do has_method
+# 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'
+# 22:29 <@groditi> this sucks though because Emulate counts on meta being there
+# 22:30 <@groditi> ok well this requires major major changes so delayed until i finish finals
+
+# Suggested fix - something less hacky than:
+#Index: lib/MooseX/Emulate/Class/Accessor/Fast.pm
+#===================================================================
+#--- lib/MooseX/Emulate/Class/Accessor/Fast.pm   (revision 7035)
+#+++ lib/MooseX/Emulate/Class/Accessor/Fast.pm   (working copy)
+#@@ -93,14 +93,15 @@
+# 
+# sub mk_accessors{
+#   my $self = shift;
+#-  my $meta = $self->meta;
+#+  my $meta = $self->Moose::Object::meta;
+#+  $meta->make_mutable if $meta->is_immutable;
+#   for my $attr_name (@_){
+#     my $reader = $self->accessor_name_for($attr_name);
+#     my $writer = $self->mutator_name_for( $attr_name);
+# 
+#     #dont overwrite existing methods
+#     if($reader eq $writer){
+#-      my %opts = ( $self->can($reader) ? () : (accessor => $reader) );
+#+      my %opts = ( $self->can($reader) && $reader ne 'meta' ? () : (accessor => $reader) );
+#       my $attr = $meta->add_attribute($attr_name, %opts);
+#       if($attr_name eq $reader){
+#         my $alias = "_${attr_name}_accessor";
+#@@ -115,6 +116,7 @@
+#       $meta->add_attribute($attr_name, @opts);
+#     }
+#   }
+#+  $meta->make_immutable;
+# }
+
+{
+  my $i = TestPackage::SubClass::Accessors->new({ normal => 42, meta => 66 });
+
+  # 1,2
+  is $i->normal, 42, 'normal accessor read value from constructor';
+  $i->normal(2);
+  is $i->normal, 2, 'normal accessor read set value';
+
+  TODO: {
+    local $TODO = 'meta method needs special case';
+
+    # 3,4
+    is $i->meta, 66, 'meta accessor read value from constructor';
+    $i->meta(9);
+    is $i->meta, 9, 'meta accessor read set value';
+  }
+}
+{
+  my $i = TestPackage::SubClass::Readonly->new({ normal => 42, meta => 66 });
+
+  # 5,6
+  is $i->normal, 42, 'normal accessor read value from constructor';
+  $i->{normal} = 2;
+  is $i->normal, 2, 'normal accessor read set value';
+
+  TODO: {
+    local $TODO = 'meta method needs special case';
+    
+    # 7,8
+    is $i->meta, 66, 'meta accessor read value from constructor';
+    $i->{meta} = 9;
+    is $i->meta, 9, 'meta accessor read set value';
+  }
+}
+{
+  my $i = TestPackage::SubClass::Writeonly->new({ normal => 42, meta => 66 });
+
+  # 9,10
+  is $i->normal, 42, 'normal accessor read value from constructor';
+  $i->normal(2);
+  is $i->normal, 2, 'normal accessor read set value';
+
+  TODO: {
+    local $TODO = 'meta method needs special case';
+
+    # 11,12
+    is $i->{meta}, 66, 'meta accessor read value from constructor';
+    $i->meta(9);
+    is $i->{meta}, 9, 'meta accessor read set value';
+  }
+}
diff --git a/t/no_replace_existing_symbols.t b/t/no_replace_existing_symbols.t
new file mode 100644
index 0000000..e59da3a
--- /dev/null
+++ b/t/no_replace_existing_symbols.t
@@ -0,0 +1,34 @@
+{
+  package SomeClass;
+  #use base qw/Class::Accessor::Fast/;
+  use Moose;
+  with 'MooseX::Emulate::Class::Accessor::Fast';
+  
+  sub anaccessor { 'wibble' }
+
+  #sub new { bless {}, 'SomeClass' }
+}
+{
+  package SubClass;
+  use base qw/SomeClass/;
+
+  sub anotherone { 'flibble' }
+  __PACKAGE__->mk_accessors(qw/ anaccessor anotherone /);
+}
+
+use Test::More tests => 6;
+
+# 1, 2
+my $someclass = SomeClass->new;
+is $someclass->anaccessor, 'wibble';
+$someclass->anaccessor('fnord');
+is $someclass->anaccessor, 'wibble';
+
+# 3-6
+my $subclass = SubClass->new;
+is $subclass->anaccessor, 'wibble';
+$subclass->anaccessor('fnord');
+is $subclass->anaccessor, 'wibble';
+is $subclass->anotherone, 'flibble';
+$subclass->anotherone('fnord');
+is $subclass->anotherone, 'flibble';