[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 9858f91..a1bc15b 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 eef6a0b..e676e04 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 8cd4c3f..d42ec36 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 a0e7491..7cbb8fd 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;