This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
make Perl_list() mostly non-recursive
authorDavid Mitchell <davem@iabyn.com>
Tue, 28 May 2019 09:57:46 +0000 (10:57 +0100)
committerDavid Mitchell <davem@iabyn.com>
Mon, 24 Jun 2019 10:40:06 +0000 (11:40 +0100)
Where it just recursively calls list() on all its children, instead
iteratively walk the sub-tree, using o->op_sibparent to work back
upwards.

Where it is more complex, such as OP_REPEAT imposing list context on its
first arg but not its second, recurse as before.

op.c
t/op/list.t

diff --git a/op.c b/op.c
index 823e48b..6547241 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2301,6 +2301,11 @@ S_listkids(pTHX_ OP *o)
 OP *
 Perl_list(pTHX_ OP *o)
 {
+    OP * top_op = o;
+
+    while (1) {
+    OP *next_kid = NULL; /* what op (if any) to process next */
+
     OP *kid;
 
     /* assumes no premature commitment */
@@ -2308,13 +2313,13 @@ Perl_list(pTHX_ OP *o)
         || (PL_parser && PL_parser->error_count)
         || o->op_type == OP_RETURN)
     {
-       return o;
+       goto do_next;
     }
 
     if ((o->op_private & OPpTARGET_MY)
        && (PL_opargs[o->op_type] & OA_TARGLEX))/* OPp share the meaning */
     {
-       return o;                               /* As if inside SASSIGN */
+       goto do_next;                           /* As if inside SASSIGN */
     }
 
     o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_LIST;
@@ -2341,8 +2346,8 @@ Perl_list(pTHX_ OP *o)
     case OP_OR:
     case OP_AND:
     case OP_COND_EXPR:
-       for (kid = OpSIBLING(cUNOPo->op_first); kid; kid = OpSIBLING(kid))
-           list(kid);
+        /* impose list context on everything except the condition */
+        next_kid = OpSIBLING(cUNOPo->op_first);
        break;
 
     default:
@@ -2352,9 +2357,9 @@ Perl_list(pTHX_ OP *o)
        if (!o->op_next && cUNOPo->op_first->op_type == OP_FLOP) {
            list(cBINOPo->op_first);
            gen_constant_list(o);
-           return o;
+           goto do_next;
        }
-       listkids(o);
+        next_kid = cUNOPo->op_first; /* do all kids */
        break;
 
     case OP_LIST:
@@ -2362,7 +2367,8 @@ Perl_list(pTHX_ OP *o)
            op_null(cUNOPo->op_first); /* NULL the pushmark */
            op_null(o); /* NULL the list */
        }
-       listkids(o);
+       if (o->op_flags & OPf_KIDS)
+            next_kid = cUNOPo->op_first; /* do all kids */
        break;
 
     /* the children of these ops are usually a list of statements,
@@ -2391,7 +2397,21 @@ Perl_list(pTHX_ OP *o)
 
     }
 
-    return o;
+    /* If next_kid is set, someone in the code above wanted us to process
+     * that kid and all its remaining siblings.  Otherwise, work our way
+     * back up the tree */
+  do_next:
+    while (!next_kid) {
+        if (o == top_op)
+            return top_op; /* at top; no parents/siblings to try */
+        if (OpHAS_SIBLING(o))
+            next_kid = o->op_sibparent;
+        else
+            o = o->op_sibparent; /*try parent's next sibling */
+
+    }
+    o = next_kid;
+    } /* while */
 }
 
 
index 2acb03a..30ec3d8 100644 (file)
@@ -6,7 +6,7 @@ BEGIN {
     set_up_inc(qw(. ../lib));
 }
 
-plan( tests => 72 );
+plan( tests => 73 );
 
 @foo = (1, 2, 3, 4);
 cmp_ok($foo[0], '==', 1, 'first elem');
@@ -268,3 +268,10 @@ q[ x
  ];
 }
 EOS
+
+# this used to SEGV due to deep recursion in Perl_list()
+
+{
+    my $e = "1"; $e = "(1,$e)" for 1..100_000; $e = "() = $e"; eval $e;
+    is $@, "", "SEGV in Perl_list";
+}