| Subject: | [PATCH] Allow overload methods without warning or redelegation |
Perl’s overloading mechanism by design does not respect AUTOLOAD, and so it doesn’t make sense for classes’ ‘can’ methods, when called on overload methods, to return a value other than what UNIVERSAL::can would return. The UNIVERSAL method is always correct in such cases.
It is also very easy for people to write classes that ‘can’ methods that return the wrong thing for overload methods, because they don’t take them into account. (And I don’t think people should have to.)
Hence, it’s not inappropriate for lightweight low-level modules, such as Carp, to call UNIVERSAL::can($o,"((") || UNIVERSAL::can($o,"()") as a quick check to see whether an object has overloading. The problem is that, when the UNIVERSAL::can module is loaded, this can end up being wrong, because module authors who override ‘can’ may not be aware of this issue (and shouldn’t have to).
Please consider the attached patch, which will allow any method name beginning with ‘(’ (all of them overload methods) to pass through to the original UNIVERSAL::can.
In fact, if you apply this, then I can change overload::Overloaded itself to start using UNIVERSAL::can. Currently it uses a slow workaround.
| Subject: | open_XJUGgr30.txt |
diff -Nurp UNIVERSAL-can-1.20140328-iftaaR-orig/MANIFEST UNIVERSAL-can-1.20140328-iftaaR/MANIFEST
--- UNIVERSAL-can-1.20140328-iftaaR-orig/MANIFEST 2014-03-28 16:21:15.000000000 -0700
+++ UNIVERSAL-can-1.20140328-iftaaR/MANIFEST 2018-02-25 11:23:54.000000000 -0800
@@ -17,3 +17,4 @@ t/deep-recursion.t
t/isa-triggering-overload.t
t/lib/Test/SmallWarn.pm
t/object.t
+t/overlord.t
diff -Nurp UNIVERSAL-can-1.20140328-iftaaR-orig/lib/UNIVERSAL/can.pm UNIVERSAL-can-1.20140328-iftaaR/lib/UNIVERSAL/can.pm
--- UNIVERSAL-can-1.20140328-iftaaR-orig/lib/UNIVERSAL/can.pm 2014-03-28 16:21:15.000000000 -0700
+++ UNIVERSAL-can-1.20140328-iftaaR/lib/UNIVERSAL/can.pm 2018-02-25 11:32:05.000000000 -0800
@@ -45,6 +45,9 @@ sub can
if $INC{'UNIVERSAL::isa'};
$caller->isa(blessed $_[0] || $_[0]) } );
+ # allow UNIVERSAL:: for overload methods
+ goto &$orig if $_[1] =~ /^\(/;
+
# call an overridden can() if it exists
my $can = eval { $_[0]->$orig('can') || 0 };
diff -Nurp UNIVERSAL-can-1.20140328-iftaaR-orig/t/overlord.t UNIVERSAL-can-1.20140328-iftaaR/t/overlord.t
--- UNIVERSAL-can-1.20140328-iftaaR-orig/t/overlord.t 1969-12-31 16:00:00.000000000 -0800
+++ UNIVERSAL-can-1.20140328-iftaaR/t/overlord.t 2018-02-25 11:30:48.000000000 -0800
@@ -0,0 +1,35 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+use UNIVERSAL::can;
+
+# 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. The proxy class intentionally does not
+# delegate overloading.
+
+{ package o;
+ use overload '""' => sub { 'keck' };
+ sub new { bless[], $_[0] }
+ our $singleton = o->new;
+}
+{ package proxy;
+ sub new { bless [$_[1]], $_[0] }
+ sub DESTROY{}
+ sub AUTOLOAD {
+ our $AUTOLOAD =~ s/.*:://;
+ &_self->$AUTOLOAD;
+ }
+ sub can { SUPER::can{@_} || &_self->can($_[1]) }
+ sub _self { ref $_[0] ? $_[0][0] : $o::singleton }
+}
+
+my $o = new o;
+my $proxy = new proxy $o;
+ok UNIVERSAL::can($o, '(""'),
+ 'UNIVERSAL::can returning true for overload meth';
+ok !UNIVERSAL::can($proxy, '(""'),
+ 'UNIVERSAL::can bypassing ->can and returning false for overload meth';