overload (2 bugs): fallback/nomethod failures with heterogeneous operands

[p5pRT]

Migrated from rt.perl.org#71286 (status was 'resolved')

Searchable as RT71286$

[p5pRT]

From perl@mbreen.com

blead 5.11.2 / all versions

These two bugs are distinct but related​: the second one was exposed by some of the test code added for the first.
The patch (to follow) therefore fixes both.

Note​: The documentation for overload is ambiguous on the correct mechanics and precedence of fallback and nomethod where there are two overloaded operands.
This is not the only problem with the documentation that I've found, and it is probably best fixed as part of a more general reorganization (as the man page itself says, "This document is confusing... It would seem a total rewrite is needed.").
Therefore I propose to write a separate bug report for the documentation, once this fix is accepted.

Bug 1

If two operands are overloaded and the first has fallback>0 then the second operand's nomethod is never called - even if it is the only implementation.
This is obviously wrong​:
(1) it implies an asymmetry between the operands (other than precedence) in the rules for finding an operator implementation;
(2) it also means that a *higher* value for fallback sometimes makes it *less* likely that an operation will succeed.

package NuMB;
use overload '0+' => sub { ${$_[0]}; };
sub new {
  my $n = $_[1] || 0;
  bless \$n, ref $_[0] || $_[0];
}

package NuMBnomethod;
use base qw/NuMB/;
use overload nomethod =>
  sub { "(${$_[0]}).nomethod"; };

package NuMBfall1;
use base qw/NuMB/;
use overload fallback => 1;

package main;

# BUG 1
my $f = NuMB->new(2);
my $g = NuMBnomethod->new(3);
print $g * $f, "\n";
# -> (3).nomethod
#print $f * $g, "\n";
# -> Operation "*"​: no method found

# BUG 2
my $p = NuMBfall1->new(2);
my $q = NuMB->new(3);
#print $p * $q, "\n";
# -> Operation "*"​: no method found
print $q * $p, "\n";
# -> 6

Bug 2

With two overloaded operands of different types, neither of which defines a 'nomethod' method, the decision on whether to fall back to the default implemention of the operator is determined solely by the second operand.

While this is even more obviously wrong than the first bug, the correct behaviour may be less clear​:
should the fallback occur if either operand has fallback=1?
No​: any other value for fallback is a statement that a numified or stringified version of that operand does not produce sensible results with the standard operators.
Logically, neither operand can blindly overrule the other in this respect (except by providing a 'nomethod' - but in that case the nomethod can check the type of the other operand before deciding what to do).
Therefore the fix must be to make fallback to the default operators dependent on both operands having fallback=1.

---

---

Flags​:
  category=core
  severity=medium

---

This is perl 5, version 11, subversion 2 (v5.11.2-157-g0f907b9*) built for i686-linux

[p5pRT]

From perl@mbreen.com

Just to be clear about the sample code, for Bug 1 the correct output
for both * ops is "(3).nomethod"; for Bug 2 the correct output for both
cases is (as explained above) "no method found".

[p5pRT]

From perl@mbreen.com

71286-overload-2-bugs-fallback-nomethod.patch

From 3d5f8a7648213e35f3a3074f22a25441518bb19e Mon Sep 17 00:00:00 2001
From: Michael Breen <perl@mbreen.com>
Date: Tue, 15 Dec 2009 08:24:54 +0000
Subject: [PATCH] [perl #71286] overload (2 bugs): fallback/nomethod failures with heterogeneous operands

---
 gv.c           |   25 +++++++--
 lib/overload.t |  146 +++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 164 insertions(+), 7 deletions(-)

diff --git a/gv.c b/gv.c
index 9743354..c6ceddd 100644
--- a/gv.c
+++ b/gv.c
@@ -1825,6 +1825,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
   int postpr = 0, force_cpy = 0;
   int assign = AMGf_assign & flags;
   const int assignshift = assign ? 1 : 0;
+  int use_default_op = 0;
 #ifdef DEBUGGING
   int fl=0;
 #endif
@@ -1989,9 +1990,8 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
 	       && (cv = cvp[off=method])) { /* Method for right
 					     * argument found */
       lr=1;
-    } else if (((ocvp && oamtp->fallback > AMGfallNEVER
-		 && (cvp=ocvp) && (lr = -1))
-		|| (cvp && amtp->fallback > AMGfallNEVER && (lr=1)))
+    } else if (((cvp && amtp->fallback > AMGfallNEVER)
+                || (ocvp && oamtp->fallback > AMGfallNEVER))
 	       && !(flags & AMGf_unary)) {
 				/* We look for substitution for
 				 * comparison operations and
@@ -2019,7 +2019,17 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
              off = scmp_amg;
              break;
 	 }
-      if ((off != -1) && (cv = cvp[off]))
+      if (off != -1) {
+          if (ocvp && (oamtp->fallback > AMGfallNEVER)) {
+              cv = ocvp[off];
+              lr = -1;
+          }
+          if (!cv && (cvp && amtp->fallback > AMGfallNEVER)) {
+              cv = cvp[off];
+              lr = 1;
+          }
+      }
+      if (cv)
           postpr = 1;
       else
           goto not_found;
@@ -2039,7 +2049,10 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
 	notfound = 1; lr = -1;
       } else if (cvp && (cv=cvp[nomethod_amg])) {
 	notfound = 1; lr = 1;
-      } else if ((amtp && amtp->fallback >= AMGfallYES) && !DEBUG_o_TEST) {
+      } else if ((use_default_op = 
+                  (!ocvp || oamtp->fallback >= AMGfallYES)
+                  && (!cvp || amtp->fallback >= AMGfallYES))
+                 && !DEBUG_o_TEST) {
 	/* Skip generating the "no method found" message.  */
 	return NULL;
       } else {
@@ -2063,7 +2076,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
 		      SvAMAGIC(right)?
 		        HvNAME_get(SvSTASH(SvRV(right))):
 		        ""));
-	if (amtp && amtp->fallback >= AMGfallYES) {
+        if (use_default_op) {
 	  DEBUG_o( Perl_deb(aTHX_ "%s", SvPVX_const(msg)) );
 	} else {
 	  Perl_croak(aTHX_ "%"SVf, SVfARG(msg));
diff --git a/lib/overload.t b/lib/overload.t
index 39333cf..5eee6b1 100644
--- a/lib/overload.t
+++ b/lib/overload.t
@@ -47,7 +47,7 @@ sub numify { 0 + "${$_[0]}" }	# Not needed, additional overhead
 package main;
 
 $| = 1;
-use Test::More tests => 607;
+use Test::More tests => 661;
 
 
 $a = new Oscalar "087";
@@ -1590,4 +1590,148 @@ foreach my $op (qw(<=> == != < <= > >=)) {
     is($y, $o, "copy constructor falls back to assignment (preinc)");
 }
 
+{
+    # fallback to 'cmp' and '<=>' with heterogeneous operands
+    # [perl #71286]
+    my $not_found = 'no method found';
+    my $used = 0;
+    package CmpBase;
+    sub new {
+        my $n = $_[1] || 0;
+        bless \$n, ref $_[0] || $_[0];
+    }
+    sub cmp {
+        $used = \$_[0];
+        (${$_[0]} <=> ${$_[1]}) * ($_[2] ? -1 : 1);
+    }
+
+    package NCmp;
+    use base 'CmpBase';
+    use overload '<=>' => 'cmp';
+
+    package SCmp;
+    use base 'CmpBase';
+    use overload 'cmp' => 'cmp';
+
+    package main;
+    my $n = NCmp->new(5);
+    my $s = SCmp->new(3);
+    my $res;
+
+    eval { $res = $n > $s; };
+    $res = $not_found if $@ =~ /$not_found/;
+    is($res, 1, 'A>B using A<=> when B overloaded, no B<=>');
+
+    eval { $res = $s < $n; };
+    $res = $not_found if $@ =~ /$not_found/;
+    is($res, 1, 'A<B using B<=> when A overloaded, no A<=>');
+
+    eval { $res = $s lt $n; };
+    $res = $not_found if $@ =~ /$not_found/;
+    is($res, 1, 'A lt B using A:cmp when B overloaded, no B:cmp');
+
+    eval { $res = $n gt $s; };
+    $res = $not_found if $@ =~ /$not_found/;
+    is($res, 1, 'A gt B using B:cmp when A overloaded, no A:cmp');
+
+    my $o = NCmp->new(9);
+    $res = $n < $o;
+    is($used, \$n, 'A < B uses <=> from A in preference to B');
+
+    my $t = SCmp->new(7);
+    $res = $s lt $t;
+    is($used, \$s, 'A lt B uses cmp from A in preference to B');
+}
+
+{
+    # Combinatorial testing of 'fallback' and 'nomethod'
+    # [perl #71286]
+    package NuMB;
+    use overload '0+' => sub { ${$_[0]}; },
+        '""' => 'str';
+    sub new {
+        my $self = shift;
+        my $n = @_ ? shift : 0;
+        bless my $obj = \$n, ref $self || $self;
+    }
+    sub str {
+        no strict qw/refs/;
+        my $s = "(${$_[0]} ";
+        $s .= "nomethod, " if defined ${ref($_[0]).'::(nomethod'};
+        my $fb = ${ref($_[0]).'::()'};
+        $s .= "fb=" . (defined $fb ? 0 + $fb : 'undef') . ")";
+    }
+    sub nomethod { "${$_[0]}.nomethod"; }
+
+    # create classes for tests
+    package main;
+    my @falls = (0, 'undef', 1);
+    my @nomethods = ('', 'nomethod');
+    my $not_found = 'no method found';
+    for my $fall (@falls) {
+        for my $nomethod (@nomethods) {
+            my $nomethod_decl = $nomethod
+                ? $nomethod . "=>'nomethod'," : '';
+            eval qq{
+                    package NuMB$fall$nomethod;
+                    use base qw/NuMB/;
+                    use overload $nomethod_decl
+                    fallback => $fall;
+                };
+        }
+    }
+
+    # operation and precedence of 'fallback' and 'nomethod'
+    # for all combinations with 2 overloaded operands
+    for my $nomethod2 (@nomethods) {
+        for my $nomethod1 (@nomethods) {
+            for my $fall2 (@falls) {
+                my $pack2 = "NuMB$fall2$nomethod2";
+                for my $fall1 (@falls) {
+                    my $pack1 = "NuMB$fall1$nomethod1";
+                    my ($test, $out, $exp);
+                    eval qq{
+                            my \$x = $pack1->new(2);
+                            my \$y = $pack2->new(3);
+                            \$test = "\$x" . ' * ' . "\$y";
+                            \$out = \$x * \$y;
+                        };
+                    $out = $not_found if $@ =~ /$not_found/;
+                    $exp = $nomethod1 ? '2.nomethod' :
+                         $nomethod2 ? '3.nomethod' :
+                         $fall1 eq '1' && $fall2 eq '1' ? 6
+                         : $not_found;
+                    is($out, $exp, "$test --> $exp");
+                }
+            }
+        }
+    }
+
+    # operation of 'fallback' and 'nomethod'
+    # where the other operand is not overloaded
+    for my $nomethod (@nomethods) {
+        for my $fall (@falls) {
+            my ($test, $out, $exp);
+            eval qq{
+                    my \$x = NuMB$fall$nomethod->new(2);
+                    \$test = "\$x" . ' * 3';
+                    \$out = \$x * 3;
+                };
+            $out = $not_found if $@ =~ /$not_found/;
+            $exp = $nomethod ? '2.nomethod' :
+                $fall eq '1' ? 6
+                : $not_found;
+            is($out, $exp, "$test --> $exp");
+
+            eval qq{
+                    my \$x = NuMB$fall$nomethod->new(2);
+                    \$test = '3 * ' . "\$x";
+                    \$out = 3 * \$x;
+                };
+            $out = $not_found if $@ =~ /$not_found/;
+            is($out, $exp, "$test --> $exp");
+        }
+    }
+}
+
 # EOF
-- 
1.5.6.5

[p5pRT]

From [Unknown Contact. See original ticket]

Just to be clear about the sample code, for Bug 1 the correct output
for both * ops is "(3).nomethod"; for Bug 2 the correct output for both
cases is (as explained above) "no method found".

[p5pRT]

perl@mbreen.com - Status changed from 'new' to 'open'

[p5pRT]

From @obra

On Tue Dec 15 00​:37​:59 2009, breen wrote​:

Just to be clear about the sample code, for Bug 1 the correct output
for both * ops is "(3).nomethod"; for Bug 2 the correct output for both
cases is (as explained above) "no method found".

This doesn't appear to be a regression (tested against 5.10 and 5.8.). As
such, I'd like to hold off on application until 5.13.

Thanks for the patch,
Jesse

[p5pRT]

From perl@mbreen.com

This doesn't appear to be a regression (tested against 5.10 and 5.8.)
. As
such, I'd like to hold off on application until 5.13.

You're correct​: it's not a regression. And I can understand
the reasons for a cautious, conservative approach.
On the other hand​:
- Shouldn't the operative criterion be not whether a patch
  fixes a regression but whether it fixes a bug of any kind
  (in this case 2 bugs), as distinct from adding a feature?
- especially given that it would not have been a last-minute
  change​: 5.12 was still months off when this was submitted
- the fix broke no regression tests, and it seems unlikely
  that anyone could be depending on the erroneous behaviour
  (partly because it's relatively obscure, partly because
  it's obviously anomalous)
- it's been claimed that submitting a patch with a bug is a
  good way to get it fixed quickly. I would now treat that
  claim very sceptically (when will 5.14 be out? :-)
Looking back at the work I did around the time I started
investigating the problems with overload last year, it
looks like it could take me a while to get back into it.
I don't think I'll be updating the documentation or doing
other patches.

[p5pRT]

From perl@mbreen.com

This ticket does not appear to have progressed since last year. And it's
a double bugfix. Should it have been disguised it as a new feature? :-)

I'm not even using Perl at the moment so I'm almost past caring. Still,
it seems like a waste of work that's already been done - not to mention
the other overload-related problem tickets I was prepared to raise and
write patches for at the time, of which the documentation had been next.

[p5pRT]

From [Unknown Contact. See original ticket]

This ticket does not appear to have progressed since last year. And it's
a double bugfix. Should it have been disguised it as a new feature? :-)

I'm not even using Perl at the moment so I'm almost past caring. Still,
it seems like a waste of work that's already been done - not to mention
the other overload-related problem tickets I was prepared to raise and
write patches for at the time, of which the documentation had been next.

[p5pRT]

From @cpansprout

On Tue Oct 19 22​:30​:04 2010, breen wrote​:

This ticket does not appear to have progressed since last year. And it's
a double bugfix. Should it have been disguised it as a new feature? :-)

I'm not even using Perl at the moment so I'm almost past caring. Still,
it seems like a waste of work that's already been done - not to mention
the other overload-related problem tickets I was prepared to raise and
write patches for at the time, of which the documentation had been next.

I understand how you feel. It was the same way with my patches. (But I
kept sending them until someone was crazy enough to give me a commit
bit.) There is simply more than enough work to fill everyone’s spare
time (1500 open bugs).

I have your patch on my list. I have not got to it yet, for three
reasons​: I don’t understand it yet; it no longer applies; I’ve been
concentrating more on fixing regressions. I will add it to the list of
5.14.0 blockers so it is not forgotten.

[p5pRT]

From perl@mbreen.com

FCVR>time (1500 open bugs).

That's a sobering number. Thank you for your reply, FC.

[p5pRT]

From @iabyn

On Mon, Dec 14, 2009 at 10​:54​:25PM -0800, Michael Breen wrote​:

These two bugs are distinct but related​: the second one was exposed by some of the test code added for the first.
The patch (to follow) therefore fixes both.

Sorry that we've collectively failed to do anything with your patch for
nearly a year. I've finally had a chance to look at it, and have now
applied it with the commit shown below.

Note​: The documentation for overload is ambiguous on the correct
mechanics and precedence of fallback and nomethod where there are two
overloaded operands.
This is not the only problem with the documentation that I've found, and
it is probably best fixed as part of a more general reorganization (as
the man page itself says, "This document is confusing... It would seem
a total rewrite is needed.").
Therefore I propose to write a separate bug report for the
documentation, once this fix is accepted.

Have we put you off completely, or are you still willing to do this?
Having spent a few hours getting my head round this patch and trying to
understand the issue, I agree that the docs are as clear as mud on
fallback and nomethod. I think what would be particularly helpful would be
two tables, one for unary and one for binary ops, showing the order of
tests that select which method resolution.

Bug 2

With two overloaded operands of different types, neither of which
defines a 'nomethod' method, the decision on whether to fall back to the
default implemention of the operator is determined solely by the second
operand.

While this is even more obviously wrong than the first bug, the correct
behaviour may be less clear​:
should the fallback occur if either operand has fallback=1?
No​: any other value for fallback is a statement that a numified or
stringified version of that operand does not produce sensible results
with the standard operators.
Logically, neither operand can blindly overrule the other in this
respect (except by providing a 'nomethod' - but in that case the
nomethod can check the type of the other operand before deciding what to
do).
Therefore the fix must be to make fallback to the default operators
dependent on both operands having fallback=1.

I had to think for a while to decide whether this should fallback with
*either* of *both* operands having fallback=1, and eventually decided I
agreed with you.

Here's the commit message - let me know if its not an accurate summary of
the issue!

commit bf5522a
Author​: Michael Breen <perl@​mbreen.com>
AuthorDate​: Tue Nov 30 17​:48​:50 2010 +0000
Commit​: David Mitchell <davem@​iabyn.com>
CommitDate​: Fri Dec 3 12​:16​:06 2010 +0000

  [perl #71286] fallback/nomethod failures
 
  This fixes two bugs related to overload and fallback on binary ops.
 
  First, if *either* of the args has a 'nomethod', this will now be used;
  previously the RH nomethod was ignored if the LH arg had fallback value
  of undef or 1.
 
  Second, if neither arg has a 'nomethod', then the fallback to the built-in
  op will now only occur if *both* args have fallback => 1; previously it
  would do so if the *RHS* had fallback => 1. Clearly the old behaviour was
  wrong, but there were two ways to fix this​: (a) *both* args have fallback
  => 1; (b) *either* arg has fallback=> 1. It could be argued either way,
  but the the choice of 'both' was that classes that hadn't set 'fallback =>
  1' were implicitly implying that their objects aren't suitable for
  fallback, regardless of the presence of conversion methods.

M gv.c
M lib/overload.t

--
Thank God I'm an atheist.....

[p5pRT]

From perl@mbreen.com

On Fri Dec 03 04​:42​:52 2010, davem wrote​:

I've finally had a chance to look at it, and have now
applied it with the commit shown below.

Thank you, Dave. Your commit message looks fine to me.

Therefore I propose to write a separate bug report for the
documentation, once this fix is accepted.

Have we put you off completely, or are you still willing to do this?

I had ideas and had planned a full rewrite to fix this and other
issues, but I expected to be doing it when everything was still
fresh in my mind, which it no longer is.
In principle, I'm still willing to do it but I can't say for sure
whether and I don't know when - perhaps if I use perl for a small
project I've been thinking about for months but haven't found time
for yet.
Which means that if you (or anyone else) is keen to improve it
and to be sure it's done in time for the next release then feel
free to go ahead. Just maybe leave a note or link here in 764164
in case two of us decide to start work on it around the same time.

Thanks again.

[p5pRT]

From perl@mbreen.com

free to go ahead. Just maybe leave a note or link here in 764164

Copy / paste error. Should be​: here in #71286

[p5pRT]

From perl@mbreen.com

[perl #82278] raised for the related shortcomings in the documentation