[libmoo-perl] 29/43: Revert "make has +attr in roles consistent with classes"
gregor herrmann
gregoa at debian.org
Mon Dec 26 17:56:15 UTC 2016
This is an automated email from the git hooks/post-receive script.
gregoa pushed a commit to branch master
in repository libmoo-perl.
commit 9a2c3130f95f03ed194c9600c186f1a3988e8c9f
Author: Graham Knop <haarg at haarg.org>
Date: Tue Dec 6 21:45:39 2016 -0500
Revert "make has +attr in roles consistent with classes"
This reverts commit c57ed0008cc7a3f22ceb7120166697171b4a8794.
This will break compatibility, and needs more exploration to solve
correctly.
---
lib/Moo/Role.pm | 18 +++---------------
t/accessor-roles.t | 2 +-
t/has-plus.t | 25 -------------------------
3 files changed, 4 insertions(+), 41 deletions(-)
diff --git a/lib/Moo/Role.pm b/lib/Moo/Role.pm
index eb55a59..1a81cf5 100644
--- a/lib/Moo/Role.pm
+++ b/lib/Moo/Role.pm
@@ -71,23 +71,11 @@ sub _install_subs {
my %spec = @_;
foreach my $name (@name_proto) {
my $spec_ref = @name_proto > 1 ? +{%spec} : \%spec;
- my $ag = $INFO{$target}{accessor_maker} ||= do {
+ ($INFO{$target}{accessor_maker} ||= do {
require Method::Generate::Accessor;
Method::Generate::Accessor->new
- };
- my $attrs = $INFO{$target}{attributes}||=[];
- if ($name =~ /^\+(.*)/) {
- my $attr_name = $1;
- my ($old_spec) =
- map $attrs->[$_+1],
- grep $attrs->[$_] eq $attr_name,
- 0 .. @$attrs/2 - 1;
- croak "has '${name}' given but no ${attr_name} attribute already exists"
- unless $old_spec;
- $ag->merge_specs($spec_ref, $old_spec);
- }
- $ag->generate_method($target, $name, $spec_ref);
- push @$attrs, $name, $spec_ref;
+ })->generate_method($target, $name, $spec_ref);
+ push @{$INFO{$target}{attributes}||=[]}, $name, $spec_ref;
$me->_maybe_reset_handlemoose($target);
}
};
diff --git a/t/accessor-roles.t b/t/accessor-roles.t
index 1546ebf..51ffb31 100644
--- a/t/accessor-roles.t
+++ b/t/accessor-roles.t
@@ -15,7 +15,7 @@ use Sub::Quote;
has four => (is => 'ro', lazy => 1, default => sub { 'four' }, predicate => 1);
package One::P3; use Moo::Role;
- has 'three' => (is => 'ro', default => sub { 'three' });
+ has '+three' => (is => 'ro', default => sub { 'three' });
}
my $combined = Moo::Role->create_class_with_roles('One', qw(One::P1 One::P2));
diff --git a/t/has-plus.t b/t/has-plus.t
index 27c65cf..1287a20 100644
--- a/t/has-plus.t
+++ b/t/has-plus.t
@@ -48,22 +48,6 @@ use Test::Fatal;
}
{
- package RoleWithTheRole;
- use Moo::Role;
-
- with 'RollyRole';
-
- has '+f' => (default => sub { 4 });
-}
-
-{
- package UsesTheOtherRole;
- use Moo;
-
- with 'RoleWithTheRole';
-}
-
-{
package BlowsUp;
use Moo;
@@ -72,14 +56,6 @@ use Test::Fatal;
}
{
- package RoleBlowsUp;
-
- use Moo::Role;
-
- ::like(::exception { has '+f' => () }, qr/\Qhas '+f'/, 'Kaboom');
-}
-
-{
package ClassyClass2;
use Moo;
has d => (is => 'ro', default => sub { 4 });
@@ -102,6 +78,5 @@ is(UsesTheRole->new->f, 0, 'role attr');
is(ClassyClass->new->f, 1, 'class attr');
is(UsesTheRole2->new->f, 2, 'role attr with +');
is(ExtendsTheClass->new->f, 3, 'class attr with +');
-is(UsesTheOtherRole->new->f, 4, 'role attr with + in role');
done_testing;
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libmoo-perl.git
More information about the Pkg-perl-cvs-commits
mailing list