This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Perl_doref(): make non-recursive
authorDavid Mitchell <davem@iabyn.com>
Fri, 31 May 2019 10:58:11 +0000 (11:58 +0100)
committerDavid Mitchell <davem@iabyn.com>
Mon, 24 Jun 2019 10:40:07 +0000 (11:40 +0100)
This stops the following code from SEGVing for example:

    my $e = "\$r";
    $e = "+do{$e}" for 1..70_000;
    $e = "push \@{$e}, 1";
    eval $e;

Similarly with a long

    $a[0][0][0][0].....

This commit causes a slight change in behaviour, in that scalar(o)
is now only called once at the end of the top-level doref() call,
rather than at the end of processing each child. This should make no
functional difference, apart from speeding up compiling infinitesimally.

op.c

diff --git a/op.c b/op.c
index 19ba06b..bc0c3d1 100644 (file)
--- a/op.c
+++ b/op.c
@@ -4687,13 +4687,15 @@ OP *
 Perl_doref(pTHX_ OP *o, I32 type, bool set_op_ref)
 {
     dVAR;
-    OP *kid;
+    OP * top_op = o;
 
     PERL_ARGS_ASSERT_DOREF;
 
     if (PL_parser && PL_parser->error_count)
        return o;
 
+    while (1) {
+
     switch (o->op_type) {
     case OP_ENTERSUB:
        if ((type == OP_EXISTS || type == OP_DEFINED) &&
@@ -4713,13 +4715,12 @@ Perl_doref(pTHX_ OP *o, I32 type, bool set_op_ref)
        break;
 
     case OP_COND_EXPR:
-       for (kid = OpSIBLING(cUNOPo->op_first); kid; kid = OpSIBLING(kid))
-           doref(kid, type, set_op_ref);
-       break;
+       o = OpSIBLING(cUNOPo->op_first);
+       continue;
+
     case OP_RV2SV:
        if (type == OP_DEFINED)
            o->op_flags |= OPf_SPECIAL;         /* don't create GV */
-       doref(cUNOPo->op_first, o->op_type, set_op_ref);
        /* FALLTHROUGH */
     case OP_PADSV:
        if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) {
@@ -4728,6 +4729,11 @@ Perl_doref(pTHX_ OP *o, I32 type, bool set_op_ref)
                              : OPpDEREF_SV);
            o->op_flags |= OPf_MOD;
        }
+       if (o->op_flags & OPf_KIDS) {
+            type = o->op_type;
+            o = cUNOPo->op_first;
+            continue;
+        }
        break;
 
     case OP_RV2AV:
@@ -4738,8 +4744,9 @@ Perl_doref(pTHX_ OP *o, I32 type, bool set_op_ref)
     case OP_RV2GV:
        if (type == OP_DEFINED)
            o->op_flags |= OPf_SPECIAL;         /* don't create GV */
-       doref(cUNOPo->op_first, o->op_type, set_op_ref);
-       break;
+        type = o->op_type;
+       o = cUNOPo->op_first;
+       continue;
 
     case OP_PADAV:
     case OP_PADHV:
@@ -4751,18 +4758,20 @@ Perl_doref(pTHX_ OP *o, I32 type, bool set_op_ref)
     case OP_NULL:
        if (!(o->op_flags & OPf_KIDS) || type == OP_DEFINED)
            break;
-       doref(cBINOPo->op_first, type, set_op_ref);
-       break;
+        o = cBINOPo->op_first;
+       continue;
+
     case OP_AELEM:
     case OP_HELEM:
-       doref(cBINOPo->op_first, o->op_type, set_op_ref);
        if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) {
            o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV
                              : type == OP_RV2HV ? OPpDEREF_HV
                              : OPpDEREF_SV);
            o->op_flags |= OPf_MOD;
        }
-       break;
+        type = o->op_type;
+       o = cBINOPo->op_first;
+       continue;;
 
     case OP_SCOPE:
     case OP_LEAVE:
@@ -4772,15 +4781,31 @@ Perl_doref(pTHX_ OP *o, I32 type, bool set_op_ref)
     case OP_LIST:
        if (!(o->op_flags & OPf_KIDS))
            break;
-       doref(cLISTOPo->op_last, type, set_op_ref);
-       break;
+       o = cLISTOPo->op_last;
+       continue;
+
     default:
        break;
-    }
-    return scalar(o);
+    } /* switch */
 
+    while (1) {
+        if (o == top_op)
+            return scalar(top_op); /* at top; no parents/siblings to try */
+        if (OpHAS_SIBLING(o)) {
+            o = o->op_sibparent;
+            /* Normally skip all siblings and go straight to the parent;
+             * the only op that requires two children to be processed
+             * is OP_COND_EXPR */
+            if (!OpHAS_SIBLING(o) && o->op_sibparent->op_type == OP_COND_EXPR)
+                break;
+            continue;
+        }
+        o = o->op_sibparent; /*try parent's next sibling */
+    }
+    } /* while */
 }
 
+
 STATIC OP *
 S_dup_attrlist(pTHX_ OP *o)
 {