This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
make POPSUB and POPFORMAT re-entrant safe
authorDavid Mitchell <davem@iabyn.com>
Mon, 19 Oct 2015 15:12:33 +0000 (16:12 +0100)
committerDavid Mitchell <davem@iabyn.com>
Wed, 3 Feb 2016 09:18:30 +0000 (09:18 +0000)
In code like

    sub DESTROY { exit }
    sub f { push @_, bless [] }
    f()

While leaving f, POPSUB will attempt to clear @_. This triggers the
destructor, which calls exit, which unwinds the context stack, calling
POPSUB again on thr same context stack entry.

Thus we need to to be careful that POPSUB can be called multiple times
on the same CX stack entry.

The general way of doing this is to NULL or update pointers *before*
calling SvREFCNT_dec() on the old value.

This commit also removes the old CxPOPSUB_DONE mechanism which was a poor
bandaid added at the last minute to 5.22 to try and achieve the basics
of what this commit does comprehensively (hopefully). Also, CxPOPSUB_DONE
was mainly a protection against re-entrantly calling LEAVE_SCOPE(). Since
that's now done before POPSUB rather than in the middle of it, it has
become reentrant-safe by default.

cop.h
pp_hot.c
pp_sys.c

diff --git a/cop.h b/cop.h
index 8408e09..d0146ce 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -647,6 +647,7 @@ struct block_format {
     STMT_START {                                                       \
         AV *av = GvAV(PL_defgv);                                        \
        GvAV(PL_defgv) = cx->blk_sub.savearray;                         \
+        cx->blk_sub.savearray = NULL;                                   \
         SvREFCNT_dec(av);                                              \
     } STMT_END
 
@@ -663,10 +664,15 @@ struct block_format {
 /* subsets of POPSUB */
 
 #define POPSUB_COMMON(cx) \
-    PL_comppad = cx->blk_sub.prevcomppad;                               \
-    PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL;        \
-    CvDEPTH((const CV*)cx->blk_sub.cv) = cx->blk_sub.olddepth;          \
-    SvREFCNT_dec_NN(cx->blk_sub.cv);
+    STMT_START {                                                       \
+        CV *cv;                                                         \
+        PL_comppad = cx->blk_sub.prevcomppad;                           \
+        PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL;    \
+        cv = cx->blk_sub.cv;                                            \
+        CvDEPTH(cv) = cx->blk_sub.olddepth;                             \
+        cx->blk_sub.cv = NULL;                                          \
+        SvREFCNT_dec(cv);                                               \
+    } STMT_END
 
 /* handle the @_ part of leaving a sub */
 
@@ -688,8 +694,6 @@ struct block_format {
 
 #define POPSUB(cx)                                                     \
     STMT_START {                                                       \
-        if (!(cx->blk_u16 & CxPOPSUB_DONE)) {                           \
-        cx->blk_u16 |= CxPOPSUB_DONE;                                   \
        RETURN_PROBE(CvNAMED(cx->blk_sub.cv)                            \
                        ? HEK_KEY(CvNAME_HEK(cx->blk_sub.cv))           \
                        : GvENAME(CvGV(cx->blk_sub.cv)),                \
@@ -700,23 +704,22 @@ struct block_format {
        if (CxHASARGS(cx)) {                                            \
             POPSUB_ARGS(cx);                                            \
        }                                                               \
-        }                                                               \
         POPSUB_COMMON(cx);                                              \
     } STMT_END
 
 #define POPFORMAT(cx)                                                  \
     STMT_START {                                                       \
-        if (!(cx->blk_u16 & CxPOPSUB_DONE)) {                           \
-       CV * const cv = cx->blk_format.cv;                              \
-       GV * const dfuot = cx->blk_format.dfoutgv;                      \
-        cx->blk_u16 |= CxPOPSUB_DONE;                                   \
-       setdefout(dfuot);                                               \
+       CV *cv;                                                         \
+       GV * const dfout = cx->blk_format.dfoutgv;                      \
+       setdefout(dfout);                                               \
+        cx->blk_format.dfoutgv = NULL;                                  \
+       SvREFCNT_dec_NN(dfout); /* the cx->defoutgv ref */              \
         PL_comppad = cx->blk_format.prevcomppad;                        \
         PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL;    \
+        cv = cx->blk_format.cv;                                                \
+       cx->blk_format.cv = NULL;;                                      \
        --CvDEPTH(cv);                                                  \
-       SvREFCNT_dec_NN(cx->blk_format.cv);                             \
-       SvREFCNT_dec_NN(dfuot);                                         \
-        }                                                               \
+       SvREFCNT_dec_NN(cv);                                            \
     } STMT_END
 
 /* eval context */
@@ -803,8 +806,6 @@ struct block_loop {
 #define CxLABEL_len_flags(c,len,flags) (0 + CopLABEL_len_flags((c)->blk_oldcop, len, flags))
 #define CxHASARGS(c)   (((c)->cx_type & CXp_HASARGS) == CXp_HASARGS)
 #define CxLVAL(c)      (0 + ((c)->blk_u16 & 0xff))
-/* POPSUB has already been performed on this context frame */
-#define CxPOPSUB_DONE 0x100
 
 
 #define PUSHLOOP_PLAIN(cx)                                             \
index 5f0ef99..89f3bb8 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -3373,15 +3373,17 @@ Perl_clear_defarray(pTHX_ AV* av, bool abandon)
 
     PERL_ARGS_ASSERT_CLEAR_DEFARRAY;
 
-    if (LIKELY(!abandon && SvREFCNT(av) == 1 && !SvMAGICAL(av)))
+    if (LIKELY(!abandon && SvREFCNT(av) == 1 && !SvMAGICAL(av))) {
         av_clear(av);
+        AvREIFY_only(av);
+    }
     else {
+        AV *newav = newAV();
+        av_extend(newav, fill);
+        AvREIFY_only(newav);
+        PAD_SVl(0) = MUTABLE_SV(newav);
         SvREFCNT_dec_NN(av);
-        av = newAV();
-        PAD_SVl(0) = MUTABLE_SV(av);
-        av_extend(av, fill);
     }
-    AvREIFY_only(av);
 }
 
 
index 0792727..99f718e 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1292,10 +1292,13 @@ of the typeglob that C<PL_defoutgv> points to is decreased by one.
 void
 Perl_setdefout(pTHX_ GV *gv)
 {
+    GV *oldgv = PL_defoutgv;
+
     PERL_ARGS_ASSERT_SETDEFOUT;
+
     SvREFCNT_inc_simple_void_NN(gv);
-    SvREFCNT_dec(PL_defoutgv);
     PL_defoutgv = gv;
+    SvREFCNT_dec(oldgv);
 }
 
 PP(pp_select)