don't upgrade overload IV return values to NV

(if we can avoid it).

Fix for RT #77456. Basically it extends the usage of the AMGf_numeric flag
to the remaining overloadable numeric ops that behave differently with IV
and NV.

diff --git a/lib/overload64.t b/lib/overload64.t
index f4b0cb0..f11f859 100644 (file)
--- a/lib/overload64.t
+++ b/lib/overload64.t
@@ -11,7 +11,7 @@ BEGIN {
 }
 
 $| = 1;
-use Test::More 'tests' => 100;
+use Test::More 'tests' => 140;
 
 
 my $ii = 36028797018963971;  # 2^55 + 3
@@ -213,4 +213,64 @@ is($$oo, $cnt++, 'overload called once');
 is($oo**1, $ii, '** overload');
 is($$oo, $cnt++, 'overload called once');
 
+# RT #77456: when conversion method returns an IV/UV,
+# avoid IV -> NV upgrade if possible .
+
+{
+    package P77456;
+    use overload '0+' => sub  { $_[0][0] }, fallback => 1;
+
+    package main;
+
+    for my $expr (
+       '(%531 + 1) - $a531  == 1',                     # pp_add
+       '$a531 - (%531 - 1) == 1',                      # pp_subtract
+       '(%531 * 2  + 1) - (%531 * 2)  == 1',           # pp_multiply
+       '(%54  / 2  + 1) - (%54 / 2)   == 1',           # pp_divide
+       '(%271 ** 2 + 1) - (%271 ** 2) == 1',           # pp_pow
+       '(%541 % 2) == 1',                              # pp_modulo
+       '$a54  + (-%531)*2  == -2',                     # pp_negate
+       '(abs(%53m)+1) - $a53 == 1',                    # pp_abs
+       '(%531 << 1) - 2  == $a54',                     # pp_left_shift
+       '(%541 >> 1) + 1  == $a531',                    # pp_right_shift
+       '!(%53 == %531)',                               # pp_eq
+       '(%53 != %531)',                                # pp_ne
+       '(%53 < %531)',                                 # pp_lt
+       '!(%531 <= %53)',                               # pp_le
+       '(%531 > %53)',                                 # pp_gt
+       '!(%53 >= %531)',                               # pp_ge
+       '(%53 <=> %531) == -1',                         # pp_ncmp
+       '(%531 & %53) == $a53',                         # pp_bit_and
+       '(%531 | %53) == $a531',                        # pp_bit_or
+       '~(~ %531 + $a531) == 0',                       # pp_complement
+    ) {
+       for my $int ('', 'use integer; ') {
+           (my $aexpr = "$int$expr") =~ s/\%(\d+m?)/\$a$1/g;
+           (my $bexpr = "$int$expr") =~ s/\%(\d+m?)/\$b$1/g;
+
+           my $a27   = 1 << 27;
+           my $a271  = $a27 + 1;
+           my $a53   = 1 << 53;
+           my $a53m  = -$a53;
+           my $a531  = $a53 + 1;
+           my $a54   = 1 << 54;
+           my $a541  = $a54 + 1;
+
+           my $b27   = bless [ $a27   ], 'P77456';
+           my $b271  = bless [ $a271  ], 'P77456';
+           my $b53   = bless [ $a53   ], 'P77456';
+           my $b53m  = bless [ $a53m  ], 'P77456';
+           my $b531  = bless [ $a531  ], 'P77456';
+           my $b54   = bless [ $a54   ], 'P77456';
+           my $b541  = bless [ $a541  ], 'P77456';
+
+           SKIP: {
+               skip("IV/NV not suitable on this platform: $aexpr", 1)
+                   unless eval $aexpr;
+               ok(eval $bexpr, "IV: $bexpr");
+           }
+       }
+    }
+}
+
 # EOF

diff --git a/pp.c b/pp.c
index 47cf756..b5e93a2 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -1795,7 +1795,7 @@ PP(pp_subtract)
 PP(pp_left_shift)
 {
     dVAR; dSP; dATARGET; SV *svl, *svr;
-    tryAMAGICbin_MG(lshift_amg, AMGf_assign);
+    tryAMAGICbin_MG(lshift_amg, AMGf_assign|AMGf_numeric);
     svr = POPs;
     svl = TOPs;
     {
@@ -1815,7 +1815,7 @@ PP(pp_left_shift)
 PP(pp_right_shift)
 {
     dVAR; dSP; dATARGET; SV *svl, *svr;
-    tryAMAGICbin_MG(rshift_amg, AMGf_assign);
+    tryAMAGICbin_MG(rshift_amg, AMGf_assign|AMGf_numeric);
     svr = POPs;
     svl = TOPs;
     {
@@ -1835,7 +1835,7 @@ PP(pp_right_shift)
 PP(pp_lt)
 {
     dVAR; dSP;
-    tryAMAGICbin_MG(lt_amg, AMGf_set);
+    tryAMAGICbin_MG(lt_amg, AMGf_set|AMGf_numeric);
 #ifdef PERL_PRESERVE_IVUV
     SvIV_please_nomg(TOPs);
     if (SvIOK(TOPs)) {
@@ -1918,7 +1918,7 @@ PP(pp_lt)
 PP(pp_gt)
 {
     dVAR; dSP;
-    tryAMAGICbin_MG(gt_amg, AMGf_set);
+    tryAMAGICbin_MG(gt_amg, AMGf_set|AMGf_numeric);
 #ifdef PERL_PRESERVE_IVUV
     SvIV_please_nomg(TOPs);
     if (SvIOK(TOPs)) {
@@ -2002,7 +2002,7 @@ PP(pp_gt)
 PP(pp_le)
 {
     dVAR; dSP;
-    tryAMAGICbin_MG(le_amg, AMGf_set);
+    tryAMAGICbin_MG(le_amg, AMGf_set|AMGf_numeric);
 #ifdef PERL_PRESERVE_IVUV
     SvIV_please_nomg(TOPs);
     if (SvIOK(TOPs)) {
@@ -2086,7 +2086,7 @@ PP(pp_le)
 PP(pp_ge)
 {
     dVAR; dSP;
-    tryAMAGICbin_MG(ge_amg,AMGf_set);
+    tryAMAGICbin_MG(ge_amg,AMGf_set|AMGf_numeric);
 #ifdef PERL_PRESERVE_IVUV
     SvIV_please_nomg(TOPs);
     if (SvIOK(TOPs)) {
@@ -2170,7 +2170,7 @@ PP(pp_ge)
 PP(pp_ne)
 {
     dVAR; dSP;
-    tryAMAGICbin_MG(ne_amg,AMGf_set);
+    tryAMAGICbin_MG(ne_amg,AMGf_set|AMGf_numeric);
 #ifndef NV_PRESERVES_UV
     if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) {
         SP--;
@@ -2247,7 +2247,7 @@ PP(pp_ne)
 PP(pp_ncmp)
 {
     dVAR; dSP; dTARGET;
-    tryAMAGICbin_MG(ncmp_amg, 0);
+    tryAMAGICbin_MG(ncmp_amg, AMGf_numeric);
 #ifndef NV_PRESERVES_UV
     if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) {
        const UV right = PTR2UV(SvRV(POPs));
@@ -2571,7 +2571,7 @@ PP(pp_not)
 PP(pp_complement)
 {
     dVAR; dSP; dTARGET;
-    tryAMAGICun_MG(compl_amg, 0);
+    tryAMAGICun_MG(compl_amg, AMGf_numeric);
     {
       dTOPss;
       if (SvNIOKp(sv)) {

diff --git a/pp_hot.c b/pp_hot.c
index 9c5f325..c1d0103 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -334,7 +334,7 @@ PP(pp_readline)
 PP(pp_eq)
 {
     dVAR; dSP;
-    tryAMAGICbin_MG(eq_amg, AMGf_set);
+    tryAMAGICbin_MG(eq_amg, AMGf_set|AMGf_numeric);
 #ifndef NV_PRESERVES_UV
     if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) {
         SP--;