In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/73512201d7f34e916ab9c04a5f41248b4740e29a?hp=b9e5552c5b9043f5218eef298d903a543fa001b5>
- Log ----------------------------------------------------------------- commit 73512201d7f34e916ab9c04a5f41248b4740e29a Author: David Golden <[email protected]> Date: Fri Dec 9 14:32:08 2011 -0500 Fix segfault on overloaded arithmetic assignment Consider an arithmetic assignment operation of the form $left += $right A segfault was occuring in the case where $right is an overloaded object but $left is not; and where $right does not override "+=" but does provide a 'nomethod' override. Internally, Perl_amagic_call was attempting to clone $left as if it were an overloaded object, causing the segfault. This commit fixes the segfault by only cloning the left operand when the left operand is the overloaded one. ----------------------------------------------------------------------- Summary of changes: MANIFEST | 1 + gv.c | 4 ++-- pod/perldelta.pod | 6 ++++++ t/lib/overload_nomethod.t | 22 ++++++++++++++++++++++ 4 files changed, 31 insertions(+), 2 deletions(-) create mode 100644 t/lib/overload_nomethod.t diff --git a/MANIFEST b/MANIFEST index c6eb168..0399d69 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4994,6 +4994,7 @@ t/lib/mypragma.pm An example user pragma t/lib/mypragma.t Test the example user pragma t/lib/no_load.t Test that some modules don't load others t/lib/overload_fallback.t Test that using overload 2x in a scope doesn't clobber fallback +t/lib/overload_nomethod.t Test that nomethod works as expected t/lib/proxy_constant_subs.t Test that Proxy Constant Subs behave correctly t/lib/Sans_mypragma.pm Test module for t/lib/mypragma.t t/lib/strict/refs Tests of "use strict 'refs'" for strict.t diff --git a/gv.c b/gv.c index 3a978f2..2af41a8 100644 --- a/gv.c +++ b/gv.c @@ -2880,9 +2880,9 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) /* off is method, method+assignshift, or a result of opcode substitution. * In the latter case assignshift==0, so only notfound case is important. */ - if (( (method + assignshift == off) + if ( (lr == -1) && ( ( (method + assignshift == off) && (assign || (method == inc_amg) || (method == dec_amg))) - || force_cpy) + || force_cpy) ) { /* newSVsv does not behave as advertised, so we copy missing * information by hand */ diff --git a/pod/perldelta.pod b/pod/perldelta.pod index d889437..85a80ca 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -670,6 +670,12 @@ C<goto &func> no longers crashes, but produces an error message, when the unwinding of the current subroutine's scope fires a destructor that undefines the subroutine being "goneto" [perl #99850]. +=item * + +Arithmetic assignment (C<$left += $right>) involving overloaded objects that +rely on the 'nomethod' override no longer segfault when the left operand is not +overloaded. + =back =head1 Known Problems diff --git a/t/lib/overload_nomethod.t b/t/lib/overload_nomethod.t new file mode 100644 index 0000000..d72dcee --- /dev/null +++ b/t/lib/overload_nomethod.t @@ -0,0 +1,22 @@ +use warnings; +use strict; +use Test::Simple tests => 3; + +package Foo; +use overload + nomethod => sub { die "unimplemented\n" }; +sub new { bless {}, shift }; + +package main; + +my $foo = Foo->new; + +eval {my $val = $foo + 1}; +ok( $@ =~ /unimplemented/ ); + +eval {$foo += 1}; +ok( $@ =~ /unimplemented/ ); + +eval {my $val = 0; $val += $foo}; +ok( $@ =~ /unimplemented/ ); + -- Perl5 Master Repository
