cosmetic change to overloading

Message-ID: <20001214220243.A18437@monk.mps.ohio-state.edu>

p4raw-id: //depot/perl@8130

diff --git a/gv.c b/gv.c
index dba3444..8f9395f 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1152,10 +1152,6 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
   AMT *amtp = (mg) ? (AMT*)mg->mg_ptr: (AMT *) NULL;
   AMT amt;
   STRLEN n_a;
-#ifdef OVERLOAD_VIA_HASH
-  GV** gvp;
-  HV* hv;
-#endif
 
   if (mg && amtp->was_ok_am == PL_amagic_generation
       && amtp->was_ok_sub == PL_sub_generation)
@@ -1177,60 +1173,6 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
   amt.fallback = AMGfallNO;
   amt.flags = 0;
 
-#ifdef OVERLOAD_VIA_HASH
-  gvp=(GV**)hv_fetch(stash,"OVERLOAD",8,FALSE);        /* A shortcut */
-  if (gvp && ((gv = *gvp) != (GV*)&PL_sv_undef && (hv = GvHV(gv)))) {
-    int filled=0;
-    int i;
-    char *cp;
-    SV* sv;
-    SV** svp;
-
-    /* Work with "fallback" key, which we assume to be first in PL_AMG_names */
-
-    if (( cp = (char *)PL_AMG_names[0] ) &&
-       (svp = (SV**)hv_fetch(hv,cp,strlen(cp),FALSE)) && (sv = *svp)) {
-      if (SvTRUE(sv)) amt.fallback=AMGfallYES;
-      else if (SvOK(sv)) amt.fallback=AMGfallNEVER;
-    }
-    for (i = 1; i < NofAMmeth; i++) {
-      cv = 0;
-      cp = (char *)PL_AMG_names[i];
-
-        svp = (SV**)hv_fetch(hv, cp, strlen(cp), FALSE);
-        if (svp && ((sv = *svp) != &PL_sv_undef)) {
-          switch (SvTYPE(sv)) {
-            default:
-              if (!SvROK(sv)) {
-                if (!SvOK(sv)) break;
-               gv = gv_fetchmethod(stash, SvPV(sv, n_a));
-                if (gv) cv = GvCV(gv);
-                break;
-              }
-              cv = (CV*)SvRV(sv);
-              if (SvTYPE(cv) == SVt_PVCV)
-                  break;
-                /* FALL THROUGH */
-            case SVt_PVHV:
-            case SVt_PVAV:
-             Perl_croak(aTHX_ "Not a subroutine reference in overload table");
-             return FALSE;
-            case SVt_PVCV:
-              cv = (CV*)sv;
-              break;
-            case SVt_PVGV:
-              if (!(cv = GvCVu((GV*)sv)))
-                cv = sv_2cv(sv, &stash, &gv, FALSE);
-              break;
-          }
-          if (cv) filled=1;
-         else {
-           Perl_croak(aTHX_ "Method for operation %s not found in package %.256s during blessing\n",
-               cp,HvNAME(stash));
-           return FALSE;
-         }
-        }
-#else
   {
     int filled = 0;
     int i;
@@ -1239,28 +1181,29 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
 
     /* Work with "fallback" key, which we assume to be first in PL_AMG_names */
 
-    if ((cp = PL_AMG_names[0])) {
-       /* Try to find via inheritance. */
-       gv = gv_fetchmeth(stash, "()", 2, -1); /* A cookie: "()". */
-       if (gv)
-           sv = GvSV(gv);
-
-       if (!gv)
-           goto no_table;
-       else if (SvTRUE(sv))
-           amt.fallback=AMGfallYES;
-       else if (SvOK(sv))
-           amt.fallback=AMGfallNEVER;
-    }
+    /* Try to find via inheritance. */
+    gv = gv_fetchmeth(stash, PL_AMG_names[0], 2, -1);
+    if (gv)
+       sv = GvSV(gv);
+
+    if (!gv)
+       goto no_table;
+    else if (SvTRUE(sv))
+       amt.fallback=AMGfallYES;
+    else if (SvOK(sv))
+       amt.fallback=AMGfallNEVER;
 
     for (i = 1; i < NofAMmeth; i++) {
-       SV *cookie = sv_2mortal(Perl_newSVpvf(aTHX_ "(%s", cp = PL_AMG_names[i]));
+       char *cooky = PL_AMG_names[i];
+       char *cp = AMG_id2name(i); /* Human-readable form, for debugging */
+       STRLEN l = strlen(cooky);
+
        DEBUG_o( Perl_deb(aTHX_ "Checking overloading of `%s' in package `%.256s'\n",
                     cp, HvNAME(stash)) );
        /* don't fill the cache while looking up! */
-       gv = gv_fetchmeth(stash, SvPVX(cookie), SvCUR(cookie), -1);
+       gv = gv_fetchmeth(stash, cooky, l, -1);
         cv = 0;
-        if(gv && (cv = GvCV(gv))) {
+        if (gv && (cv = GvCV(gv))) {
            if (GvNAMELEN(CvGV(cv)) == 3 && strEQ(GvNAME(CvGV(cv)), "nil")
                && strEQ(HvNAME(GvSTASH(CvGV(cv))), "overload")) {
                /* GvSV contains the name of the method. */
@@ -1289,7 +1232,6 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
                         GvNAME(CvGV(cv))) );
            filled = 1;
        }
-#endif
        amt.table[i]=(CV*)SvREFCNT_inc(cv);
     }
     if (filled) {
@@ -1488,7 +1430,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
        if (off==-1) off=method;
        msg = sv_2mortal(Perl_newSVpvf(aTHX_
                      "Operation `%s': no method found,%sargument %s%s%s%s",
-                     PL_AMG_names[method + assignshift],
+                     AMG_id2name(method + assignshift),
                      (flags & AMGf_unary ? " " : "\n\tleft "),
                      SvAMAGIC(left)?
                        "in overloaded package ":
@@ -1517,11 +1459,11 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
   if (!notfound) {
     DEBUG_o( Perl_deb(aTHX_
   "Overloaded operator `%s'%s%s%s:\n\tmethod%s found%s in package %s%s\n",
-                PL_AMG_names[off],
+                AMG_id2name(off),
                 method+assignshift==off? "" :
                             " (initially `",
                 method+assignshift==off? "" :
-                            PL_AMG_names[method+assignshift],
+                            AMG_id2name(method+assignshift),
                 method+assignshift==off? "" : "')",
                 flags & AMGf_unary? "" :
                   lr==1 ? " for right argument": " for left argument",
@@ -1581,7 +1523,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
     PUSHs(lr>0? left: right);
     PUSHs( lr > 0 ? &PL_sv_yes : ( assign ? &PL_sv_undef : &PL_sv_no ));
     if (notfound) {
-      PUSHs( sv_2mortal(newSVpv((char *)PL_AMG_names[method + assignshift],0)));
+      PUSHs( sv_2mortal(newSVpv(AMG_id2name(method + assignshift),0)));
     }
     PUSHs((SV*)cv);
     PUTBACK;

diff --git a/perl.h b/perl.h
index a55ebef..e1c9438 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -3060,41 +3060,47 @@ enum {
 };
 
 #define NofAMmeth max_amg_code
+#define AMG_id2name(id) ((char*)PL_AMG_names[id]+1)
 
 #ifdef DOINIT
 EXTCONST char * PL_AMG_names[NofAMmeth] = {
-  "fallback",  "abs",                  /* "fallback" should be the first. */
-  "bool",      "nomethod",
-  "\"\"",      "0+",
-  "+",         "+=",
-  "-",         "-=",
-  "*",         "*=",
-  "/",         "/=",
-  "%",         "%=",
-  "**",                "**=",
-  "<<",                "<<=",
-  ">>",                ">>=",
-  "&",         "&=",
-  "|",         "|=",
-  "^",         "^=",
-  "<",         "<=",
-  ">",         ">=",
-  "==",                "!=",
-  "<=>",       "cmp",
-  "lt",                "le",
-  "gt",                "ge",
-  "eq",                "ne",
-  "!",         "~",
-  "++",                "--",
-  "atan2",     "cos",
-  "sin",       "exp",
-  "log",       "sqrt",
-  "x",         "x=",
-  ".",         ".=",
-  "=",         "neg",
-  "${}",       "@{}",
-  "%{}",       "*{}",
-  "&{}",       "<>",
+  /* Names kept in the symbol table.  fallback => "()", the rest has
+     "(" prepended.  The only other place in perl which knows about
+     this convention is AMG_id2name (used for debugging output and
+     'nomethod' only), the only other place which has it hardwired is
+     overload.pm.  */
+  "()",                "(abs",                 /* "fallback" should be the first. */
+  "(bool",     "(nomethod",
+  "(\"\"",     "(0+",
+  "(+",                "(+=",
+  "(-",                "(-=",
+  "(*",                "(*=",
+  "(/",                "(/=",
+  "(%",                "(%=",
+  "(**",       "(**=",
+  "(<<",       "(<<=",
+  "(>>",       "(>>=",
+  "(&",                "(&=",
+  "(|",                "(|=",
+  "(^",                "(^=",
+  "(<",                "(<=",
+  "(>",                "(>=",
+  "(==",       "(!=",
+  "(<=>",      "(cmp",
+  "(lt",       "(le",
+  "(gt",       "(ge",
+  "(eq",       "(ne",
+  "(!",                "(~",
+  "(++",       "(--",
+  "(atan2",    "(cos",
+  "(sin",      "(exp",
+  "(log",      "(sqrt",
+  "(x",                "(x=",
+  "(.",                "(.=",
+  "(=",                "(neg",
+  "(${}",      "(@{}",
+  "(%{}",      "(*{}",
+  "(&{}",      "(<>",
 };
 #else
 EXTCONST char * PL_AMG_names[NofAMmeth];