[perl #87708] $tied + $tied

This is just part of #87708.

This fixes the + operator outside of any ‘use integer’ when the same
tied scalar is used for both operands and returns two different val-
ues. Before this commit, get-magic would be called only once and the
same value used. In 5.12.x it worked.

diff --git a/pp_hot.c b/pp_hot.c
index f8a61cb..3d46287 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -501,6 +501,16 @@ PP(pp_add)
     svl = TOPm1s;
 
     useleft = USE_LEFT(svl);
     svl = TOPm1s;
 
     useleft = USE_LEFT(svl);

+    if(useleft && svr == svl) {
+       /* Print the uninitialized warning now, so it includes the vari-
+          able name. */
+       if (!SvOK(svl)) report_uninit(svl), useleft = 0;
+       /* Non-magical sv_mortalcopy */
+       svl = sv_newmortal();
+       sv_setsv_flags(svl, svr, 0);
+       SvGETMAGIC(svr);
+    }
+

 #ifdef PERL_PRESERVE_IVUV
     /* We must see if we can perform the addition with integers if possible,
        as the integer code detects overflow while the NV code doesn't.
 #ifdef PERL_PRESERVE_IVUV
     /* We must see if we can perform the addition with integers if possible,
        as the integer code detects overflow while the NV code doesn't.

diff --git a/t/lib/warnings/9uninit b/t/lib/warnings/9uninit
index a16fd35..33cc2b9 100644 (file)
--- a/t/lib/warnings/9uninit
+++ b/t/lib/warnings/9uninit
@@ -689,6 +689,16 @@ Use of uninitialized value $g1 in subtraction (-) at - line 20.
 Use of uninitialized value $m1 in subtraction (-) at - line 20.
 ########
 use warnings 'uninitialized';
 Use of uninitialized value $m1 in subtraction (-) at - line 20.
 ########
 use warnings 'uninitialized';

+sub TIESCALAR{bless[]}
+sub FETCH { undef }
+
+tie my $m1, "";
+my $v = $m1 + $m1;
+EXPECT
+Use of uninitialized value $m1 in addition (+) at - line 6.
+Use of uninitialized value $m1 in addition (+) at - line 6.
+########
+use warnings 'uninitialized';

 my ($m1, $v);
 our ($g1);
 
 my ($m1, $v);
 our ($g1);
 

diff --git a/t/op/tie_fetch_count.t b/t/op/tie_fetch_count.t
index d6cf9c6..be339cd 100644 (file)
--- a/t/op/tie_fetch_count.t
+++ b/t/op/tie_fetch_count.t
@@ -228,8 +228,8 @@ bin_test '.' ,  1, 2, 12;
 {
     local $TODO = $todo ;
     bin_test '==',  1, 2, "";
 {
     local $TODO = $todo ;
     bin_test '==',  1, 2, "";

-    bin_test '+' ,  1, 2, 3;

 }
 }

+bin_test '+' ,  1, 2, 3;

 bin_int_test '*' ,  2, 3, 6;
 bin_int_test '/' , 10, 2, 5;
 bin_int_test '%' , 11, 2, 1;
 bin_int_test '*' ,  2, 3, 6;
 bin_int_test '/' , 10, 2, 5;
 bin_int_test '%' , 11, 2, 1;