r27278 - in /branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current: Changes MANIFEST META.yml Makefile.PL 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:17:34 UTC 2008
Author: eloy
Date: Wed Nov 26 09:17:31 2008
New Revision: 27278
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=27278
Log:
[svn-upgrade] Integrating new upstream version, libmoosex-emulate-class-accessor-fast-perl (0.00400)
Added:
branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/t/construction.t
Modified:
branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/Changes
branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/MANIFEST
branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/META.yml
branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/Makefile.PL
branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/lib/MooseX/Emulate/Class/Accessor/Fast.pm
branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/t/accessors.t
Modified: branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/Changes?rev=27278&op=diff
==============================================================================
--- branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/Changes (original)
+++ branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/Changes Wed Nov 26 09:17:31 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: branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/MANIFEST?rev=27278&op=diff
==============================================================================
--- branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/MANIFEST (original)
+++ branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/MANIFEST Wed Nov 26 09:17:31 2008
@@ -15,5 +15,6 @@
README
t/accessors.t
t/adopt.t
+t/construction.t
t/getset.t
t/lib/TestAdoptCAF.pm
Modified: branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/META.yml?rev=27278&op=diff
==============================================================================
--- branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/META.yml (original)
+++ branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/META.yml Wed Nov 26 09:17:31 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: branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/Makefile.PL?rev=27278&op=diff
==============================================================================
--- branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/Makefile.PL (original)
+++ branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/Makefile.PL Wed Nov 26 09:17:31 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: branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/lib/MooseX/Emulate/Class/Accessor/Fast.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/lib/MooseX/Emulate/Class/Accessor/Fast.pm?rev=27278&op=diff
==============================================================================
--- branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/lib/MooseX/Emulate/Class/Accessor/Fast.pm (original)
+++ branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/lib/MooseX/Emulate/Class/Accessor/Fast.pm Wed Nov 26 09:17:31 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: branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/t/accessors.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/t/accessors.t?rev=27278&op=diff
==============================================================================
--- branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/t/accessors.t (original)
+++ branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/t/accessors.t Wed Nov 26 09:17:31 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';
Added: branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/t/construction.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/t/construction.t?rev=27278&op=file
==============================================================================
--- branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/t/construction.t (added)
+++ branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/t/construction.t Wed Nov 26 09:17:31 2008
@@ -1,0 +1,71 @@
+#!perl
+use strict;
+use Test::More tests => 9;
+
+#1
+require_ok("MooseX::Emulate::Class::Accessor::Fast");
+
+{
+ package MyClass;
+ use Moose;
+ with 'MooseX::Emulate::Class::Accessor::Fast';
+}
+
+{
+ package MyClass::MooseChild;
+ use Moose;
+ extends 'MyClass';
+}
+
+{
+ package MyClass::ImmutableMooseChild;
+ use Moose;
+ extends 'MyClass';
+ __PACKAGE__->meta->make_immutable;
+}
+
+{
+ package MyClass::TraditionalChild;
+ use base qw(MyClass);
+}
+
+{
+ package MyImmutableClass;
+ use Moose;
+ with 'MooseX::Emulate::Class::Accessor::Fast';
+ __PACKAGE__->meta->make_immutable;
+}
+
+{
+ package MyImmutableClass::MooseChild;
+ use Moose;
+ extends 'MyImmutableClass';
+}
+
+{
+ package MyImmutableClass::ImmutableMooseChild;
+ use Moose;
+ extends 'MyImmutableClass';
+ __PACKAGE__->meta->make_immutable;
+}
+
+{
+ package MyImmutableClass::TraditionalChild;
+ use base qw(MyImmutableClass);
+}
+
+# 2-9
+foreach my $class (qw/
+ MyClass
+ MyImmutableClass
+ MyClass::MooseChild
+ MyClass::ImmutableMooseChild
+ MyClass::TraditionalChild
+ MyImmutableClass::MooseChild
+ MyImmutableClass::ImmutableMooseChild
+ MyImmutableClass::TraditionalChild
+ /) {
+ my $instance = $class->new(foo => 'bar');
+ is($instance->{foo}, 'bar', $class . " has CAF construction behavior");
+}
+
More information about the Pkg-perl-cvs-commits
mailing list