utime documentation

[perl5.git] / gv.c

diff --git a/gv.c b/gv.c
index a18304e..28a37a6 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -79,7 +79,7 @@ char *name;
     sv_setpv(GvSV(gv), name);
     if (*name == '/' && (instr(name, "/lib/") || instr(name, ".pm")))
        GvMULTI_on(gv);
-    if (perldb)
+    if (PERLDB_LINE)
        hv_magic(GvHVn(gv_AVadd(gv)), gv, 'L');
     return gv;
 }
@@ -104,7 +104,7 @@ int multi;
     GvFILEGV(gv) = curcop->cop_filegv;
     GvEGV(gv) = gv;
     sv_magic((SV*)gv, (SV*)gv, '*', name, len);
-    GvSTASH(gv) = stash;
+    GvSTASH(gv) = (HV*)SvREFCNT_inc(stash);
     GvNAME(gv) = savepvn(name, len);
     GvNAMELEN(gv) = len;
     if (multi)
@@ -170,8 +170,8 @@ I32 level;
     gvp = (GV**)hv_fetch(stash, "ISA", 3, FALSE);
     av = (gvp && (gv = *gvp) && gv != (GV*)&sv_undef) ? GvAV(gv) : Nullav;
 
-    /* create @.*::SUPER::ISA on demand */
-    if (!av) {
+    /* create and re-create @.*::SUPER::ISA on demand */
+    if (!av || !SvMAGIC(av)) {
        char* packname = HvNAME(stash);
        STRLEN packlen = strlen(packname);
 
@@ -275,8 +275,8 @@ I32 autoload;
            --nsplit;
        if ((nsplit - origname) == 5 && strnEQ(origname, "SUPER", 5)) {
            /* ->SUPER::method should really be looked up in original stash */
-           SV *tmpstr = sv_2mortal(newSVpv(HvNAME(curcop->cop_stash), 0));
-           sv_catpvn(tmpstr, "::SUPER", 7);
+           SV *tmpstr = sv_2mortal(newSVpvf("%s::SUPER",
+                                            HvNAME(curcop->cop_stash)));
            stash = gv_stashpvn(SvPVX(tmpstr), SvCUR(tmpstr), TRUE);
            DEBUG_o( deb("Treating %s as %s::%s\n",
                         origname, HvNAME(stash), name) );
@@ -427,7 +427,6 @@ I32 sv_type;
     register char *namend;
     HV *stash = 0;
     U32 add_gvflags = 0;
-    char *tmpbuf;
 
     if (*name == '*' && isALPHA(name[1])) /* accidental stringify on a GV? */
        name++;
@@ -443,23 +442,29 @@ I32 sv_type;
 
            len = namend - name;
            if (len > 0) {
-               New(601, tmpbuf, len+3, char);
+               char smallbuf[256];
+               char *tmpbuf;
+
+               if (len + 3 < sizeof smallbuf)
+                   tmpbuf = smallbuf;
+               else
+                   New(601, tmpbuf, len+3, char);
                Copy(name, tmpbuf, len, char);
                tmpbuf[len++] = ':';
                tmpbuf[len++] = ':';
                tmpbuf[len] = '\0';
                gvp = (GV**)hv_fetch(stash,tmpbuf,len,add);
-               Safefree(tmpbuf);
-               if (!gvp || *gvp == (GV*)&sv_undef)
-                   return Nullgv;
-               gv = *gvp;
-
-               if (SvTYPE(gv) == SVt_PVGV)
-                   GvMULTI_on(gv);
-               else if (!add)
+               gv = gvp ? *gvp : Nullgv;
+               if (gv && gv != (GV*)&sv_undef) {
+                   if (SvTYPE(gv) != SVt_PVGV)
+                       gv_init(gv, stash, tmpbuf, len, (add & 2));
+                   else
+                       GvMULTI_on(gv);
+               }
+               if (tmpbuf != smallbuf)
+                   Safefree(tmpbuf);
+               if (!gv || gv == (GV*)&sv_undef)
                    return Nullgv;
-               else
-                   gv_init(gv, stash, nambeg, namend - nambeg, (add & 2));
 
                if (!(stash = GvHV(gv)))
                    stash = GvHV(gv) = newHV();
@@ -553,17 +558,26 @@ I32 sv_type;
     /* By this point we should have a stash and a name */
 
     if (!stash) {
-       if (add) {
-           warn("Global symbol \"%s\" requires explicit package name", name);
-           ++error_count;
-           stash = curstash ? curstash : defstash;     /* avoid core dumps */
-           add_gvflags = ((sv_type == SVt_PV) ? GVf_IMPORTED_SV
-                          : (sv_type == SVt_PVAV) ? GVf_IMPORTED_AV
-                          : (sv_type == SVt_PVHV) ? GVf_IMPORTED_HV
-                          : 0);
-       }
-       else
+       if (!add)
            return Nullgv;
+       if (add & ~2) {
+           char sv_type_char = ((sv_type == SVt_PV) ? '$'
+                                : (sv_type == SVt_PVAV) ? '@'
+                                : (sv_type == SVt_PVHV) ? '%'
+                                : 0);
+           if (sv_type_char) 
+               warn("Global symbol \"%c%s\" requires explicit package name",
+                    sv_type_char, name);
+           else
+               warn("Global symbol \"%s\" requires explicit package name",
+                    name);
+       }
+       ++error_count;
+       stash = curstash ? curstash : defstash; /* avoid core dumps */
+       add_gvflags = ((sv_type == SVt_PV) ? GVf_IMPORTED_SV
+                      : (sv_type == SVt_PVAV) ? GVf_IMPORTED_AV
+                      : (sv_type == SVt_PVHV) ? GVf_IMPORTED_HV
+                      : 0);
     }
 
     if (!SvREFCNT(stash))      /* symbol table under destruction */
@@ -664,21 +678,21 @@ I32 sv_type;
        if (len > 1)
            break;
        ampergv = gv;
-       sawampersand = TRUE;
+       sawampersand |= 1;
        goto ro_magicalize;
 
     case '`':
        if (len > 1)
            break;
        leftgv = gv;
-       sawampersand = TRUE;
+       sawampersand |= 2;
        goto ro_magicalize;
 
     case '\'':
        if (len > 1)
            break;
        rightgv = gv;
-       sawampersand = TRUE;
+       sawampersand |= 4;
        goto ro_magicalize;
 
     case ':':
@@ -740,6 +754,7 @@ I32 sv_type;
     case '7':
     case '8':
     case '9':
+    case '\023':
       ro_magicalize:
        SvREADONLY_on(GvSV(gv));
       magicalize:
@@ -827,7 +842,9 @@ newIO()
     sv_upgrade((SV *)io,SVt_PVIO);
     SvREFCNT(io) = 1;
     SvOBJECT_on(io);
-    iogv = gv_fetchpv("IO::Handle::", TRUE, SVt_PVHV);
+    iogv = gv_fetchpv("FileHandle::", FALSE, SVt_PVHV);
+    if (!iogv)
+      iogv = gv_fetchpv("IO::Handle::", TRUE, SVt_PVHV);
     SvSTASH(io) = (HV*)SvREFCNT_inc(GvHV(iogv));
     return io;
 }
@@ -1179,13 +1196,11 @@ int flags;
         case copy_amg:
           {
             SV* ref=SvRV(left);
-            if (!SvROK(ref) && SvTYPE(ref) <= SVt_PVMG) { /* Just to be
-                                                     * extra
-                                                     * causious,
-                                                     * maybe in some
-                                                     * additional
-                                                     * cases sv_setsv
-                                                     * is safe too */
+            if (!SvROK(ref) && SvTYPE(ref) <= SVt_PVMG) {
+               /*
+                * Just to be extra cautious.  Maybe in some
+                * additional cases sv_setsv is safe, too.
+                */
                SV* newref = newSVsv(ref);
                SvOBJECT_on(newref);
                SvSTASH(newref) = (HV*)SvREFCNT_inc(SvSTASH(ref));
@@ -1242,7 +1257,7 @@ int flags;
               && !(flags & AMGf_unary)) {
                                /* We look for substitution for
                                 * comparison operations and
-                                * concatendation */
+                                * concatenation */
       if (method==concat_amg || method==concat_ass_amg
          || method==repeat_amg || method==repeat_ass_amg) {
        return NULL;            /* Delegate operation to string conversion */
@@ -1298,7 +1313,7 @@ int flags;
        if (amtp && amtp->fallback >= AMGfallYES) {
          DEBUG_o( deb("%s", SvPVX(msg)) );
        } else {
-         croak("%S", msg);
+         croak("%_", msg);
        }
        return NULL;
       }
@@ -1341,7 +1356,7 @@ int flags;
     ENTER;
     SAVESPTR(op);
     op = (OP *) &myop;
-    if (perldb && curstash != debstash)
+    if (PERLDB_SUB && curstash != debstash)
        op->op_private |= OPpENTERSUB_DB;
     PUTBACK;
     pp_pushmark();