[win32] merge changes#922,944,949,965,970 from maintbranch

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

diff --git a/sv.c b/sv.c
index 62add34..8310047 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -335,8 +335,19 @@ do_clean_objs(SV *sv)
 static void
 do_clean_named_objs(SV *sv)
 {
-    if (SvTYPE(sv) == SVt_PVGV && GvSV(sv))
-       do_clean_objs(GvSV(sv));
+    if (SvTYPE(sv) == SVt_PVGV) {
+       if ( SvOBJECT(GvSV(sv)) ||
+            GvAV(sv) && SvOBJECT(GvAV(sv)) ||
+            GvHV(sv) && SvOBJECT(GvHV(sv)) ||
+            GvIO(sv) && SvOBJECT(GvIO(sv)) ||
+            GvCV(sv) && SvOBJECT(GvCV(sv)) )
+       {
+           DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning named glob object:\n "), sv_dump(sv));)
+           SvREFCNT_dec(sv);
+       }
+       else if (GvSV(sv))
+           do_clean_objs(GvSV(sv));
+    }
 }
 #endif
 
@@ -389,6 +400,10 @@ sv_free_arenas(void)
            Safefree((void *)sva);
     }
 
+    if (nice_chunk)
+       Safefree(nice_chunk);
+    nice_chunk = Nullch;
+    nice_chunk_size = 0;
     sv_arenaroot = 0;
     sv_root = 0;
 }
@@ -1891,8 +1906,11 @@ sv_setsv(SV *dstr, register SV *sstr)
 
     switch (stype) {
     case SVt_NULL:
-       (void)SvOK_off(dstr);
-       return;
+       if (dtype != SVt_PVGV) {
+           (void)SvOK_off(dstr);
+           return;
+       }
+       break;
     case SVt_IV:
        if (dtype != SVt_IV && dtype < SVt_PVIV) {
            if (dtype < SVt_IV)
@@ -2194,7 +2212,12 @@ sv_setsv(SV *dstr, register SV *sstr)
        SvIVX(dstr) = SvIVX(sstr);
     }
     else {
-       (void)SvOK_off(dstr);
+       if (dtype == SVt_PVGV) {
+           if (dowarn)
+               warn("Undefined value assigned to typeglob");
+       }
+       else
+           (void)SvOK_off(dstr);
     }
     SvTAINT(dstr);
 }
@@ -2406,11 +2429,7 @@ sv_catpv_mg(register SV *sv, register char *ptr)
 }
 
 SV *
-#ifdef LEAKTEST
-newSV(I32 x, STRLEN len)
-#else
 newSV(STRLEN len)
-#endif
 {
     register SV *sv;
     
@@ -2619,10 +2638,17 @@ sv_insert(SV *bigstr, STRLEN offset, STRLEN len, char *little, STRLEN littlelen)
     register char *midend;
     register char *bigend;
     register I32 i;
+    STRLEN curlen;
+    
 
     if (!bigstr)
        croak("Can't modify non-existent substring");
-    SvPV_force(bigstr, na);
+    SvPV_force(bigstr, curlen);
+    if (offset + len > curlen) {
+       SvGROW(bigstr, offset+len+1);
+       Zero(SvPVX(bigstr)+curlen, offset+len-curlen, char);
+       SvCUR_set(bigstr, offset+len);
+    }
 
     i = littlelen - len;
     if (i > 0) {                       /* string might grow */
@@ -2718,6 +2744,7 @@ sv_replace(register SV *sv, register SV *nsv)
 void
 sv_clear(register SV *sv)
 {
+    HV* stash;
     assert(sv);
     assert(SvREFCNT(sv) == 0);
 
@@ -2726,7 +2753,6 @@ sv_clear(register SV *sv)
        if (defstash) {         /* Still have a symbol table? */
            djSP;
            GV* destructor;
-           HV* stash;
            SV ref;
 
            Zero(&ref, 1, SV);
@@ -2772,6 +2798,7 @@ sv_clear(register SV *sv)
     }
     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
        mg_free(sv);
+    stash = NULL;
     switch (SvTYPE(sv)) {
     case SVt_PVIO:
        if (IoIFP(sv) != PerlIO_stdin() &&
@@ -2797,7 +2824,11 @@ sv_clear(register SV *sv)
     case SVt_PVGV:
        gp_free((GV*)sv);
        Safefree(GvNAME(sv));
-       SvREFCNT_dec(GvSTASH(sv));
+       /* cannot decrease stash refcount yet, as we might recursively delete
+          ourselves when the refcnt drops to zero. Delay SvREFCNT_dec
+          of stash until current sv is completely gone.
+          -- JohnPC, 27 Mar 1998 */
+       stash = GvSTASH(sv);
        /* FALL THROUGH */
     case SVt_PVLV:
     case SVt_PVMG:
@@ -2859,7 +2890,13 @@ sv_clear(register SV *sv)
        break;
     case SVt_PVGV:
        del_XPVGV(SvANY(sv));
-       break;
+       /* code duplication for increased performance. */
+       SvFLAGS(sv) &= SVf_BREAK;
+       SvFLAGS(sv) |= SVTYPEMASK;
+       /* decrease refcount of the stash that owns this GV, if any */
+       if (stash)
+           SvREFCNT_dec(stash);
+       return; /* not break, SvFLAGS reset already happened */
     case SVt_PVBM:
        del_XPVBM(SvANY(sv));
        break;
@@ -3673,7 +3710,7 @@ sv_reset(register char *s, HV *stash)
 
     if (!*s) {         /* reset ?? searches */
        for (pm = HvPMROOT(stash); pm; pm = pm->op_pmnext) {
-           pm->op_pmflags &= ~PMf_USED;
+           pm->op_pmdynflags &= ~PMdf_USED;
        }
        return;
     }
@@ -4093,6 +4130,10 @@ sv_unglob(SV *sv)
     SvFAKE_off(sv);
     if (GvGP(sv))
        gp_free((GV*)sv);
+    if (GvSTASH(sv)) {
+       SvREFCNT_dec(GvSTASH(sv));
+       GvSTASH(sv) = Nullhv;
+    }
     sv_unmagic(sv, '*');
     Safefree(GvNAME(sv));
     GvMULTI_off(sv);
@@ -5007,7 +5048,8 @@ sv_dump(SV *sv)
     case SVt_PVGV:
        PerlIO_printf(Perl_debug_log, "  NAME = \"%s\"\n", GvNAME(sv));
        PerlIO_printf(Perl_debug_log, "  NAMELEN = %ld\n", (long)GvNAMELEN(sv));
-       PerlIO_printf(Perl_debug_log, "  STASH = \"%s\"\n", HvNAME(GvSTASH(sv)));
+       PerlIO_printf(Perl_debug_log, "  STASH = \"%s\"\n",
+           SvTYPE(GvSTASH(sv)) == SVt_PVHV ? HvNAME(GvSTASH(sv)) : "(deleted)");
        PerlIO_printf(Perl_debug_log, "  GP = 0x%lx\n", (long)GvGP(sv));
        PerlIO_printf(Perl_debug_log, "    SV = 0x%lx\n", (long)GvSV(sv));
        PerlIO_printf(Perl_debug_log, "    REFCNT = %ld\n", (long)GvREFCNT(sv));