Add a new Porting/podtidy to reformat pod using Pod::Tidy

[p5sagit/p5-mst-13.2.git] / op.c

diff --git a/op.c b/op.c
index 10c1fc9..d80aa95 100644 (file)
--- a/op.c
+++ b/op.c
@@ -785,8 +785,8 @@ Perl_op_refcnt_unlock(pTHX)
 
 #define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist((OP*)o))
 
-OP *
-Perl_linklist(pTHX_ OP *o)
+static OP *
+S_linklist(pTHX_ OP *o)
 {
     OP *first;
 
@@ -817,8 +817,8 @@ Perl_linklist(pTHX_ OP *o)
     return o->op_next;
 }
 
-OP *
-Perl_scalarkids(pTHX_ OP *o)
+static OP *
+S_scalarkids(pTHX_ OP *o)
 {
     if (o && o->op_flags & OPf_KIDS) {
         OP *kid;
@@ -1205,8 +1205,8 @@ Perl_scalarvoid(pTHX_ OP *o)
     return o;
 }
 
-OP *
-Perl_listkids(pTHX_ OP *o)
+static OP *
+S_listkids(pTHX_ OP *o)
 {
     if (o && o->op_flags & OPf_KIDS) {
         OP *kid;
@@ -1293,8 +1293,8 @@ Perl_list(pTHX_ OP *o)
     return o;
 }
 
-OP *
-Perl_scalarseq(pTHX_ OP *o)
+static OP *
+S_scalarseq(pTHX_ OP *o)
 {
     dVAR;
     if (o) {
@@ -1766,8 +1766,8 @@ S_is_handle_constructor(const OP *o, I32 numargs)
     }
 }
 
-OP *
-Perl_refkids(pTHX_ OP *o, I32 type)
+static OP *
+S_refkids(pTHX_ OP *o, I32 type)
 {
     if (o && o->op_flags & OPf_KIDS) {
         OP *kid;
@@ -2152,14 +2152,6 @@ Perl_my_attrs(pTHX_ OP *o, OP *attrs)
 }
 
 OP *
-Perl_my(pTHX_ OP *o)
-{
-    PERL_ARGS_ASSERT_MY;
-
-    return my_attrs(o, NULL);
-}
-
-OP *
 Perl_sawparens(pTHX_ OP *o)
 {
     PERL_UNUSED_CONTEXT;
@@ -2434,8 +2426,8 @@ Perl_jmaybe(pTHX_ OP *o)
     return o;
 }
 
-OP *
-Perl_fold_constants(pTHX_ register OP *o)
+static OP *
+S_fold_constants(pTHX_ register OP *o)
 {
     dVAR;
     register OP * VOL curop;
@@ -2575,8 +2567,8 @@ Perl_fold_constants(pTHX_ register OP *o)
     return o;
 }
 
-OP *
-Perl_gen_constant_list(pTHX_ register OP *o)
+static OP *
+S_gen_constant_list(pTHX_ register OP *o)
 {
     dVAR;
     register OP *curop;
@@ -2989,8 +2981,8 @@ Perl_newNULLLIST(pTHX)
     return newOP(OP_STUB, 0);
 }
 
-OP *
-Perl_force_list(pTHX_ OP *o)
+static OP *
+S_force_list(pTHX_ OP *o)
 {
     if (!o || o->op_type != OP_LIST)
        o = newLISTOP(OP_LIST, 0, o, NULL);
@@ -3127,8 +3119,8 @@ static int uvcompare(const void *a, const void *b)
     return 0;
 }
 
-OP *
-Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
+static OP *
+S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 {
     dVAR;
     SV * const tstr = ((SVOP*)expr)->op_sv;
@@ -7644,14 +7636,29 @@ OP *
 Perl_ck_return(pTHX_ OP *o)
 {
     dVAR;
+    OP *kid;
 
     PERL_ARGS_ASSERT_CK_RETURN;
 
+    kid = cLISTOPo->op_first->op_sibling;
     if (CvLVALUE(PL_compcv)) {
-        OP *kid;
-       for (kid = cLISTOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
+       for (; kid; kid = kid->op_sibling)
            mod(kid, OP_LEAVESUBLV);
+    } else {
+       for (; kid; kid = kid->op_sibling)
+           if ((kid->op_type == OP_NULL)
+               && ((kid->op_flags & (OPf_SPECIAL|OPf_KIDS)) == (OPf_SPECIAL|OPf_KIDS))) {
+               /* This is a do block */
+               OP *op = kUNOP->op_first;
+               if (op->op_type == OP_LEAVE && op->op_flags & OPf_KIDS) {
+                   op = cUNOPx(op)->op_first;
+                   assert(op->op_type == OP_ENTER && !(op->op_flags & OPf_SPECIAL));
+                   /* Force the use of the caller's context */
+                   op->op_flags |= OPf_SPECIAL;
+               }
+           }
     }
+
     return o;
 }