[libmoo-perl] 21/43: fix @ISA assignment in create_class_with_roles

gregor herrmann gregoa at debian.org
Mon Dec 26 17:56:14 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 90e292eca76eb692de777c1c802da65cee188af4
Author: Graham Knop <haarg at haarg.org>
Date:   Thu Dec 1 20:44:29 2016 -0500

    fix @ISA assignment in create_class_with_roles
    
    If the @ISA already existed for some reason, it would break
    mro::get_linear_isa on 5.10.0.  Use the same workaround that Moo.pm
    uses.
---
 lib/Moo/Role.pm                  |  2 +-
 t/accessor-generator-extension.t | 20 ++++++++++++++++++++
 2 files changed, 21 insertions(+), 1 deletion(-)

diff --git a/lib/Moo/Role.pm b/lib/Moo/Role.pm
index 6f95bdf..eb55a59 100644
--- a/lib/Moo/Role.pm
+++ b/lib/Moo/Role.pm
@@ -317,7 +317,7 @@ sub create_class_with_roles {
       and $m = Moo->_accessor_maker_for($superclass)
       and ref($m) ne 'Method::Generate::Accessor') {
     # old fashioned way time.
-    *{_getglob("${new_name}::ISA")} = [ $superclass ];
+    @{*{_getglob("${new_name}::ISA")}{ARRAY}} = ($superclass);
     $Moo::MAKERS{$new_name} = {is_class => 1};
     $me->apply_roles_to_package($new_name, @roles);
   }
diff --git a/t/accessor-generator-extension.t b/t/accessor-generator-extension.t
index be840de..614e267 100644
--- a/t/accessor-generator-extension.t
+++ b/t/accessor-generator-extension.t
@@ -136,4 +136,24 @@ $o = ArrayTest4->new(one => 1, two => 2, three => 3, four => 4);
 
 is_deeply([ @$o ], [ 1, 2, 3, 4 ], 'Subclass of non-Moo object');
 
+
+{
+  package ArrayTestRole2;
+  use Moo::Role;
+
+  has four => (is => 'ro');
+}
+
+{
+  my ($new_c) = Moo::Role->_composite_name('ArrayTest1', 'ArrayTestRole2');
+  {
+    no strict 'refs';
+    # cause ISA to exist somehow
+    @{"${new_c}::ISA"} = ();
+  }
+  my $c = Moo::Role->create_class_with_roles('ArrayTest1', 'ArrayTestRole2');
+  is_deeply mro::get_linear_isa($c), [$c, 'ArrayTest1', 'Moo::Object'],
+    'mro::get_linear_isa is correct if create_class_with_roles target class @ISA existed';
+}
+
 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