Add missing ARGS_ASSERT

[perl5.git] / op.c

diff --git a/op.c b/op.c
index 8ed48b2..11f84e7 100644 (file)
--- a/op.c
+++ b/op.c
@@ -190,6 +190,22 @@ static const char array_passed_to_stat[] = "Array passed to stat will be coerced
     } \
     defer_stack[++defer_ix] = o; \
   } STMT_END
+#define DEFER_REVERSE(count)                            \
+    STMT_START {                                        \
+        UV cnt = (count);                               \
+        if (cnt > 1) {                                  \
+            OP **top = defer_stack + defer_ix;          \
+            /* top - (cnt) + 1 isn't safe here */       \
+            OP **bottom = top - (cnt - 1);              \
+            OP *tmp;                                    \
+            assert(bottom >= defer_stack);              \
+            while (top > bottom) {                      \
+                tmp = *top;                             \
+                *top-- = *bottom;                       \
+                *bottom++ = tmp;                        \
+            }                                           \
+        }                                               \
+    } STMT_END;
 
 #define POP_DEFERRED_OP() (defer_ix >= 0 ? defer_stack[defer_ix--] : (OP *)NULL)
 
@@ -1426,8 +1442,7 @@ Perl_op_sibling_splice(OP *parent, OP *start, int del_count, OP* insert)
         OpMAYBESIB_set(start, insert, NULL);
     }
     else {
-        if (!parent)
-            goto no_parent;
+        assert(parent);
         cLISTOPx(parent)->op_first = insert;
         if (insert)
             parent->op_flags |= OPf_KIDS;
@@ -2634,6 +2649,7 @@ S_sprintf_is_multiconcatable(pTHX_ OP *o,struct sprintf_ismc_info *info)
 STATIC void
 S_maybe_multiconcat(pTHX_ OP *o)
 {
+    dVAR;
     OP *lastkidop;   /* the right-most of any kids unshifted onto o */
     OP *topop;       /* the top-most op in the concat tree (often equals o,
                         unless there are assign/stringify ops above it */
@@ -3459,39 +3475,47 @@ Perl_optimize_optree(pTHX_ OP* o)
 STATIC void
 S_optimize_op(pTHX_ OP* o)
 {
-    OP *kid;
+    dDEFER_OP;
 
     PERL_ARGS_ASSERT_OPTIMIZE_OP;
-    assert(o->op_type != OP_FREED);
+    do {
+        assert(o->op_type != OP_FREED);
 
-    switch (o->op_type) {
-    case OP_NEXTSTATE:
-    case OP_DBSTATE:
-       PL_curcop = ((COP*)o);          /* for warnings */
-       break;
+        switch (o->op_type) {
+        case OP_NEXTSTATE:
+        case OP_DBSTATE:
+            PL_curcop = ((COP*)o);             /* for warnings */
+            break;
 
 
-    case OP_CONCAT:
-    case OP_SASSIGN:
-    case OP_STRINGIFY:
-    case OP_SPRINTF:
-        S_maybe_multiconcat(aTHX_ o);
-        break;
+        case OP_CONCAT:
+        case OP_SASSIGN:
+        case OP_STRINGIFY:
+        case OP_SPRINTF:
+            S_maybe_multiconcat(aTHX_ o);
+            break;
 
-    case OP_SUBST:
-       if (cPMOPo->op_pmreplrootu.op_pmreplroot)
-           optimize_op(cPMOPo->op_pmreplrootu.op_pmreplroot);
-       break;
+        case OP_SUBST:
+            if (cPMOPo->op_pmreplrootu.op_pmreplroot)
+                DEFER_OP(cPMOPo->op_pmreplrootu.op_pmreplroot);
+            break;
 
-    default:
-       break;
-    }
+        default:
+            break;
+        }
 
-    if (!(o->op_flags & OPf_KIDS))
-        return;
+        if (o->op_flags & OPf_KIDS) {
+            OP *kid;
+            IV child_count = 0;
+            for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid)) {
+                DEFER_OP(kid);
+                ++child_count;
+            }
+            DEFER_REVERSE(child_count);
+        }
+    } while ( ( o = POP_DEFERRED_OP() ) );
 
-    for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid))
-        optimize_op(kid);
+    DEFER_OP_CLEANUP;
 }
 
 
@@ -3552,7 +3576,7 @@ For now it's static, but it may be exposed to the API in the future.
 */
 
 STATIC OP*
-S_traverse_op_tree(OP *top, OP *o) {
+S_traverse_op_tree(pTHX_ OP *top, OP *o) {
     OP *sib;
 
     PERL_ARGS_ASSERT_TRAVERSE_OP_TREE;
@@ -7798,6 +7822,7 @@ S_assignment_type(pTHX_ const OP *o)
 static OP *
 S_newONCEOP(pTHX_ OP *initop, OP *padop)
 {
+    dVAR;
     const PADOFFSET target = padop->op_targ;
     OP *const other = newOP(OP_PADSV,
                            padop->op_flags
@@ -17017,6 +17042,28 @@ const_av_xsub(pTHX_ CV* cv)
     XSRETURN(AvFILLp(av)+1);
 }
 
+/* Copy an existing cop->cop_warnings field.
+ * If it's one of the standard addresses, just re-use the address.
+ * This is the e implementation for the DUP_WARNINGS() macro
+ */
+
+STRLEN*
+Perl_dup_warnings(pTHX_ STRLEN* warnings)
+{
+    Size_t size;
+    STRLEN *new_warnings;
+
+    PERL_ARGS_ASSERT_DUP_WARNINGS;
+
+    if (specialWARN(warnings))
+        return warnings;
+
+    size = sizeof(*warnings) + *warnings;
+
+    new_warnings = (STRLEN*)PerlMemShared_malloc(size);
+    Copy(warnings, new_warnings, size, char);
+    return new_warnings;
+}
 
 /*
  * ex: set ts=8 sts=4 sw=4 et: