| Subject: | before and after broken when '$_' modified inside |
Class::Method::Modifiers generate code, that sensitive to modification of
$_ variable:
$_->(@_) for @$before;
Above constructs will die if coderefs in @$before array will modify $_
In attach fix + test that dies with version 1.12
| Subject: | cmm-fix-undercore-sensitivity.patch |
diff --git a/lib/Class/Method/Modifiers.pm b/lib/Class/Method/Modifiers.pm
index 7f481b0..17a31bd 100644
--- a/lib/Class/Method/Modifiers.pm
+++ b/lib/Class/Method/Modifiers.pm
@@ -91,7 +91,12 @@ sub install_modifier {
$generated .= "sub $name {";
# before is easy, it doesn't affect the return value(s)
- $generated .= '$_->(@_) for @$before;' if @$before;
+ if (@$before) {
+ $generated .= '
+ foreach my $meth (@$before) {
+ $meth->(@_);
+ }';
+ }
if (@$after) {
$generated .= '
@@ -106,7 +111,9 @@ sub install_modifier {
$$wrapped->(@_);
}
- $_->(@_) for @$after;
+ foreach my $meth (@$after) {
+ $meth->(@_);
+ }
return wantarray ? @ret : $ret[0];
';
diff --git a/t/120-modify-undercore.t b/t/120-modify-undercore.t
new file mode 100644
index 0000000..4737c3d
--- /dev/null
+++ b/t/120-modify-undercore.t
@@ -0,0 +1,37 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 2;
+
+my $storage = "0";
+
+my $child = Child->new();
+is($child->orig($storage), "110");
+$storage = "0";
+is($child->orig($storage), "110");
+
+BEGIN {
+ package Parent;
+ sub new { bless {}, shift }
+ sub orig {
+ my $self = shift;
+ $_ = "some value";
+ $_[0];
+ }
+}
+
+BEGIN {
+ package Child;
+ our @ISA = 'Parent';
+ use Class::Method::Modifiers;
+
+ before 'orig' => sub {
+ my $self = shift;
+ $_[0] = '1'.$_[0];
+ $_='babah';
+ };
+ before 'orig' => sub {
+ my $self = shift;
+ $_[0] = '1'.$_[0];
+ };
+}