up patchlevel &c
[p5sagit/p5-mst-13.2.git] / gv.c
diff --git a/gv.c b/gv.c
index a3e8d88..8df41c5 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1,6 +1,6 @@
 /*    gv.c
  *
- *    Copyright (c) 1991-1997, Larry Wall
+ *    Copyright (c) 1991-1999, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -50,7 +50,7 @@ gv_IOadd(register GV *gv)
 }
 
 GV *
-gv_fetchfile(char *name)
+gv_fetchfile(const char *name)
 {
     dTHR;
     char smallbuf[256];
@@ -80,7 +80,7 @@ gv_fetchfile(char *name)
 }
 
 void
-gv_init(GV *gv, HV *stash, char *name, STRLEN len, int multi)
+gv_init(GV *gv, HV *stash, const char *name, STRLEN len, int multi)
 {
     dTHR;
     register GP *gp;
@@ -107,11 +107,12 @@ gv_init(GV *gv, HV *stash, char *name, STRLEN len, int multi)
     GvSTASH(gv) = (HV*)SvREFCNT_inc(stash);
     GvNAME(gv) = savepvn(name, len);
     GvNAMELEN(gv) = len;
-    if (multi)
+    if (multi || doproto)              /* doproto means it _was_ mentioned */
        GvMULTI_on(gv);
     if (doproto) {                     /* Replicate part of newSUB here. */
        SvIOK_off(gv);
        ENTER;
+       /* XXX unsafe for threads if eval_owner isn't held */
        start_subparse(0,0);            /* Create CV in compcv. */
        GvCV(gv) = PL_compcv;
        LEAVE;
@@ -151,7 +152,7 @@ gv_init_sv(GV *gv, I32 sv_type)
 }
 
 GV *
-gv_fetchmeth(HV *stash, char *name, STRLEN len, I32 level)
+gv_fetchmeth(HV *stash, const char *name, STRLEN len, I32 level)
 {
     AV* av;
     GV* topgv;
@@ -272,17 +273,17 @@ gv_fetchmeth(HV *stash, char *name, STRLEN len, I32 level)
 }
 
 GV *
-gv_fetchmethod(HV *stash, char *name)
+gv_fetchmethod(HV *stash, const char *name)
 {
     return gv_fetchmethod_autoload(stash, name, TRUE);
 }
 
 GV *
-gv_fetchmethod_autoload(HV *stash, char *name, I32 autoload)
+gv_fetchmethod_autoload(HV *stash, const char *name, I32 autoload)
 {
     dTHR;
-    register char *nend;
-    char *nsplit = 0;
+    register const char *nend;
+    const char *nsplit = 0;
     GV* gv;
     
     for (nend = name; *nend; nend++) {
@@ -292,7 +293,7 @@ gv_fetchmethod_autoload(HV *stash, char *name, I32 autoload)
            nsplit = ++nend;
     }
     if (nsplit) {
-       char *origname = name;
+       const char *origname = name;
        name = nsplit + 1;
        if (*nsplit == ':')
            --nsplit;
@@ -339,7 +340,7 @@ gv_fetchmethod_autoload(HV *stash, char *name, I32 autoload)
 }
 
 GV*
-gv_autoload4(HV *stash, char *name, STRLEN len, I32 method)
+gv_autoload4(HV *stash, const char *name, STRLEN len, I32 method)
 {
     dTHR;
     static char autoload[] = "AUTOLOAD";
@@ -384,13 +385,13 @@ gv_autoload4(HV *stash, char *name, STRLEN len, I32 method)
 }
 
 HV*
-gv_stashpv(char *name, I32 create)
+gv_stashpv(const char *name, I32 create)
 {
     return gv_stashpvn(name, strlen(name), create);
 }
 
 HV*
-gv_stashpvn(char *name, U32 namelen, I32 create)
+gv_stashpvn(const char *name, U32 namelen, I32 create)
 {
     char smallbuf[256];
     char *tmpbuf;
@@ -429,14 +430,14 @@ gv_stashsv(SV *sv, I32 create)
 
 
 GV *
-gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
+gv_fetchpv(const char *nambeg, I32 add, I32 sv_type)
 {
     dTHR;
-    register char *name = nambeg;
+    register const char *name = nambeg;
     register GV *gv = 0;
     GV**gvp;
     I32 len;
-    register char *namend;
+    register const char *namend;
     HV *stash = 0;
     U32 add_gvflags = 0;
 
@@ -620,12 +621,6 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
            IoFLAGS(GvIOn(gv)) |= IOf_ARGV|IOf_START;
        }
        break;
-
-    case 'a':
-    case 'b':
-       if (len == 1)
-           GvMULTI_on(gv);
-       break;
     case 'E':
        if (strnEQ(name, "EXPORT", 6))
            GvMULTI_on(gv);
@@ -640,20 +635,19 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
                && AvFILLp(av) == -1)
            {
                char *pname;
-               av_push(av, newSVpv(pname = "NDBM_File",0));
+               av_push(av, newSVpvn(pname = "NDBM_File",9));
                gv_stashpvn(pname, 9, TRUE);
-               av_push(av, newSVpv(pname = "DB_File",0));
+               av_push(av, newSVpvn(pname = "DB_File",7));
                gv_stashpvn(pname, 7, TRUE);
-               av_push(av, newSVpv(pname = "GDBM_File",0));
+               av_push(av, newSVpvn(pname = "GDBM_File",9));
                gv_stashpvn(pname, 9, TRUE);
-               av_push(av, newSVpv(pname = "SDBM_File",0));
+               av_push(av, newSVpvn(pname = "SDBM_File",9));
                gv_stashpvn(pname, 9, TRUE);
-               av_push(av, newSVpv(pname = "ODBM_File",0));
+               av_push(av, newSVpvn(pname = "ODBM_File",9));
                gv_stashpvn(pname, 9, TRUE);
            }
        }
        break;
-#ifdef OVERLOAD
     case 'O':
         if (strEQ(name, "OVERLOAD")) {
             HV* hv = GvHVn(gv);
@@ -661,7 +655,6 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
             hv_magic(hv, gv, 'A');
         }
         break;
-#endif /* OVERLOAD */
     case 'S':
        if (strEQ(name, "SIG")) {
            HV *hv;
@@ -670,13 +663,13 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
            GvMULTI_on(PL_siggv);
            hv = GvHVn(PL_siggv);
            hv_magic(hv, PL_siggv, 'S');
-           for(i=1;sig_name[i];i++) {
+           for(i=1;PL_sig_name[i];i++) {
                SV ** init;
-               init=hv_fetch(hv,sig_name[i],strlen(sig_name[i]),1);
+               init=hv_fetch(hv,PL_sig_name[i],strlen(PL_sig_name[i]),1);
                if(init)
                        sv_setsv(*init,&PL_sv_undef);
-               psig_ptr[i] = 0;
-               psig_name[i] = 0;
+               PL_psig_ptr[i] = 0;
+               PL_psig_name[i] = 0;
            }
        }
        break;
@@ -712,7 +705,7 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
        if (len > 1)
            break;
 #ifdef COMPLEX_STATUS
-       sv_upgrade(GvSV(gv), SVt_PVLV);
+       (void)SvUPGRADE(GvSV(gv), SVt_PVLV);
 #endif
        goto magicalize;
 
@@ -761,6 +754,7 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
     case '|':
     case '\001':
     case '\002':
+    case '\003':
     case '\004':
     case '\005':
     case '\006':
@@ -815,7 +809,7 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
     case ']':
        if (len == 1) {
            SV *sv = GvSV(gv);
-           sv_upgrade(sv, SVt_PVNV);
+           (void)SvUPGRADE(sv, SVt_PVNV);
            sv_setpv(sv, PL_patchlevel);
            (void)sv_2nv(sv);
            SvREADONLY_on(sv);
@@ -826,7 +820,7 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
 }
 
 void
-gv_fullname3(SV *sv, GV *gv, char *prefix)
+gv_fullname3(SV *sv, GV *gv, const char *prefix)
 {
     HV *hv = GvSTASH(gv);
     if (!hv) {
@@ -840,7 +834,7 @@ gv_fullname3(SV *sv, GV *gv, char *prefix)
 }
 
 void
-gv_efullname3(SV *sv, GV *gv, char *prefix)
+gv_efullname3(SV *sv, GV *gv, const char *prefix)
 {
     GV *egv = GvEGV(gv);
     if (!egv)
@@ -874,7 +868,8 @@ newIO(void)
     SvREFCNT(io) = 1;
     SvOBJECT_on(io);
     iogv = gv_fetchpv("FileHandle::", FALSE, SVt_PVHV);
-    if (!iogv)
+    /* unless exists($main::{FileHandle}) and defined(%main::FileHandle::) */
+    if (!(iogv && GvHV(iogv) && HvARRAY(GvHV(iogv))))
       iogv = gv_fetchpv("IO::Handle::", TRUE, SVt_PVHV);
     SvSTASH(io) = (HV*)SvREFCNT_inc(GvHV(iogv));
     return io;
@@ -1002,7 +997,6 @@ register GV *gv;
 }
 #endif                 /* Microport 2.4 hack */
 
-#ifdef OVERLOAD
 /* Updates and caches the CV's */
 
 bool
@@ -1016,6 +1010,7 @@ Gv_AMupdate(HV *stash)
   MAGIC* mg=mg_find((SV*)stash,'c');
   AMT *amtp = (mg) ? (AMT*)mg->mg_ptr: (AMT *) NULL;
   AMT amt;
+  STRLEN n_a;
 
   if (mg && amtp->was_ok_am == PL_amagic_generation
       && amtp->was_ok_sub == PL_sub_generation)
@@ -1046,16 +1041,16 @@ Gv_AMupdate(HV *stash)
     SV* sv;
     SV** svp;
 
-    /* Work with "fallback" key, which we assume to be first in AMG_names */
+    /* Work with "fallback" key, which we assume to be first in PL_AMG_names */
 
-    if (( cp = (char *)AMG_names[0] ) &&
+    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 *)AMG_names[i];
+      cp = (char *)PL_AMG_names[i];
       
         svp = (SV**)hv_fetch(hv, cp, strlen(cp), FALSE);
         if (svp && ((sv = *svp) != &PL_sv_undef)) {
@@ -1063,7 +1058,7 @@ Gv_AMupdate(HV *stash)
             default:
               if (!SvROK(sv)) {
                 if (!SvOK(sv)) break;
-               gv = gv_fetchmethod(stash, SvPV(sv, PL_na));
+               gv = gv_fetchmethod(stash, SvPV(sv, n_a));
                 if (gv) cv = GvCV(gv);
                 break;
               }
@@ -1080,7 +1075,7 @@ Gv_AMupdate(HV *stash)
               break;
             case SVt_PVGV:
               if (!(cv = GvCVu((GV*)sv)))
-                cv = sv_2cv(sv, &stash, &gv, TRUE);
+                cv = sv_2cv(sv, &stash, &gv, FALSE);
               break;
           }
           if (cv) filled=1;
@@ -1098,9 +1093,9 @@ Gv_AMupdate(HV *stash)
     SV* sv = NULL;
     SV** svp;
 
-    /* Work with "fallback" key, which we assume to be first in AMG_names */
+    /* Work with "fallback" key, which we assume to be first in PL_AMG_names */
 
-    if ( cp = AMG_names[0] ) {
+    if ( cp = PL_AMG_names[0] ) {
        /* Try to find via inheritance. */
        gv = gv_fetchmeth(stash, "()", 2, -1); /* A cookie: "()". */
        if (gv) sv = GvSV(gv);
@@ -1111,7 +1106,7 @@ Gv_AMupdate(HV *stash)
     }
 
     for (i = 1; i < NofAMmeth; i++) {
-       SV *cookie = sv_2mortal(newSVpvf("(%s", cp = AMG_names[i]));
+       SV *cookie = sv_2mortal(newSVpvf("(%s", cp = PL_AMG_names[i]));
        DEBUG_o( deb("Checking overloading of `%s' in package `%.256s'\n",
                     cp, HvNAME(stash)) );
        /* don't fill the cache while looking up! */
@@ -1124,7 +1119,7 @@ Gv_AMupdate(HV *stash)
                GV *ngv;
                
                DEBUG_o( deb("Resolving method `%.256s' for overloaded `%s' in package `%.256s'\n", 
-                            SvPV(GvSV(gv), PL_na), cp, HvNAME(stash)) );
+                            SvPV(GvSV(gv), n_a), cp, HvNAME(stash)) );
                if (!SvPOK(GvSV(gv)) 
                    || !(ngv = gv_fetchmethod_autoload(stash, SvPVX(GvSV(gv)),
                                                       FALSE)))
@@ -1135,7 +1130,7 @@ Gv_AMupdate(HV *stash)
                              (SvPOK(GvSV(gv)) ?  SvPVX(GvSV(gv)) : "???" ),
                              cp, HvNAME(stash));
                    } else
-                       croak("Cannot resolve method `%.256s' overloading `%s' in package `%.256s'", 
+                       croak("Can't resolve method `%.256s' overloading `%s' in package `%.256s'", 
                              (SvPOK(GvSV(gv)) ?  SvPVX(GvSV(gv)) : "???" ),
                              cp, HvNAME(stash));
                }
@@ -1269,6 +1264,15 @@ amagic_call(SV *left, SV *right, int method, int flags)
             lr = 1;
           }
           break;
+        case iter_amg:                 /* XXXX Eventually should do to_gv. */
+        case to_sv_amg:
+        case to_av_amg:
+        case to_hv_amg:
+        case to_gv_amg:
+        case to_cv_amg:
+            /* FAIL safe */
+            return NULL;       /* Delegate operation to standard mechanisms. */
+            break;
         default:
           goto not_found;
         }
@@ -1324,7 +1328,7 @@ amagic_call(SV *left, SV *right, int method, int flags)
        if (off==-1) off=method;
        msg = sv_2mortal(newSVpvf(
                      "Operation `%s': no method found,%sargument %s%s%s%s",
-                     AMG_names[method + assignshift],
+                     PL_AMG_names[method + assignshift],
                      (flags & AMGf_unary ? " " : "\n\tleft "),
                      SvAMAGIC(left)? 
                        "in overloaded package ":
@@ -1353,11 +1357,11 @@ amagic_call(SV *left, SV *right, int method, int flags)
   if (!notfound) {
     DEBUG_o( deb(
   "Overloaded operator `%s'%s%s%s:\n\tmethod%s found%s in package %s%s\n",
-                AMG_names[off],
+                PL_AMG_names[off],
                 method+assignshift==off? "" :
                             " (initially `",
                 method+assignshift==off? "" :
-                            AMG_names[method+assignshift],
+                            PL_AMG_names[method+assignshift],
                 method+assignshift==off? "" : "')",
                 flags & AMGf_unary? "" :
                   lr==1 ? " for right argument": " for left argument",
@@ -1417,7 +1421,7 @@ amagic_call(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 *)AMG_names[method + assignshift],0)) );
+      PUSHs( sv_2mortal(newSVpv((char *)PL_AMG_names[method + assignshift],0)));
     }
     PUSHs((SV*)cv);
     PUTBACK;
@@ -1428,6 +1432,7 @@ amagic_call(SV *left, SV *right, int method, int flags)
     SPAGAIN;
 
     res=POPs;
+    PUTBACK;
     POPSTACK;
     CATCH_SET(oldcatch);
 
@@ -1469,5 +1474,3 @@ amagic_call(SV *left, SV *right, int method, int flags)
     }
   }
 }
-#endif /* OVERLOAD */
-