New upstream version 2.001003

8 files changed, 85 insertions, 22 deletions

diff --git a/Changes b/Changes
index 7ffaa00..49aef03 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,15 @@
 Revision history for Role-Tiny
 
+2.001003 - 2019-10-09
+  - releasing as stable
+
+2.001_002 - 2019-10-06
+  - fix methods from roles composed via create_class_with_roles being treated
+    differently from roles composed directly (RT#128470)
+  - fix constants being included in the methods provided by a role if they
+    were created before importing Role::Tiny but used after importing
+  - fix prototype handling test on cperl
+
 2.001001 - 2019-10-01
   - added tests for make_role
 
diff --git a/META.json b/META.json
index d2f1e18..04f589c 100644
--- a/META.json
+++ b/META.json
@@ -60,6 +60,6 @@
       },
       "x_IRC" : "irc://irc.perl.org/#moose"
    },
-   "version" : "2.001001",
+   "version" : "2.001003",
    "x_serialization_backend" : "JSON::PP version 4.04"
 }
diff --git a/META.yml b/META.yml
index 39966a9..83341b3 100644
--- a/META.yml
+++ b/META.yml
@@ -25,5 +25,5 @@ resources:
   bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Role-Tiny
   license: http://dev.perl.org/licenses/
   repository: git://github.com/moose/Role-Tiny.git
-version: '2.001001'
+version: '2.001003'
 x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
diff --git a/lib/Role/Tiny.pm b/lib/Role/Tiny.pm
index 90c9520..9257bb5 100644
--- a/lib/Role/Tiny.pm
+++ b/lib/Role/Tiny.pm
@@ -2,7 +2,7 @@ package Role::Tiny;
 use strict;
 use warnings;
 
-our $VERSION = '2.001001';
+our $VERSION = '2.001003';
 $VERSION =~ tr/_//d;
 
 our %INFO;
@@ -19,6 +19,7 @@ BEGIN {
     = "$]" < 5.011 && !("$]" >= 5.009004 && "$]" < 5.010001)
       ? sub(){1} : sub(){0};
   *_MRO_MODULE = "$]" < 5.010 ? sub(){"MRO/Compat.pm"} : sub(){"mro.pm"};
+  *_CONSTANTS_DEFLATE = "$]" >= 5.012 && "$]" < 5.020 ? sub(){1} : sub(){0};
 }
 
 sub _getglob { no strict 'refs'; \*{$_[0]} }
@@ -57,7 +58,17 @@ sub _all_subs {
   my ($me, $package) = @_;
   my $stash = _getstash($package);
   return {
-    map +($_ => \&{"${package}::${_}"}),
+    map {;
+      no strict 'refs';
+      # this is an ugly hack to populate the scalar slot of any globs, to
+      # prevent perl from converting constants back into scalar refs in the
+      # stash when they are used (perl 5.12 - 5.18). scalar slots on their own
+      # aren't detectable through pure perl, so this seems like an acceptable
+      # compromise.
+      ${"${package}::${_}"} = ${"${package}::${_}"}
+        if _CONSTANTS_DEFLATE;
+      $_ => \&{"${package}::${_}"}
+    }
     grep exists &{"${package}::${_}"},
     grep !/::\z/,
     keys %$stash
@@ -419,21 +430,21 @@ sub methods_provided_by {
 sub _install_methods {
   my ($me, $to, $role) = @_;
 
-  my $info = $INFO{$role};
-
   my $methods = $me->_concrete_methods_of($role);
 
-  # grab target symbol table
-  my $stash = _getstash($to);
+  my %existing_methods;
+  for my $package ($to, grep $_ ne $role, keys %{$APPLIED_TO{$to}}) {
+    @existing_methods{keys %{ $me->_concrete_methods_of($package) }} = ();;
+  }
 
-  foreach my $i (keys %$methods) {
-    my $target = $stash->{$i};
+  # _concrete_methods_of caches its result on roles.  that cache needs to be
+  # invalidated after applying roles
+  delete $INFO{$to}{methods} if $INFO{$to};
 
-    no warnings 'once';
-    no strict 'refs';
 
+  foreach my $i (keys %$methods) {
     next
-      if exists &{"${to}::${i}"};
+      if exists $existing_methods{$i};
 
     my $glob = _getglob "${to}::${i}";
     *$glob = $methods->{$i};
diff --git a/lib/Role/Tiny/With.pm b/lib/Role/Tiny/With.pm
index d6b1f71..eb9abe8 100644
--- a/lib/Role/Tiny/With.pm
+++ b/lib/Role/Tiny/With.pm
@@ -3,7 +3,7 @@ package Role::Tiny::With;
 use strict;
 use warnings;
 
-our $VERSION = '2.001001';
+our $VERSION = '2.001003';
 $VERSION =~ tr/_//d;
 
 use Role::Tiny ();
diff --git a/t/concrete-methods.t b/t/concrete-methods.t
index 603ad95..5f9aaad 100644
--- a/t/concrete-methods.t
+++ b/t/concrete-methods.t
@@ -16,6 +16,7 @@ BEGIN {
   our $before_constant_glob = 1;
   use constant before_constant_inflate => 1;
   use constant before_constant_list_inflate => (4, 5);
+  use constant before_constant_deflate => 1;
 
   # subs stored directly in the stash are meant to be supported in perl 5.22+,
   # but until 5.26.1 they have a risk of segfaulting.  perl itself won't ever
@@ -49,6 +50,8 @@ BEGIN {
     \&after_constant_list_inflate,
   ) {}
 
+  my $deflated = before_constant_deflate;
+
   bless \&before_sub_blessed;
   bless \&after_sub_blessed;
 }
diff --git a/t/proto.t b/t/proto.t
index 981cb0f..3f09dff 100644
--- a/t/proto.t
+++ b/t/proto.t
@@ -2,6 +2,8 @@ use strict;
 use warnings;
 use Test::More;
 
+my $invalid_prototypes;
+
 BEGIN {
   package TestExporter1;
   $INC{"TestExporter1.pm"} = 1;
@@ -14,8 +16,12 @@ BEGIN {
   sub farb ($) { rand(1) }
 
   no warnings;
-  sub tube (plaf) { rand(1) }
-  sub truck (-1) { rand(1) }
+
+  eval q{
+    sub tube (plaf) { rand(1) }
+    sub truck (-1) { rand(1) }
+    1;
+  } and $invalid_prototypes = 1;
 }
 
 BEGIN {
@@ -38,12 +44,15 @@ BEGIN {
   eval { farb 1 };
   ::is $@, '',
     'composing matching function with ($) prototype works';
-  eval { &tube };
-  ::is $@, '',
-    'composing matching function with invalid prototype works';
-  eval { &truck };
-  ::is $@, '',
-    'composing matching function with invalid -1 prototype works';
+
+  if ($invalid_prototypes) {
+    eval { &tube };
+    ::is $@, '',
+      'composing matching function with invalid prototype works';
+    eval { &truck };
+    ::is $@, '',
+      'composing matching function with invalid -1 prototype works';
+  }
 }
 
 done_testing;
diff --git a/t/subclass.t b/t/subclass.t
index 5eeb12d..e17383b 100644
--- a/t/subclass.t
+++ b/t/subclass.t
@@ -107,4 +107,34 @@ SKIP: {
     'requires checked properly during create_class_with_roles';
 }
 
+{
+  package SimpleRole1;
+  use Role::Tiny;
+  sub role_method { __PACKAGE__ }
+}
+
+{
+  package SimpleRole2;
+  use Role::Tiny;
+  sub role_method { __PACKAGE__ }
+}
+
+{
+  package SomeEmptyClass;
+  $INC{'SomeEmptyClass.pm'} ||= __FILE__;
+}
+
+{
+  my $create_class = Role::Tiny->create_class_with_roles('SomeEmptyClass', 'SimpleRole1');
+  Role::Tiny->apply_roles_to_package( $create_class, 'SimpleRole2' );
+
+  my $manual_extend = 'ManualExtend';
+  @ManualExtend::ISA = qw(SomeEmptyClass);
+  Role::Tiny->apply_roles_to_package( $manual_extend, 'SimpleRole1' );
+  Role::Tiny->apply_roles_to_package( $manual_extend, 'SimpleRole2' );
+
+  is $create_class->role_method, $manual_extend->role_method,
+    'methods added by create_class_with_roles treated equal to those added with apply_roles_to_package';
+}
+
 done_testing;