This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
make op.c:S_find_and_forget_pmops() non-recursive
authorDavid Mitchell <davem@iabyn.com>
Fri, 31 May 2019 15:53:42 +0000 (16:53 +0100)
committerDavid Mitchell <davem@iabyn.com>
Mon, 24 Jun 2019 10:40:07 +0000 (11:40 +0100)
For every CV that's freed which has a shared optree (e.g. a closure
or between threads), the whole optree is walked looking for PMOPs.
Make that walk non-recursive.

Contrived code that triggers a stack overflow:

{
    my $outer;
    my $e = 'sub { $outer && '
            . join('&&', ('$x') x 100_000)
            . " }";
    #print $e, "\n";
    eval $e;
}

Even after this commit, that code still SEGVs due to a separate stack
blow in Perl_rpeep().

op.c

diff --git a/op.c b/op.c
index 589f080..cdf6bc4 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1275,27 +1275,41 @@ S_forget_pmop(pTHX_ PMOP *const o)
        PL_curpm = NULL;
 }
 
+
 STATIC void
 S_find_and_forget_pmops(pTHX_ OP *o)
 {
+    OP* top_op = o;
+
     PERL_ARGS_ASSERT_FIND_AND_FORGET_PMOPS;
 
-    if (o->op_flags & OPf_KIDS) {
-        OP *kid = cUNOPo->op_first;
-       while (kid) {
-           switch (kid->op_type) {
-           case OP_SUBST:
-           case OP_SPLIT:
-           case OP_MATCH:
-           case OP_QR:
-               forget_pmop((PMOP*)kid);
-           }
-           find_and_forget_pmops(kid);
-           kid = OpSIBLING(kid);
-       }
+    while (1) {
+        switch (o->op_type) {
+        case OP_SUBST:
+        case OP_SPLIT:
+        case OP_MATCH:
+        case OP_QR:
+            forget_pmop((PMOP*)o);
+        }
+
+        if (o->op_flags & OPf_KIDS) {
+            o = cUNOPo->op_first;
+            continue;
+        }
+
+        while (1) {
+            if (o == top_op)
+                return; /* at top; no parents/siblings to try */
+            if (OpHAS_SIBLING(o)) {
+                o = o->op_sibparent; /* process next sibling */
+                break;
+            }
+            o = o->op_sibparent; /*try parent's next sibling */
+        }
     }
 }
 
+
 /*
 =for apidoc op_null