Mark all places where perl needs to look at a possibly-freed scalar
Nicholas Clark [Mon, 14 Nov 2005 22:31:14 +0000 (22:31 +0000)]
with a macro SvIS_FREED(sv)

p4raw-id: //depot/perl@26132

av.c
mg.c
op.c
pad.c
pp_hot.c
sv.h

diff --git a/av.c b/av.c
index df35b1a..5f9c092 100644 (file)
--- a/av.c
+++ b/av.c
@@ -244,7 +244,7 @@ Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval)
     }
     else if (AvREIFY(av)
             && (!AvARRAY(av)[key]      /* eg. @_ could have freed elts */
-                || SvTYPE(AvARRAY(av)[key]) == SVTYPEMASK)) {
+                || SvIS_FREED(AvARRAY(av)[key]))) {
        AvARRAY(av)[key] = &PL_sv_undef;        /* 1/2 reify */
        goto emptyness;
     }
diff --git a/mg.c b/mg.c
index 6d71b21..1423df0 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -2040,7 +2040,9 @@ Perl_magic_killbackrefs(pTHX_ SV *sv, MAGIC *mg)
     SV **svp = AvARRAY(av);
     PERL_UNUSED_ARG(sv);
 
-    if (svp) {
+    /* Not sure why the av can get freed ahead of its sv, but somehow it does
+       in ext/B/t/bytecode.t test 15 (involving print <DATA>)  */
+    if (svp && !SvIS_FREED(av)) {
        SV *const *const last = svp + AvFILLp(av);
 
        while (svp <= last) {
diff --git a/op.c b/op.c
index a3dee91..d9cb1d0 100644 (file)
--- a/op.c
+++ b/op.c
@@ -407,7 +407,7 @@ Perl_op_clear(pTHX_ OP *o)
 clear_pmop:
        {
            HV * const pmstash = PmopSTASH(cPMOPo);
-           if (pmstash && SvREFCNT(pmstash)) {
+           if (pmstash && !SvIS_FREED(pmstash)) {
                MAGIC * const mg = mg_find((SV*)pmstash, PERL_MAGIC_symtab);
                if (mg) {
                    PMOP *pmop = (PMOP*) mg->mg_obj;
diff --git a/pad.c b/pad.c
index cbc1cb5..df1b8f4 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -233,7 +233,7 @@ Perl_pad_undef(pTHX_ CV* cv)
 
     if (!padlist)
        return;
-    if (!SvREFCNT(CvPADLIST(cv))) /* may be during global destruction */
+    if (SvIS_FREED(padlist)) /* may be during global destruction */
        return;
 
     DEBUG_X(PerlIO_printf(Perl_debug_log,
index 24af67e..813b606 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1909,7 +1909,7 @@ PP(pp_iter)
        }
     }
 
-    if (sv && SvREFCNT(sv) == 0) {
+    if (sv && SvIS_FREED(sv)) {
        *itersvp = Nullsv;
        Perl_croak(aTHX_ "Use of freed value in iteration");
     }
diff --git a/sv.h b/sv.h
index 99cfe5a..f5a3125 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -185,6 +185,11 @@ perform the upgrade if necessary.  See C<svtype>.
 #define SVTYPEMASK     0xff
 #define SvTYPE(sv)     ((sv)->sv_flags & SVTYPEMASK)
 
+/* Sadly there are some parts of the core that have pointers to already-freed
+   SV heads, and rely on being able to tell that they are now free. So mark
+   them all by using a consistent macro.  */
+#define SvIS_FREED(sv) ((sv)->sv_flags == SVTYPEMASK)
+
 #define SvUPGRADE(sv, mt) (SvTYPE(sv) >= (mt) || (sv_upgrade(sv, mt), 1))
 
 #define SVs_PADSTALE   0x00000100      /* lexical has gone out of scope */