Support named closures

[p5sagit/p5-mst-13.2.git] / gv.c

diff --git a/gv.c b/gv.c
index cb38bad..6dd8ad0 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -19,7 +19,7 @@
 #include "EXTERN.h"
 #include "perl.h"
 
-extern char rcsid[];
+EXT char rcsid[];
 
 GV *
 gv_AVadd(gv)
@@ -143,19 +143,20 @@ I32 level;
     if (SvTYPE(topgv) != SVt_PVGV)
        gv_init(topgv, stash, name, len, TRUE);
 
-    if (cv=GvCV(topgv)) {
-       if (GvCVGEN(topgv) >= sub_generation)
-           return topgv;       /* valid cached inheritance */
-       if (!GvCVGEN(topgv)) {  /* not an inheritance cache */
-           return topgv;
-       }
-       else {
-           /* stale cached entry, just junk it */
-           GvCV(topgv) = cv = 0;
-           GvCVGEN(topgv) = 0;
+    if (cv = GvCV(topgv)) {
+       if (CvXSUB(cv) || CvROOT(cv) || CvGV(cv)) { /* Not deleted, possibly autoloaded. */
+           if (GvCVGEN(topgv) >= sub_generation)
+               return topgv;   /* valid cached inheritance */
+           if (!GvCVGEN(topgv)) {      /* not an inheritance cache */
+               return topgv;
+           }
        }
+       /* stale cached entry, just junk it */
+       SvREFCNT_dec(cv);
+       GvCV(topgv) = cv = 0;
+       GvCVGEN(topgv) = 0;
     }
-    /* if cv is still set, we have to free it if we find something to cache */
+    /* Now cv = 0, and there is no cv in topgv. */
 
     gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE);
     if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) {
@@ -172,13 +173,9 @@ I32 level;
            }
            gv = gv_fetchmeth(basestash, name, len, level + 1);
            if (gv) {
-               if (cv) {                               /* junk old undef */
-                   assert(SvREFCNT(topgv) > 1);
-                   SvREFCNT_dec(topgv);
-                   SvREFCNT_dec(cv);
-               }
                GvCV(topgv) = GvCV(gv);                 /* cache the CV */
                GvCVGEN(topgv) = sub_generation;        /* valid for now */
+               SvREFCNT_inc(GvCV(gv));
                return gv;
            }
        }
@@ -187,13 +184,9 @@ I32 level;
     if (!level) {
        if (lastchance = gv_stashpvn("UNIVERSAL", 9, FALSE)) {
            if (gv = gv_fetchmeth(lastchance, name, len, level + 1)) {
-               if (cv) {                               /* junk old undef */
-                   assert(SvREFCNT(topgv) > 1);
-                   SvREFCNT_dec(topgv);
-                   SvREFCNT_dec(cv);
-               }
                GvCV(topgv) = GvCV(gv);                 /* cache the CV */
                GvCVGEN(topgv) = sub_generation;        /* valid for now */
+               SvREFCNT_inc(GvCV(gv));
                return gv;
            }
        }
@@ -276,7 +269,7 @@ char* name;
     if (!gv) {
        CV* cv;
 
-       if (strEQ(name,"import") || strEQ(name,"unimport"))
+       if (strEQ(name,"import"))
            gv = (GV*)&sv_yes;
        else if (strNE(name, "AUTOLOAD")) {
            gv = gv_fetchmeth(stash, "AUTOLOAD", 8, 0);
@@ -285,8 +278,7 @@ char* name;
                sv_catpvn(tmpstr,"::", 2);
                sv_catpvn(tmpstr, name, nend - name);
                sv_setsv(GvSV(CvGV(cv)), tmpstr);
-               if (tainting)
-                   sv_unmagic(GvSV(CvGV(cv)), 't');
+               SvTAINTED_off(GvSV(CvGV(cv)));
            }
        }
     }
@@ -687,38 +679,50 @@ I32 sv_type;
 }
 
 void
-gv_fullname(sv,gv)
+gv_fullname3(sv, gv, prefix)
 SV *sv;
 GV *gv;
+char *prefix;
 {
     HV *hv = GvSTASH(gv);
-
-    if (!hv)
+    if (!hv) {
+       SvOK_off(sv);
        return;
-    sv_setpv(sv, sv == (SV*)gv ? "*" : "");
+    }
+    sv_setpv(sv, prefix ? prefix : "");
     sv_catpv(sv,HvNAME(hv));
     sv_catpvn(sv,"::", 2);
     sv_catpvn(sv,GvNAME(gv),GvNAMELEN(gv));
 }
 
 void
-gv_efullname(sv,gv)
+gv_efullname3(sv, gv, prefix)
 SV *sv;
 GV *gv;
+char *prefix;
 {
-    GV* egv = GvEGV(gv);
-    HV *hv;
-    
+    GV *egv = GvEGV(gv);
     if (!egv)
        egv = gv;
-    hv = GvSTASH(egv);
-    if (!hv)
-       return;
+    gv_fullname3(sv, egv, prefix);
+}
 
-    sv_setpv(sv, sv == (SV*)gv ? "*" : "");
-    sv_catpv(sv,HvNAME(hv));
-    sv_catpvn(sv,"::", 2);
-    sv_catpvn(sv,GvNAME(egv),GvNAMELEN(egv));
+/* XXX compatibility with versions <= 5.003. */
+void
+gv_fullname(sv,gv)
+SV *sv;
+GV *gv;
+{
+    gv_fullname3(sv, gv, sv == (SV*)gv ? "*" : "");
+}
+
+/* XXX compatibility with versions <= 5.003. */
+void
+gv_efullname(sv,gv)
+SV *sv;
+GV *gv;
+{
+    gv_efullname3(sv, gv, sv == (SV*)gv ? "*" : "");
 }
 
 IO *
@@ -923,7 +927,7 @@ HV* stash;
                 /* FALL THROUGH */
             case SVt_PVHV:
             case SVt_PVAV:
-             die("Not a subroutine reference in %%OVERLOAD");
+             die("Not a subroutine reference in overload table");
              return FALSE;
             case SVt_PVCV:
                 cv = (CV*)sv;
@@ -1219,7 +1223,7 @@ int flags;
        ans=SvIV(res)!=0; break;
       case inc_amg:
       case dec_amg:
-       SvSetSV(left,res); return res; break;
+       SvSetSV(left,res); return left;
       case not_amg:
 ans=!SvOK(res); break;
       }