utf8.c: Add functions for Turkic locale case changing

[perl5.git] / op.c

diff --git a/op.c b/op.c
index 8ed48b2..5774044 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)
 
@@ -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;