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 11e940b..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;
@@ -3451,6 +3443,15 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
            }
        }
     }
+
+    if(ckWARN(WARN_MISC)) {
+        if(del && rlen == tlen) {
+            Perl_warner(aTHX_ packWARN(WARN_MISC), "Useless use of /d modifier in transliteration operator"); 
+        } else if(rlen > tlen) {
+            Perl_warner(aTHX_ packWARN(WARN_MISC), "Replacement list is longer than search list");
+        } 
+    }
+
     if (grows)
        o->op_private |= OPpTRANS_GROWS;
 #ifdef PERL_MAD
@@ -5802,7 +5803,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        pp_entereval that it should not throw away any saved lines at scope
        exit.  */
        
-    PL_breakable_sub_generation++;
+    PL_breakable_sub_gen++;
     if (CvLVALUE(cv)) {
        CvROOT(cv) = newUNOP(OP_LEAVESUBLV, 0,
                             mod(scalarseq(block), OP_LEAVESUBLV));
@@ -7635,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;
 }