perl 5.002gamma: hints/sco.sh
[p5sagit/p5-mst-13.2.git] / gv.c
diff --git a/gv.c b/gv.c
index f4d03d2..7836d88 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -225,7 +225,7 @@ char* name;
        *nsplit = '\0';
        if (strEQ(origname,"SUPER")) {
            /* Degenerate case ->SUPER::method should really lookup in original stash */
-           SV *tmpstr = sv_2mortal(newSVpv(HvNAME(stash),0));
+           SV *tmpstr = sv_2mortal(newSVpv(HvNAME(curcop->cop_stash),0));
            sv_catpvn(tmpstr, "::SUPER", 7);
            stash = gv_stashpv(SvPV(tmpstr,na),TRUE);
            *nsplit = ch;
@@ -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');
            }
        }
     }
@@ -298,7 +300,11 @@ I32 create;
     char tmpbuf[1234];
     HV *stash;
     GV *tmpgv;
-    sprintf(tmpbuf,"%.*s::",1200,name);
+    /* Use strncpy to avoid bug in VMS sprintf */
+    /* sprintf(tmpbuf,"%.*s::",1200,name); */
+    strncpy(tmpbuf, name, 1200);
+    tmpbuf[1200] = '\0';  /* just in case . . . */
+    strcat(tmpbuf, "::");
     tmpgv = gv_fetchpv(tmpbuf,create, SVt_PVHV);
     if (!tmpgv)
        return 0;
@@ -334,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] == ':'))
@@ -418,7 +427,8 @@ 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 ||
@@ -428,10 +438,7 @@ I32 sv_type;
                        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) ))
+                            sv_type == SVt_PV   && !GvSV(*gvp) )
                    {
                        warn("Variable \"%c%s\" is not exported",
                            sv_type == SVt_PVAV ? '@' :
@@ -756,9 +763,8 @@ void
 gp_free(gv)
 GV* gv;
 {
-    IO *io;
-    CV *cv;
     GP* gp;
+    CV* cv;
 
     if (!gv || !(gp = GvGP(gv)))
        return;
@@ -775,10 +781,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);
@@ -899,7 +902,7 @@ HV* stash;
           }
           if (cv) filled=1;
          else {
-           die("Method for operation %s not found in package %.200s during blessing\n",
+           die("Method for operation %s not found in package %.256s during blessing\n",
                cp,HvNAME(stash));
            return FALSE;
          }
@@ -1068,10 +1071,9 @@ int flags;
       } else if (cvp && (cv=cvp[nomethod_amg])) {
        notfound = 1; lr = 1;
       } else {
-       char tmpstr[512];
         if (off==-1) off=method;
-       sprintf(tmpstr,"Operation `%s': no method found,\n\tleft argument %s%.200s,\n\tright argument %s%.200s",
-                     ((char**)AMG_names)[off],
+       sprintf(buf, "Operation `%s': no method found,\n\tleft argument %s%.256s,\n\tright argument %s%.256s",
+                     ((char**)AMG_names)[method + assignshift],
                      SvAMAGIC(left)? 
                        "in overloaded package ":
                        "has no overloaded magic",
@@ -1085,16 +1087,16 @@ int flags;
                        HvNAME(SvSTASH(SvRV(right))):
                        "");
        if (amtp && amtp->fallback >= AMGfallYES) {
-         DEBUG_o( deb(tmpstr) );
+         DEBUG_o( deb(buf) );
        } else {
-         die(tmpstr);
+         die(buf);
        }
        return NULL;
       }
     }
   }
   if (!notfound) {
-    DEBUG_o( deb("Overloaded operator `%s'%s%s%s:\n\tmethod%s found%s in package %.200s%s\n",
+    DEBUG_o( deb("Overloaded operator `%s'%s%s%s:\n\tmethod%s found%s in package %.256s%s\n",
                 ((char**)AMG_names)[off],
                 method+assignshift==off? "" :
                             " (initially `",
@@ -1110,7 +1112,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);
   }
@@ -1135,7 +1137,7 @@ 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;