In Perl_sv_del_backref(), don't panic if tsv is already freed.

[perl5.git] / sv.c

diff --git a/sv.c b/sv.c
index 068be55..f03f475 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -5571,6 +5571,30 @@ Perl_sv_del_backref(pTHX_ SV *const tsv, SV *const sv)
        if (SvOOK(tsv))
            svp = (SV**)Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(tsv));
     }
+    else if (SvIS_FREED(tsv) && PL_phase == PERL_PHASE_DESTRUCT) {
+       /* It's possible for the the last (strong) reference to tsv to have
+          become freed *before* the last thing holding a weak reference.
+          If both survive longer than the backreferences array, then when
+          the referent's reference count drops to 0 and it is freed, it's
+          not able to chase the backreferences, so they aren't NULLed.
+
+          For example, a CV holds a weak reference to its stash. If both the
+          CV and the stash survive longer than the backreferences array,
+          and the CV gets picked for the SvBREAK() treatment first,
+          *and* it turns out that the stash is only being kept alive because
+          of an our variable in the pad of the CV, then midway during CV
+          destruction the stash gets freed, but CvSTASH() isn't set to NULL.
+          It ends up pointing to the freed HV. Hence it's chased in here, and
+          if this block wasn't here, it would hit the !svp panic just below.
+
+          I don't believe that "better" destruction ordering is going to help
+          here - during global destruction there's always going to be the
+          chance that something goes out of order. We've tried to make it
+          foolproof before, and it only resulted in evolutionary pressure on
+          fools. Which made us look foolish for our hubris. :-(
+       */
+       return;
+    }
     else {
        MAGIC *const mg
            = SvMAGICAL(tsv) ? mg_find(tsv, PERL_MAGIC_backref) : NULL;
@@ -8387,22 +8411,24 @@ Perl_newSVpv(pTHX_ const char *const s, const STRLEN len)
 /*
 =for apidoc newSVpvn
 
-Creates a new SV and copies a string into it.  The reference count for the
-SV is set to 1.  Note that if C<len> is zero, Perl will create a zero length
-string.  You are responsible for ensuring that the source string is at least
-C<len> bytes long.  If the C<s> argument is NULL the new SV will be undefined.
+Creates a new SV and copies a buffer into it, which may contain NUL characters
+(C<\0>) and other binary data.  The reference count for the SV is set to 1.
+Note that if C<len> is zero, Perl will create a zero length (Perl) string.  You
+are responsible for ensuring that the source buffer is at least
+C<len> bytes long.  If the C<buffer> argument is NULL the new SV will be
+undefined.
 
 =cut
 */
 
 SV *
-Perl_newSVpvn(pTHX_ const char *const s, const STRLEN len)
+Perl_newSVpvn(pTHX_ const char *const buffer, const STRLEN len)
 {
     dVAR;
     register SV *sv;
 
     new_SV(sv);
-    sv_setpvn(sv,s,len);
+    sv_setpvn(sv,buffer,len);
     return sv;
 }
 
@@ -13081,10 +13107,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     PL_globhook                = proto_perl->Iglobhook;
 
-#ifdef THREADS_HAVE_PIDS
-    PL_ppid            = proto_perl->Ippid;
-#endif
-
     /* swatch cache */
     PL_last_swash_hv   = NULL; /* reinits on demand */
     PL_last_swash_klen = 0;
@@ -13398,6 +13420,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_PosixBlank      = sv_dup_inc(proto_perl->IPosixBlank, param);
     PL_XPosixBlank     = sv_dup_inc(proto_perl->IXPosixBlank, param);
 
+    PL_L1Cased         = sv_dup_inc(proto_perl->IL1Cased, param);
+
     PL_PosixCntrl      = sv_dup_inc(proto_perl->IPosixCntrl, param);
     PL_XPosixCntrl     = sv_dup_inc(proto_perl->IXPosixCntrl, param);
 
@@ -13406,8 +13430,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_L1PosixGraph    = sv_dup_inc(proto_perl->IL1PosixGraph, param);
     PL_PosixGraph      = sv_dup_inc(proto_perl->IPosixGraph, param);
 
-    PL_HorizSpace      = sv_dup_inc(proto_perl->IHorizSpace, param);
-
     PL_L1PosixLower    = sv_dup_inc(proto_perl->IL1PosixLower, param);
     PL_PosixLower      = sv_dup_inc(proto_perl->IPosixLower, param);
 
@@ -13463,6 +13485,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_utf8_idcont     = sv_dup_inc(proto_perl->Iutf8_idcont, param);
     PL_utf8_xidcont    = sv_dup_inc(proto_perl->Iutf8_xidcont, param);
     PL_utf8_foldable   = sv_dup_inc(proto_perl->Iutf8_foldable, param);
+    PL_utf8_quotemeta  = sv_dup_inc(proto_perl->Iutf8_quotemeta, param);
     PL_ASCII           = sv_dup_inc(proto_perl->IASCII, param);
     PL_AboveLatin1     = sv_dup_inc(proto_perl->IAboveLatin1, param);
     PL_Latin1          = sv_dup_inc(proto_perl->ILatin1, param);