Fix exception when $_ is modified in before/after.

I _think_ what's happening here is that $_ was getting aliased to an entry in
@$before/@$after, so that modifying $_ would in fact modify that array slot's
scalar.

Declaring `my $c` like this doesn't seem to impact performance vs. using $_.
Putting it outside the "cache" closure means `my` only gets run once.

diff --git a/lib/Class/MOP/Method/Wrapped.pm b/lib/Class/MOP/Method/Wrapped.pm
index 4e72a59..11492d5 100644 (file)
--- a/lib/Class/MOP/Method/Wrapped.pm
+++ b/lib/Class/MOP/Method/Wrapped.pm
@@ -26,9 +26,10 @@ my $_build_wrapped_method = sub {
         $modifier_table->{after},
         $modifier_table->{around},
     );
+    my $c;
     if (@$before && @$after) {
         $modifier_table->{cache} = sub {
-            $_->(@_) for @{$before};
+            for $c (@$before) { $c->(@_) };
             my @rval;
             ((defined wantarray) ?
                 ((wantarray) ?
@@ -37,14 +38,14 @@ my $_build_wrapped_method = sub {
                     ($rval[0] = $around->{cache}->(@_)))
                 :
                 $around->{cache}->(@_));
-            $_->(@_) for @{$after};
+            for $c (@$after) { $c->(@_) };
             return unless defined wantarray;
             return wantarray ? @rval : $rval[0];
         }
     }
     elsif (@$before && !@$after) {
         $modifier_table->{cache} = sub {
-            $_->(@_) for @{$before};
+            for $c (@$before) { $c->(@_) };
             return $around->{cache}->(@_);
         }
     }
@@ -58,7 +59,7 @@ my $_build_wrapped_method = sub {
                     ($rval[0] = $around->{cache}->(@_)))
                 :
                 $around->{cache}->(@_));
-            $_->(@_) for @{$after};
+            for $c (@$after) { $c->(@_) };
             return unless defined wantarray;
             return wantarray ? @rval : $rval[0];
         }

diff --git a/t/313_before_after_dollar_under.t b/t/313_before_after_dollar_under.t
new file mode 100644 (file)
index 0000000..f029173
--- /dev/null
+++ b/t/313_before_after_dollar_under.t
@@ -0,0 +1,57 @@
+use strict;
+use warnings;
+
+use Class::MOP;
+use Class::MOP::Class;
+use Test::More qw/no_plan/;
+use Test::Exception;
+
+my %results;
+
+{
+    package Base;
+    use metaclass;
+    sub hey { $results{base}++ }
+}
+
+for my $wrap (qw(before after)) {
+    my $meta = Class::MOP::Class->create_anon_class(
+        superclasses => ['Base', 'Class::MOP::Object']
+    );
+    my $alter = "add_${wrap}_method_modifier";
+    $meta->$alter('hey' => sub {
+        $results{wrapped}++;
+        $_ = 'barf'; # 'barf' would replace the cached wrapper subref
+    });
+
+    %results = ();
+    my $o = $meta->get_meta_instance->create_instance;
+    isa_ok($o, 'Base');
+    lives_ok {
+        $o->hey;
+        $o->hey; # this would die with 'Can't use string ("barf") as a subroutine ref while "strict refs" in use'
+    } 'wrapped doesn\'t die when $_ gets changed';
+    is_deeply(\%results, {base=>2,wrapped=>2});
+}
+
+{
+    my $meta = Class::MOP::Class->create_anon_class(
+        superclasses => ['Base', 'Class::MOP::Object']
+    );
+    for my $wrap (qw(before after)) {
+        my $alter = "add_${wrap}_method_modifier";
+        $meta->$alter('hey' => sub {
+            $results{wrapped}++;
+            $_ = 'barf'; # 'barf' would replace the cached wrapper subref
+        });
+    }
+
+    %results = ();
+    my $o = $meta->get_meta_instance->create_instance;
+    isa_ok($o, 'Base');
+    lives_ok {
+        $o->hey;
+        $o->hey; # this would die with 'Can't use string ("barf") as a subroutine ref while "strict refs" in use'
+    } 'double-wrapped doesn\'t die when $_ gets changed';
+    is_deeply(\%results, {base=>2,wrapped=>4});
+}