This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #87708] $tied + $tied
authorFather Chrysostomos <sprout@cpan.org>
Thu, 7 Apr 2011 00:43:29 +0000 (17:43 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Thu, 7 Apr 2011 03:27:22 +0000 (20:27 -0700)
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.

pp_hot.c
t/lib/warnings/9uninit
t/op/tie_fetch_count.t

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);
+    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.
index a16fd35..33cc2b9 100644 (file)
@@ -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';
+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);
 
index d6cf9c6..be339cd 100644 (file)
@@ -228,8 +228,8 @@ bin_test '.' ,  1, 2, 12;
 {
     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;