r27280 - in /trunk/libmoosex-emulate-class-accessor-fast-perl: Changes MANIFEST META.yml Makefile.PL debian/changelog lib/MooseX/Emulate/Class/Accessor/Fast.pm t/accessors.t t/construction.t

eloy at users.alioth.debian.org eloy at users.alioth.debian.org
Wed Nov 26 09:21:53 UTC 2008


Author: eloy
Date: Wed Nov 26 09:21:50 2008
New Revision: 27280

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=27280
Log:
new upstream version

Added:
    trunk/libmoosex-emulate-class-accessor-fast-perl/t/construction.t
      - copied unchanged from r27279, branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/t/construction.t
Modified:
    trunk/libmoosex-emulate-class-accessor-fast-perl/Changes
    trunk/libmoosex-emulate-class-accessor-fast-perl/MANIFEST
    trunk/libmoosex-emulate-class-accessor-fast-perl/META.yml
    trunk/libmoosex-emulate-class-accessor-fast-perl/Makefile.PL
    trunk/libmoosex-emulate-class-accessor-fast-perl/debian/changelog
    trunk/libmoosex-emulate-class-accessor-fast-perl/lib/MooseX/Emulate/Class/Accessor/Fast.pm
    trunk/libmoosex-emulate-class-accessor-fast-perl/t/accessors.t

Modified: trunk/libmoosex-emulate-class-accessor-fast-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-emulate-class-accessor-fast-perl/Changes?rev=27280&op=diff
==============================================================================
--- trunk/libmoosex-emulate-class-accessor-fast-perl/Changes (original)
+++ trunk/libmoosex-emulate-class-accessor-fast-perl/Changes Wed Nov 26 09:21:50 2008
@@ -1,3 +1,8 @@
+0.00400    Oct 28, 2008
+           - Fix bug where a bad assumption was causing us to infinitely loop
+             on badly-written code like Data::Page. (Reported by marcus)
+             - Tests for this
+             - Up Moose dep to 0.31 
 0.00300    Jul XX, 2008
            - Replace around 'new' with a BUILD method. Faster and avoids Moose
              bug with around/immutable and sub-classes.

Modified: trunk/libmoosex-emulate-class-accessor-fast-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-emulate-class-accessor-fast-perl/MANIFEST?rev=27280&op=diff
==============================================================================
--- trunk/libmoosex-emulate-class-accessor-fast-perl/MANIFEST (original)
+++ trunk/libmoosex-emulate-class-accessor-fast-perl/MANIFEST Wed Nov 26 09:21:50 2008
@@ -15,5 +15,6 @@
 README
 t/accessors.t
 t/adopt.t
+t/construction.t
 t/getset.t
 t/lib/TestAdoptCAF.pm

Modified: trunk/libmoosex-emulate-class-accessor-fast-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-emulate-class-accessor-fast-perl/META.yml?rev=27280&op=diff
==============================================================================
--- trunk/libmoosex-emulate-class-accessor-fast-perl/META.yml (original)
+++ trunk/libmoosex-emulate-class-accessor-fast-perl/META.yml Wed Nov 26 09:21:50 2008
@@ -16,7 +16,7 @@
     - inc
     - t
 requires:
-  Moose: 0
+  Moose: 0.31
 resources:
   license: http://dev.perl.org/licenses/
-version: 0.00300
+version: 0.00400

Modified: trunk/libmoosex-emulate-class-accessor-fast-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-emulate-class-accessor-fast-perl/Makefile.PL?rev=27280&op=diff
==============================================================================
--- trunk/libmoosex-emulate-class-accessor-fast-perl/Makefile.PL (original)
+++ trunk/libmoosex-emulate-class-accessor-fast-perl/Makefile.PL Wed Nov 26 09:21:50 2008
@@ -9,8 +9,7 @@
 all_from 'lib/MooseX/Emulate/Class/Accessor/Fast.pm';
 
 # Specific dependencies
-requires 'Moose';
-
+requires 'Moose' => '0.31';
 build_requires 'Test::More' => 0;
 
 WriteAll;

Modified: trunk/libmoosex-emulate-class-accessor-fast-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-emulate-class-accessor-fast-perl/debian/changelog?rev=27280&op=diff
==============================================================================
--- trunk/libmoosex-emulate-class-accessor-fast-perl/debian/changelog (original)
+++ trunk/libmoosex-emulate-class-accessor-fast-perl/debian/changelog Wed Nov 26 09:21:50 2008
@@ -1,9 +1,13 @@
-libmoosex-emulate-class-accessor-fast-perl (0.00300-2) UNRELEASED; urgency=low
+libmoosex-emulate-class-accessor-fast-perl (0.00400-1) UNRELEASED; urgency=low
 
+  [ Krzysztof Krzyżaniak (eloy) <eloy at debian.org> ]
+  * New upstream release
+
+  [ gregor herrmann <gregoa at debian.org> ]
   * debian/control: Changed: Switched Vcs-Browser field to ViewSVN
     (source stanza).
 
- -- gregor herrmann <gregoa at debian.org>  Sun, 16 Nov 2008 20:45:05 +0100
+ -- Krzysztof Krzyżaniak (eloy) <eloy at debian.org>  Wed, 26 Nov 2008 10:18:14 +0100
 
 libmoosex-emulate-class-accessor-fast-perl (0.00300-1) unstable; urgency=low
 

Modified: trunk/libmoosex-emulate-class-accessor-fast-perl/lib/MooseX/Emulate/Class/Accessor/Fast.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-emulate-class-accessor-fast-perl/lib/MooseX/Emulate/Class/Accessor/Fast.pm?rev=27280&op=diff
==============================================================================
--- trunk/libmoosex-emulate-class-accessor-fast-perl/lib/MooseX/Emulate/Class/Accessor/Fast.pm (original)
+++ trunk/libmoosex-emulate-class-accessor-fast-perl/lib/MooseX/Emulate/Class/Accessor/Fast.pm Wed Nov 26 09:21:50 2008
@@ -2,7 +2,7 @@
 
 use Moose::Role;
 
-our $VERSION = '0.00300';
+our $VERSION = '0.00400';
 
 =head1 NAME
 
@@ -97,17 +97,23 @@
   for my $attr_name (@_){
     my $reader = $self->accessor_name_for($attr_name);
     my $writer = $self->mutator_name_for( $attr_name);
+
     #dont overwrite existing methods
-    my @opts = $reader eq $writer ?
-      ( $self->can($reader) ? () : (accessor => $reader) ) :
-        (
-         ( $self->can($reader) ? () : (reader => $reader) ),
-         ( $self->can($writer) ? () : (writer => $writer) ),
-        );
-    $meta->add_attribute($attr_name, @opts);
-
-    $meta->add_method("_${attr_name}_accessor", $self->can($reader) )
-      if($reader eq $attr_name && !$self->can("_${attr_name}_accessor") );
+    if($reader eq $writer){
+      my %opts = ( $self->can($reader) ? () : (accessor => $reader) );
+      my $attr = $meta->add_attribute($attr_name, %opts);
+      if($attr_name eq $reader){
+        my $alias = "_${attr_name}_accessor";
+        next if $self->can($alias);
+        my @alias_method = $opts{accessor} ? ( $alias => $self->can($reader) )
+          : ( $attr->process_accessors(accessor => $alias, 0 ) );
+        $meta->add_method(@alias_method);
+      }
+    } else {
+      my @opts = ( $self->can($writer) ? () : (writer => $writer) );
+      push(@opts, (reader => $reader)) unless $self->can($reader);
+      $meta->add_attribute($attr_name, @opts);
+    }
   }
 }
 
@@ -122,10 +128,12 @@
   my $meta = $self->meta;
   for my $attr_name (@_){
     my $reader = $self->accessor_name_for($attr_name);
-    $meta->add_attribute($attr_name,
-                         $self->can($reader) ? () : (reader => $reader) );
-    $meta->add_method("_${attr_name}_accessor", $meta->find_method_by_name($reader))
-      if($reader eq $attr_name && !$self->can("_${attr_name}_accessor") );
+    my @opts = ($self->can($reader) ? () : (reader => $reader) );
+    my $attr = $meta->add_attribute($attr_name, @opts);
+    if($reader eq $attr_name && $reader eq $self->mutator_name_for($attr_name)){
+      $meta->add_method("_${attr_name}_accessor" => $attr->get_read_method_ref)
+        unless $self->can("_${attr_name}_accessor");
+    }
   }
 }
 
@@ -141,9 +149,12 @@
   my $meta = $self->meta;
   for my $attr_name (@_){
     my $writer = $self->mutator_name_for($attr_name);
-    $meta->add_attribute($attr_name, $self->can($writer) ? () : (writer => $writer) );
-    $meta->add_method("_${attr_name}_accessor", $meta->find_method_by_name($writer))
-      if($writer eq $attr_name && !$self->can("_${attr_name}_accessor") );
+    my @opts = ($self->can($writer) ? () : (writer => $writer) );
+    my $attr = $meta->add_attribute($attr_name, @opts);
+    if($writer eq $attr_name && $writer eq $self->accessor_name_for($attr_name)){
+      $meta->add_method("_${attr_name}_accessor" => $attr->get_write_method_ref)
+        unless $self->can("_${attr_name}_accessor");
+    }
   }
 }
 

Modified: trunk/libmoosex-emulate-class-accessor-fast-perl/t/accessors.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-emulate-class-accessor-fast-perl/t/accessors.t?rev=27280&op=diff
==============================================================================
--- trunk/libmoosex-emulate-class-accessor-fast-perl/t/accessors.t (original)
+++ trunk/libmoosex-emulate-class-accessor-fast-perl/t/accessors.t Wed Nov 26 09:21:50 2008
@@ -1,6 +1,9 @@
 #!perl
 use strict;
-use Test::More tests => 32;
+use Test::More tests => 33;
+use Test::Exception;
+
+use Class::MOP;
 
 #1
 require_ok("MooseX::Adopt::Class::Accessor::Fast");
@@ -8,12 +11,21 @@
 my $class = "Testing::Class::Accessor::Fast";
 
 {
-  no strict 'refs';
-  @{"${class}::ISA"} = ('Class::Accessor::Fast');
-  *{"${class}::car"} = sub { shift->_car_accessor(@_); };
-  *{"${class}::mar"} = sub { return "Overloaded"; };
+  my $infinite_loop_indicator = 0;
+  my $meta = Class::MOP::Class->create(
+    $class,
+    superclasses => ['Class::Accessor::Fast'],
+    methods => {
+      car => sub { shift->_car_accessor(@_); },
+      mar => sub { return "Overloaded"; },
+      test => sub {
+        die('Infinite loop detected') if $infinite_loop_indicator++;
+        $_[0]->_test_accessor((@_ > 1 ? @_ : ()));
+      }
+    }
+  );
 
-  $class->mk_accessors(qw( foo bar yar car mar ));
+  $class->mk_accessors(qw( foo bar yar car mar test));
   $class->mk_ro_accessors(qw(static unchanged));
   $class->mk_wo_accessors(qw(sekret double_sekret));
   $class->follow_best_practice;
@@ -23,14 +35,14 @@
 my %attrs = map{$_->name => $_} $class->meta->compute_all_applicable_attributes;
 
 #2
-is(keys %attrs, 10, 'Correct number of attributes');
+is(keys %attrs, 11, 'Correct number of attributes');
 
 #3-12
 ok(exists $attrs{$_}, "Attribute ${_} created")
   for qw( foo bar yar car mar static unchanged sekret double_sekret best );
 
 #13-21
-ok($class->can("_${_}_accessor"), "Attribute ${_} created")
+ok($class->can("_${_}_accessor"), "Alias method (_${_}_accessor) for ${_} created")
   for qw( foo bar yar car mar static unchanged sekret double_sekret );
 
 #22-24
@@ -52,3 +64,6 @@
 #31,32
 is( $attrs{'best'}->reader, 'get_best', "Reader get_best created");
 is( $attrs{'best'}->writer, 'set_best', "Writer set_best created");
+
+#33
+lives_ok{ $class->new->test(1) } 'no auto-reference to accessors from aliases';




More information about the Pkg-perl-cvs-commits mailing list