[perl #113050] Put fallback back under "()"

Unfortunately, there is code all over CPAN that assumes fallback is
stored under the "()" stash entry.  And that code also assumes that
the overloadedness flag (the existence of the CV) is in the same spot.
So much for encapsulation.

This commit changes overloading itself to use a different key, "((",
while having it search for "()" first, and then "((" only if "()" is
not found, to preserve compatibility with encapsulation-breaking code.

So the "((" key will only be used by gv.c if there is no fallback
value specified at all.

diff --git a/gv.c b/gv.c
index 8248bfe..58025b3 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -2260,31 +2260,27 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
     int filled = 0, have_ovl = 0;
     int i, lim = 1;
 
-    /* The first key in PL_AMG_names is the overloadedness indicator, which
-       allows us to skip overloading entries for non-overloaded classes. */
+    /* Work with "fallback" key, which we assume to be first in PL_AMG_names */
 
     /* Try to find via inheritance. */
     GV *gv = gv_fetchmeth_pvn(stash, PL_AMG_names[0], 2, -1, 0);
+    SV * const sv = gv ? GvSV(gv) : NULL;
     CV* cv;
 
     if (!gv)
+    {
+      if (!gv_fetchmeth_pvn(stash, "((", 2, -1, 0))
        lim = DESTROY_amg;              /* Skip overloading entries. */
-
-    else {
-      
-      /* The "fallback" key is special-cased here, being absent from the
-        list in PL_AMG_names. */
-
-      SV *sv;
-      gv = gv_fetchmeth_pvn(stash, "(fallback", 9, -1, 0);
-
-      if (!gv || !(sv = GvSV(gv)))
+    }
+#ifdef PERL_DONT_CREATE_GVSV
+    else if (!sv) {
        NOOP;   /* Equivalent to !SvTRUE and !SvOK  */
-      else if (SvTRUE(sv))
+    }
+#endif
+    else if (SvTRUE(sv))
        amt.fallback=AMGfallYES;
-      else if (SvOK(sv))
+    else if (SvOK(sv))
        amt.fallback=AMGfallNEVER;
-    }
 
     for (i = 1; i < lim; i++)
        amt.table[i] = NULL;

diff --git a/lib/overload.pm b/lib/overload.pm
index ed69440..c1eefc0 100644 (file)
--- a/lib/overload.pm
+++ b/lib/overload.pm
@@ -31,10 +31,10 @@ sub OVERLOAD {
   $package = shift;
   my %arg = @_;
   my ($sub, $fb);
-  *{$package . "::()"} = \&nil; # Make it findable via fetchmethod.
+  *{$package . "::(("} = \&nil; # Make it findable via fetchmethod.
   for (keys %arg) {
     if ($_ eq 'fallback') {
-      for my $sym (*{$package . "::(fallback"}) {
+      for my $sym (*{$package . "::()"}) {
        *$sym = \&nil; # Make it findable via fetchmethod.
        $$sym = $arg{$_};
       }
@@ -62,17 +62,18 @@ sub import {
 sub unimport {
   $package = (caller())[0];
   shift;
+  *{$package . "::(("} = \&nil;
   for (@_) {
       warnings::warnif("overload arg '$_' is invalid")
         unless $ops_seen{$_};
-      delete $ {$package . "::"}{"(" . $_};
+      delete $ {$package . "::"}{$_ eq 'fallback' ? '()' : "(" .$_};
   }
 }
 
 sub Overloaded {
   my $package = shift;
   $package = ref $package if ref $package;
-  mycan ($package, '()');
+  mycan ($package, '()') || mycan ($package, '((');
 }
 
 sub ov_method {

diff --git a/lib/overload.t b/lib/overload.t
index df3a9b8..72e3b6e 100644 (file)
--- a/lib/overload.t
+++ b/lib/overload.t
@@ -48,7 +48,7 @@ package main;
 
 $| = 1;
 BEGIN { require './test.pl' }
-plan tests => 5081;
+plan tests => 5082;
 
 use Scalar::Util qw(tainted);
 
@@ -2313,6 +2313,17 @@ $a = bless[], mane::;
 is eval { "$a" }, 'twine', ':: in method name' or diag $@;
 is eval { !$a  },   1,      "' in method name" or diag $@;
 
+# [perl #113050] Half of CPAN assumes fallback is under "()"
+{
+  package dodo;
+  use overload '+' => sub {};
+  no strict;
+  *{"dodo::()"} = sub{};
+  ${"dodo::()"} = 1;
+}
+$a = bless [],'dodo';
+is eval {"$a"}, overload::StrVal($a), 'fallback is stored under "()"';
+
 
 { # undefining the overload stash -- KEEP THIS TEST LAST
     package ant;