[perl #87708] use integer; $tied <=> $tied

This is just part of #87708.

This fixes <=> under ‘use integer’ when the same tied scalar is used
for both operands and returns two different values. Before this com-
mit, get-magic would be called only once and the same value used. In
5.12.x, the operands would be reversed.

diff --git a/pp.c b/pp.c
index 9858f91b4807a120ffd46e27539c1ec5975db754..a1bc15b8d05aa1ced6deeb225dd3273060dfaf35 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -3049,7 +3049,7 @@ PP(pp_i_ncmp)
     dVAR; dSP; dTARGET;
     tryAMAGICbin_MG(ncmp_amg, 0);
     {
-      dPOPTOPiirl_nomg;
+      dPOPTOPiirl_halfmg;
       I32 value;
 
       if (left > right)

diff --git a/pp.h b/pp.h
index eef6a0b806f87aa6ed0b1bce031f9347eb6b2b92..e676e045b59df5983c91e018c1105f524e2c5fa2 100644 (file)
--- a/pp.h
+++ b/pp.h
@@ -380,6 +380,11 @@ Does not use C<TARG>.  See also C<XPUSHu>, C<mPUSHu> and C<PUSHu>.
 #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 8cd4c3f35fd47ec39ff81eb7008bb49001ae8953..d42ec36d357e74cd4f3d1c38b33bdf2fc33b5205 100644 (file)
--- a/t/lib/warnings/9uninit
+++ b/t/lib/warnings/9uninit
@@ -579,8 +579,8 @@ Use of uninitialized value $g1 in integer eq (==) at - line 17.
 Use of uninitialized value $m1 in integer eq (==) at - line 17.
 Use of uninitialized value $g1 in integer ne (!=) at - line 18.
 Use of uninitialized value $m1 in integer ne (!=) at - line 18.
-Use of uninitialized value $g1 in integer comparison (<=>) at - line 19.
 Use of uninitialized value $m1 in integer comparison (<=>) at - line 19.
+Use of uninitialized value $g1 in integer comparison (<=>) at - line 19.
 Use of uninitialized value $m1 in integer negation (-) at - line 20.
 ########
 use warnings 'uninitialized';

diff --git a/t/op/tie_fetch_count.t b/t/op/tie_fetch_count.t
index a0e74913cc8f214111fd431e47861967487f2fb3..7cbb8fd5af03e661b1fb487875ad68f2eee4948c 100644 (file)
--- a/t/op/tie_fetch_count.t
+++ b/t/op/tie_fetch_count.t
@@ -251,8 +251,8 @@ bin_test '.' ,  1, 2, 12;
     bin_int_test '>=',  1, 2, "";
     bin_int_test '==',  1, 2, "";
     bin_int_test '!=',  1, 2, 1;
-    bin_int_test '<=>', 1, 2, -1;
 }
+bin_int_test '<=>', 1, 2, -1;
 tie $var, "main", 1, 4;
 cmp_ok(atan2($var, $var), '<', .3, 'retval of atan2 $var, $var');
 check_count 'atan2',  2;