This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix segfault on overloaded arithmetic assignment
authorDavid Golden <dagolden@cpan.org>
Fri, 9 Dec 2011 19:32:08 +0000 (14:32 -0500)
committerDavid Golden <dagolden@cpan.org>
Fri, 9 Dec 2011 19:44:42 +0000 (14:44 -0500)
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.

MANIFEST
gv.c
pod/perldelta.pod
t/lib/overload_nomethod.t [new file with mode: 0644]

index c6eb168..0399d69 100644 (file)
--- 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 (file)
--- 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 */
index d889437..85a80ca 100644 (file)
@@ -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 (file)
index 0000000..d72dcee
--- /dev/null
@@ -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/ );
+