New warning "Useless localization of %s", based on

[perl5.git] / sv.c

diff --git a/sv.c b/sv.c
index 1de42fb..d82e354 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3069,7 +3069,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
                                    s = "REF";
                                else
                                    s = "SCALAR";               break;
-               case SVt_PVLV:  s = "LVALUE";                   break;
+               case SVt_PVLV:  s = SvROK(sv) ? "REF":"LVALUE"; break;
                case SVt_PVAV:  s = "ARRAY";                    break;
                case SVt_PVHV:  s = "HASH";                     break;
                case SVt_PVCV:  s = "CODE";                     break;
@@ -3080,7 +3080,10 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
                }
                tsv = NEWSV(0,0);
                if (SvOBJECT(sv))
-                   Perl_sv_setpvf(aTHX_ tsv, "%s=%s", HvNAME(SvSTASH(sv)), s);
+                   if (HvNAME(SvSTASH(sv)))
+                       Perl_sv_setpvf(aTHX_ tsv, "%s=%s", HvNAME(SvSTASH(sv)), s);
+                   else
+                       Perl_sv_setpvf(aTHX_ tsv, "__ANON__=%s", s);
                else
                    sv_setpv(tsv, s);
                Perl_sv_catpvf(aTHX_ tsv, "(0x%"UVxf")", PTR2UV(sv));
@@ -5393,7 +5396,13 @@ Perl_sv_clear(pTHX_ register SV *sv)
        av_undef((AV*)sv);
        break;
     case SVt_PVLV:
-       SvREFCNT_dec(LvTARG(sv));
+       if (LvTYPE(sv) == 'T') { /* for tie: return HE to pool */
+           SvREFCNT_dec(HeKEY_sv((HE*)LvTARG(sv)));
+           HeNEXT((HE*)LvTARG(sv)) = PL_hv_fetch_ent_mh;
+           PL_hv_fetch_ent_mh = (HE*)LvTARG(sv);
+       }
+       else if (LvTYPE(sv) != 't') /* unless tie: unrefcnted fake SV**  */
+           SvREFCNT_dec(LvTARG(sv));
        goto freescalar;
     case SVt_PVGV:
        gp_free((GV*)sv);
@@ -6348,7 +6357,7 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
        Stat_t st;
        if (!PerlLIO_fstat(PerlIO_fileno(fp), &st) && S_ISREG(st.st_mode))  {
            Off_t offset = PerlIO_tell(fp);
-           if (offset != (Off_t) -1) {
+           if (offset != (Off_t) -1 && st.st_size + append > offset) {
                (void) SvGROW(sv, (STRLEN)((st.st_size - offset) + append + 1));
            }
        }
@@ -6373,6 +6382,8 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
 #else
       bytesread = PerlIO_read(fp, buffer, recsize);
 #endif
+      if (bytesread < 0)
+         bytesread = 0;
       SvCUR_set(sv, bytesread += append);
       buffer[bytesread] = '\0';
       goto return_string_or_null;
@@ -7765,7 +7776,10 @@ char *
 Perl_sv_reftype(pTHX_ SV *sv, int ob)
 {
     if (ob && SvOBJECT(sv)) {
-       return HvNAME(SvSTASH(sv));
+       if (HvNAME(SvSTASH(sv)))
+           return HvNAME(SvSTASH(sv));
+       else
+           return "__ANON__";
     }
     else {
        switch (SvTYPE(sv)) {
@@ -7784,7 +7798,7 @@ Perl_sv_reftype(pTHX_ SV *sv, int ob)
                                    return "REF";
                                else
                                    return "SCALAR";
-       case SVt_PVLV:          return "LVALUE";
+       case SVt_PVLV:          return SvROK(sv) ? "REF" : "LVALUE";
        case SVt_PVAV:          return "ARRAY";
        case SVt_PVHV:          return "HASH";
        case SVt_PVCV:          return "CODE";
@@ -7843,6 +7857,8 @@ Perl_sv_isa(pTHX_ SV *sv, const char *name)
     sv = (SV*)SvRV(sv);
     if (!SvOBJECT(sv))
        return 0;
+    if (!HvNAME(SvSTASH(sv)))
+       return 0;
 
     return strEQ(HvNAME(SvSTASH(sv)), name);
 }
@@ -10004,7 +10020,12 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
        Perl_rvpv_dup(aTHX_ dstr, sstr, param);
        LvTARGOFF(dstr) = LvTARGOFF(sstr);      /* XXX sometimes holds PMOP* when DEBUGGING */
        LvTARGLEN(dstr) = LvTARGLEN(sstr);
-       LvTARG(dstr)    = sv_dup_inc(LvTARG(sstr), param);
+       if (LvTYPE(sstr) == 't') /* for tie: unrefcnted fake (SV**) */
+           LvTARG(dstr) = dstr;
+       else if (LvTYPE(sstr) == 'T') /* for tie: fake HE */
+           LvTARG(dstr) = (SV*)he_dup((HE*)LvTARG(sstr), 0, param);
+       else
+           LvTARG(dstr) = sv_dup_inc(LvTARG(sstr), param);
        LvTYPE(dstr)    = LvTYPE(sstr);
        break;
     case SVt_PVGV:
@@ -10059,12 +10080,21 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
        IoPAGE(dstr)            = IoPAGE(sstr);
        IoPAGE_LEN(dstr)        = IoPAGE_LEN(sstr);
        IoLINES_LEFT(dstr)      = IoLINES_LEFT(sstr);
+        if(IoFLAGS(sstr) & IOf_FAKE_DIRP) { 
+            /* I have no idea why fake dirp (rsfps)
+               should be treaded differently but otherwise
+               we end up with leaks -- sky*/
+            IoTOP_GV(dstr)      = gv_dup_inc(IoTOP_GV(sstr), param);
+            IoFMT_GV(dstr)      = gv_dup_inc(IoFMT_GV(sstr), param);
+            IoBOTTOM_GV(dstr)   = gv_dup_inc(IoBOTTOM_GV(sstr), param);
+        } else {
+            IoTOP_GV(dstr)      = gv_dup(IoTOP_GV(sstr), param);
+            IoFMT_GV(dstr)      = gv_dup(IoFMT_GV(sstr), param);
+            IoBOTTOM_GV(dstr)   = gv_dup(IoBOTTOM_GV(sstr), param);
+        }
        IoTOP_NAME(dstr)        = SAVEPV(IoTOP_NAME(sstr));
-       IoTOP_GV(dstr)          = gv_dup(IoTOP_GV(sstr), param);
        IoFMT_NAME(dstr)        = SAVEPV(IoFMT_NAME(sstr));
-       IoFMT_GV(dstr)          = gv_dup(IoFMT_GV(sstr), param);
        IoBOTTOM_NAME(dstr)     = SAVEPV(IoBOTTOM_NAME(sstr));
-       IoBOTTOM_GV(dstr)       = gv_dup(IoBOTTOM_GV(sstr), param);
        IoSUBPROCESS(dstr)      = IoSUBPROCESS(sstr);
        IoTYPE(dstr)            = IoTYPE(sstr);
        IoFLAGS(dstr)           = IoFLAGS(sstr);
@@ -11191,6 +11221,23 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     /* sort() routine */
     PL_sort_RealCmp    = proto_perl->Isort_RealCmp;
 
+    /* Not really needed/useful since the reenrant_retint is "volatile",
+     * but do it for consistency's sake. */
+    PL_reentrant_retint        = proto_perl->Ireentrant_retint;
+
+    /* Hooks to shared SVs and locks. */
+    PL_sharehook       = proto_perl->Isharehook;
+    PL_lockhook                = proto_perl->Ilockhook;
+    PL_unlockhook      = proto_perl->Iunlockhook;
+    PL_threadhook      = proto_perl->Ithreadhook;
+
+    PL_runops_std      = proto_perl->Irunops_std;
+    PL_runops_dbg      = proto_perl->Irunops_dbg;
+
+#ifdef THREADS_HAVE_PIDS
+    PL_ppid            = proto_perl->Ippid;
+#endif
+
     /* swatch cache */
     PL_last_swash_hv   = Nullhv;       /* reinits on demand */
     PL_last_swash_klen = 0;
@@ -11332,9 +11379,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_protect         = proto_perl->Tprotect;
 #endif
     PL_errors          = sv_dup_inc(proto_perl->Terrors, param);
-    PL_av_fetch_sv     = Nullsv;
-    PL_hv_fetch_sv     = Nullsv;
-    Zero(&PL_hv_fetch_ent_mh, 1, HE);                  /* XXX */
+    PL_hv_fetch_ent_mh = Nullhe;
     PL_modcount                = proto_perl->Tmodcount;
     PL_lastgotoprobe   = Nullop;
     PL_dumpindent      = proto_perl->Tdumpindent;