From: Stash Date: Fri, 17 Jul 2009 01:10:03 +0000 (-0700) Subject: Fix exception when $_ is modified in before/after. X-Git-Tag: 0.90~3 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=342c0218f20cac0d4201e3d02eadc79d98bd3ac1;hp=7fe2c0b65ce511286856916fc8f245d2d3bc4f9c;p=gitmo%2FClass-MOP.git 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 --- 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 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}); +}