[perl #40333] Stop overload::Overloaded from calling ->can

It’s possible, and too easy, for classes to define a can method to
deal with AUTOLOAD, without taking overloading into account.  Since
AUTOLOAD is the main reason for overriding can, and since overloading
does not respect autoloading, can overrides should not be expected to
deal with it.

Since overload.pm already has a mycan function that fits this purpose,
this commit changes Overloaded to use that.

The test includes an example of a class structure that the previous
Overloaded implementation could not handle.

2 files changed, 25 insertions, 2 deletions

diff --git a/lib/overload.pm b/lib/overload.pm
index 4e01e45d09..1f9f461da1 100644
--- a/lib/overload.pm
+++ b/lib/overload.pm
@@ -50,7 +50,7 @@ sub unimport {
 sub Overloaded {
   my $package = shift;
   $package = ref $package if ref $package;
-  $package->can('()');
+  mycan ($package, '()');
 }
 
 sub ov_method {
diff --git a/lib/overload.t b/lib/overload.t
index 5d6e38d382..37c7c0ae77 100644
--- a/lib/overload.t
+++ b/lib/overload.t
@@ -48,7 +48,7 @@ package main;
 
 $| = 1;
 BEGIN { require './test.pl' }
-plan tests => 5037;
+plan tests => 5038;
 
 use Scalar::Util qw(tainted);
 
@@ -2197,4 +2197,27 @@ fresh_perl_is
     ::ok(1, 'no crash when undefining %overload::');
 }
 
+# [perl #40333]
+# overload::Overloaded should not use a ->can designed for autoloading.
+# This example attempts to be as realistic as possible.  The o class has a
+# default singleton object, but can have instances, too.  The proxy class
+# represents proxies for o objects, but class methods delegate to the
+# singleton.
+# overload::Overloaded used to return incorrect results for proxy objects.
+package proxy {
+    sub new { bless [$_[1]], $_[0] }
+    sub AUTOLOAD {
+       our $AUTOLOAD =~ s/.*:://;
+       &_self->$AUTOLOAD;
+    }
+    sub can      { SUPER::can{@_} || &_self->can($_[1]) }
+    sub _self { ref $_[0] ? $_[0][0] : $o::singleton }
+}
+package o     { use overload '""' => sub { 'keck' };
+                sub new { bless[], $_[0] }
+                our $singleton = o->new; }
+ok !overload::Overloaded(new proxy new o),
+ 'overload::Overloaded does not incorrectly return true for proxy classes';
+
+
 # EOF