This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
New warning "Useless localization of %s", based on
[perl5.git] / sv.c
diff --git a/sv.c b/sv.c
index 5280c08..d82e354 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -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));
@@ -6354,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));
            }
        }
@@ -6379,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;
@@ -7771,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)) {
@@ -7849,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);
 }
@@ -10070,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);
@@ -11202,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;