perl 5.002_01: vms/config.vms

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

diff --git a/gv.c b/gv.c
index b3faf16..dc6d2e5 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -65,7 +65,7 @@ char *name;
     gv = gv_fetchpv(tmpbuf, TRUE, SVt_PVGV);
     sv_setpv(GvSV(gv), name);
     if (*name == '/' && (instr(name,"/lib/") || instr(name,".pm")))
-       SvMULTI_on(gv);
+       GvMULTI_on(gv);
     if (perldb)
        hv_magic(GvHVn(gv_AVadd(gv)), gv, 'L');
     return gv;
@@ -96,7 +96,7 @@ int multi;
     GvNAME(gv) = savepvn(name, len);
     GvNAMELEN(gv) = len;
     if (multi)
-       SvMULTI_on(gv);
+       GvMULTI_on(gv);
 }
 
 static void
@@ -284,6 +284,8 @@ 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');
            }
        }
     }
@@ -338,6 +340,9 @@ I32 sv_type;
     bool global = FALSE;
     char *tmpbuf;
 
+    if (*name == '*' && isALPHA(name[1])) /* accidental stringify on a GV? */
+       name++;
+
     for (namend = name; *namend; namend++) {
        if ((*namend == '\'' && namend[1]) ||
            (*namend == ':' && namend[1] == ':'))
@@ -361,7 +366,7 @@ I32 sv_type;
                gv = *gvp;
 
                if (SvTYPE(gv) == SVt_PVGV)
-                   SvMULTI_on(gv);
+                   GvMULTI_on(gv);
                else if (!add)
                    return Nullgv;
                else
@@ -422,22 +427,21 @@ I32 sv_type;
                    sv_type != SVt_PVCV &&
                    sv_type != SVt_PVGV &&
                    sv_type != SVt_PVFM &&
-                   sv_type != SVt_PVIO)
+                   sv_type != SVt_PVIO &&
+                   !(len == 1 && sv_type == SVt_PV && strchr("ab",*name)) )
                {
                    gvp = (GV**)hv_fetch(stash,name,len,0);
                    if (!gvp ||
-                           *gvp == (GV*)&sv_undef ||
-                           SvTYPE(*gvp) != SVt_PVGV ||
-                           !(GvFLAGS(*gvp) & GVf_IMPORTED))
+                       *gvp == (GV*)&sv_undef ||
+                       SvTYPE(*gvp) != SVt_PVGV)
+                   {
                        stash = 0;
-                   else if (sv_type == SVt_PVAV && !GvAV(*gvp) ||
-                            sv_type == SVt_PVHV && !GvHV(*gvp) ||
-                            sv_type == SVt_PV &&
-                                (!GvSV(*gvp) ||
-                                   (!SvTYPE(GvSV(*gvp)) &&
-                                    SvREFCNT(GvSV(*gvp)) == 1) ))
+                   }
+                   else if (sv_type == SVt_PV   && !GvIMPORTED_SV(*gvp) ||
+                            sv_type == SVt_PVAV && !GvIMPORTED_AV(*gvp) ||
+                            sv_type == SVt_PVHV && !GvIMPORTED_HV(*gvp) )
                    {
-                       warn("Variable \"%c%s\" is not exported",
+                       warn("Variable \"%c%s\" is not imported",
                            sv_type == SVt_PVAV ? '@' :
                            sv_type == SVt_PVHV ? '%' : '$',
                            name);
@@ -475,7 +479,7 @@ I32 sv_type;
     gv = *gvp;
     if (SvTYPE(gv) == SVt_PVGV) {
        if (add) {
-           SvMULTI_on(gv);
+           GvMULTI_on(gv);
            gv_init_sv(gv, sv_type);
        }
        return gv;
@@ -499,16 +503,16 @@ I32 sv_type;
     case 'a':
     case 'b':
        if (len == 1)
-           SvMULTI_on(gv);
+           GvMULTI_on(gv);
        break;
     case 'E':
        if (strnEQ(name, "EXPORT", 6))
-           SvMULTI_on(gv);
+           GvMULTI_on(gv);
        break;
     case 'I':
        if (strEQ(name, "ISA")) {
            AV* av = GvAVn(gv);
-           SvMULTI_on(gv);
+           GvMULTI_on(gv);
            sv_magic((SV*)av, (SV*)gv, 'I', Nullch, 0);
            if (add & 2 && strEQ(nambeg,"AnyDBM_File::ISA") && AvFILL(av) == -1)
            {
@@ -530,7 +534,7 @@ I32 sv_type;
     case 'O':
         if (strEQ(name, "OVERLOAD")) {
             HV* hv = GvHVn(gv);
-            SvMULTI_on(gv);
+            GvMULTI_on(gv);
             sv_magic((SV*)hv, (SV*)gv, 'A', 0, 0);
         }
         break;
@@ -539,7 +543,7 @@ I32 sv_type;
        if (strEQ(name, "SIG")) {
            HV *hv;
            siggv = gv;
-           SvMULTI_on(siggv);
+           GvMULTI_on(siggv);
            hv = GvHVn(siggv);
            hv_magic(hv, siggv, 'S');
 
@@ -602,8 +606,10 @@ I32 sv_type;
     case '|':
     case '\001':
     case '\004':
+    case '\005':
     case '\006':
     case '\010':
+    case '\017':
     case '\t':
     case '\020':
     case '\024':
@@ -696,7 +702,7 @@ newIO()
     sv_upgrade((SV *)io,SVt_PVIO);
     SvREFCNT(io) = 1;
     SvOBJECT_on(io);
-    iogv = gv_fetchpv("FileHandle::", TRUE, SVt_PVIO);
+    iogv = gv_fetchpv("FileHandle::", TRUE, SVt_PVHV);
     SvSTASH(io) = (HV*)SvREFCNT_inc(GvHV(iogv));
     return io;
 }
@@ -723,12 +729,12 @@ HV* stash;
            }
            else if (isALPHA(*entry->hent_key)) {
                gv = (GV*)entry->hent_val;
-               if (SvMULTI(gv))
+               if (GvMULTI(gv))
                    continue;
                curcop->cop_line = GvLINE(gv);
                filegv = GvFILEGV(gv);
                curcop->cop_filegv = filegv;
-               if (filegv && SvMULTI(filegv))  /* Filename began with slash */
+               if (filegv && GvMULTI(filegv))  /* Filename began with slash */
                    continue;
                warn("Identifier \"%s::%s\" used only once: possible typo",
                        HvNAME(stash), GvNAME(gv));
@@ -760,9 +766,8 @@ void
 gp_free(gv)
 GV* gv;
 {
-    IO *io;
-    CV *cv;
     GP* gp;
+    CV* cv;
 
     if (!gv || !(gp = GvGP(gv)))
        return;
@@ -779,10 +784,7 @@ GV* gv;
     SvREFCNT_dec(gp->gp_sv);
     SvREFCNT_dec(gp->gp_av);
     SvREFCNT_dec(gp->gp_hv);
-    if ((io = gp->gp_io) && SvTYPE(io) != SVTYPEMASK) {
-       do_close(gv,FALSE);
-       SvREFCNT_dec(io);
-    }
+    SvREFCNT_dec(gp->gp_io);
     if ((cv = gp->gp_cv) && !GvCVGEN(gv))
        SvREFCNT_dec(cv);
     SvREFCNT_dec(gp->gp_form);
@@ -1074,7 +1076,7 @@ int flags;
       } else {
         if (off==-1) off=method;
        sprintf(buf, "Operation `%s': no method found,\n\tleft argument %s%.256s,\n\tright argument %s%.256s",
-                     ((char**)AMG_names)[method],
+                     ((char**)AMG_names)[method + assignshift],
                      SvAMAGIC(left)? 
                        "in overloaded package ":
                        "has no overloaded magic",
@@ -1113,7 +1115,7 @@ int flags;
      * to dublicate the contents, probably calling user-supplied
      * version of copy operator
      */
-    if ((method+assignshift==off 
+    if ((method + assignshift==off 
         && (assign || method==inc_amg || method==dec_amg))
        || inc_dec_ass) RvDEEPCP(left);
   }
@@ -1138,13 +1140,13 @@ int flags;
     PUSHs(lr>0? left: right);
     PUSHs( assign ? &sv_undef : (lr>0? &sv_yes: &sv_no));
     if (notfound) {
-      PUSHs( sv_2mortal(newSVpv(((char**)AMG_names)[off],0)) );
+      PUSHs( sv_2mortal(newSVpv(((char**)AMG_names)[method + assignshift],0)) );
     }
     PUSHs((SV*)cv);
     PUTBACK;
 
     if (op = pp_entersub())
-      run();
+      runops();
     LEAVE;
     SPAGAIN;