[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