[perl #87708] $tied % $tied and $tied * $tied under use integer

This is just part of #87708.

This fixes the % and * operators under ‘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 * just worked but the operands were
swapped for %.

It turns out that every operator using the dPOPTOPiirl_nomg macro
needs exactly the same treatment, so this commit eliminates the
dPOPTOPiirl_halfmg macro added a few commits ago and modifies
dPOPTOPiirl_nomg to do was it was doing. This should be perfectly
safe, as dPOPTOPiirl_nomg has not been in a stable release (and is
only for internal use anyway).

diff --git a/pp.c b/pp.c
index 51dc496..9858f91 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -2983,7 +2983,7 @@ PP(pp_i_lt)
     dVAR; dSP;
     tryAMAGICbin_MG(lt_amg, AMGf_set);
     {
-      dPOPTOPiirl_halfmg;
+      dPOPTOPiirl_nomg;
       SETs(boolSV(left < right));
       RETURN;
     }
@@ -2994,7 +2994,7 @@ PP(pp_i_gt)
     dVAR; dSP;
     tryAMAGICbin_MG(gt_amg, AMGf_set);
     {
-      dPOPTOPiirl_halfmg;
+      dPOPTOPiirl_nomg;
       SETs(boolSV(left > right));
       RETURN;
     }
@@ -3005,7 +3005,7 @@ PP(pp_i_le)
     dVAR; dSP;
     tryAMAGICbin_MG(le_amg, AMGf_set);
     {
-      dPOPTOPiirl_halfmg;
+      dPOPTOPiirl_nomg;
       SETs(boolSV(left <= right));
       RETURN;
     }
@@ -3016,7 +3016,7 @@ PP(pp_i_ge)
     dVAR; dSP;
     tryAMAGICbin_MG(ge_amg, AMGf_set);
     {
-      dPOPTOPiirl_halfmg;
+      dPOPTOPiirl_nomg;
       SETs(boolSV(left >= right));
       RETURN;
     }
@@ -3027,7 +3027,7 @@ PP(pp_i_eq)
     dVAR; dSP;
     tryAMAGICbin_MG(eq_amg, AMGf_set);
     {
-      dPOPTOPiirl_halfmg;
+      dPOPTOPiirl_nomg;
       SETs(boolSV(left == right));
       RETURN;
     }
@@ -3038,7 +3038,7 @@ PP(pp_i_ne)
     dVAR; dSP;
     tryAMAGICbin_MG(ne_amg, AMGf_set);
     {
-      dPOPTOPiirl_halfmg;
+      dPOPTOPiirl_nomg;
       SETs(boolSV(left != right));
       RETURN;
     }
@@ -3049,7 +3049,7 @@ PP(pp_i_ncmp)
     dVAR; dSP; dTARGET;
     tryAMAGICbin_MG(ncmp_amg, 0);
     {
-      dPOPTOPiirl_halfmg;
+      dPOPTOPiirl_nomg;
       I32 value;
 
       if (left > right)

diff --git a/pp.h b/pp.h
index 80ebfe6..7ae6afa 100644 (file)
--- a/pp.h
+++ b/pp.h
@@ -380,12 +380,8 @@ Does not use C<TARG>.  See also C<XPUSHu>, C<mPUSHu> and C<PUSHu>.
 #define dPOPTOPiirl_ul dPOPXiirl_ul(TOP)
 #define dPOPTOPiirl_ul_nomg dPOPXiirl_ul_nomg(TOP)
 #define dPOPTOPiirl_nomg \
-    IV right = SvIV_nomg(TOPs); IV left = (sp--, SvIV_nomg(TOPs))
-#ifdef PERL_CORE
-# define dPOPTOPiirl_halfmg \
     IV left  = SvIV_nomg(TOPm1s); \
     IV right = (sp--, TOPp1s == TOPs ? SvIV(TOPs) : SvIV_nomg(TOPp1s))
-#endif
 
 #define RETPUSHYES     RETURNX(PUSHs(&PL_sv_yes))
 #define RETPUSHNO      RETURNX(PUSHs(&PL_sv_no))

diff --git a/t/lib/warnings/9uninit b/t/lib/warnings/9uninit
index d634846..10f0a7c 100644 (file)
--- a/t/lib/warnings/9uninit
+++ b/t/lib/warnings/9uninit
@@ -560,12 +560,12 @@ Use of uninitialized value $m1 in integer addition (+) at - line 6.
 Use of uninitialized value $g1 in integer addition (+) at - line 6.
 Use of uninitialized value $m1 in integer subtraction (-) at - line 7.
 Use of uninitialized value $g1 in integer subtraction (-) at - line 7.
-Use of uninitialized value $g1 in integer multiplication (*) at - line 8.
 Use of uninitialized value $m1 in integer multiplication (*) at - line 8.
+Use of uninitialized value $g1 in integer multiplication (*) at - line 8.
 Use of uninitialized value $g1 in integer division (/) at - line 9.
 Use of uninitialized value $m2 in integer division (/) at - line 10.
-Use of uninitialized value $g1 in integer modulus (%) at - line 11.
 Use of uninitialized value $m1 in integer modulus (%) at - line 11.
+Use of uninitialized value $g1 in integer modulus (%) at - line 11.
 Use of uninitialized value $m2 in integer modulus (%) at - line 12.
 Use of uninitialized value $m1 in integer lt (<) at - line 13.
 Use of uninitialized value $g1 in integer lt (<) at - line 13.

diff --git a/t/op/tie_fetch_count.t b/t/op/tie_fetch_count.t
index 79c9015..6643941 100644 (file)
--- a/t/op/tie_fetch_count.t
+++ b/t/op/tie_fetch_count.t
@@ -229,10 +229,13 @@ bin_test '.' ,  1, 2, 12;
     local $TODO = $todo ;
     bin_test '==',  1, 2, "";
     bin_test '+' ,  1, 2, 3;
-    bin_int_test '*' ,  2, 3, 6;
+}
+bin_int_test '*' ,  2, 3, 6;
+{
+    local $TODO = $todo ;
     bin_int_test '/' , 10, 2, 5;
-    bin_int_test '%' , 11, 2, 1;
 }
+bin_int_test '%' , 11, 2, 1;
 bin_int_test '+' ,  1, 2, 3;
 bin_int_test '-' , 11, 2, 9;
 bin_int_test '<' ,  1, 2, 1;