avoid infinite recursive exec()s of perl.exe when shebang

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

diff --git a/op.c b/op.c
index 3f5541c..788464f 100644 (file)
--- a/op.c
+++ b/op.c
@@ -96,9 +96,9 @@ S_bad_type(pTHX_ I32 n, char *t, char *name, OP *kid)
 STATIC void
 S_no_bareword_allowed(pTHX_ OP *o)
 {
-    Perl_warn(aTHX_ "Bareword \"%s\" not allowed while \"strict subs\" in use",
-         SvPV_nolen(cSVOPo->op_sv));
-    ++PL_error_count;
+    qerror(Perl_mess(aTHX_
+                    "Bareword \"%s\" not allowed while \"strict subs\" in use",
+                    SvPV_nolen(cSVOPo->op_sv)));
 }
 
 /* "register" allocation */
@@ -1267,19 +1267,19 @@ Perl_mod(pTHX_ OP *o, I32 type)
                    if (kid->op_type == OP_METHOD_NAMED
                        || kid->op_type == OP_METHOD)
                    {
-                       OP *new;
+                       OP *newop;
 
                        if (kid->op_sibling || kid->op_next != kid) {
                            yyerror("panic: unexpected optree near method call");
                            break;
                        }
                        
-                       NewOp(1101, new, 1, OP);
-                       new->op_type = OP_RV2CV;
-                       new->op_ppaddr = PL_ppaddr[OP_RV2CV];
-                       new->op_next = new;
-                       kid->op_sibling = new;
-                       new->op_private |= OPpLVAL_INTRO;
+                       NewOp(1101, newop, 1, OP);
+                       newop->op_type = OP_RV2CV;
+                       newop->op_ppaddr = PL_ppaddr[OP_RV2CV];
+                       newop->op_next = newop;
+                       kid->op_sibling = newop;
+                       newop->op_private |= OPpLVAL_INTRO;
                        break;
                    }
                    
@@ -5381,14 +5381,13 @@ Perl_ck_sassign(pTHX_ OP *o)
            && !(kkid->op_private & OPpLVAL_INTRO))
        {
            /* Concat has problems if target is equal to right arg. */
-           if (kid->op_type == OP_CONCAT
-               && kLISTOP->op_first->op_sibling->op_type == OP_PADSV
-               && kLISTOP->op_first->op_sibling->op_targ == kkid->op_targ)
-           {
-               return o;
+           if (kid->op_type == OP_CONCAT) {
+               if (kLISTOP->op_first->op_sibling->op_type == OP_PADSV
+                   && kLISTOP->op_first->op_sibling->op_targ == kkid->op_targ)
+                   return o;
            }
-           if (kid->op_type == OP_JOIN) {
-               /* do_join has problems the arguments coincide with target.
+           else if (kid->op_type == OP_JOIN) {
+               /* do_join has problems if the arguments coincide with target.
                   In fact the second argument *can* safely coincide,
                   but ignore=pessimize this rare occasion. */
                OP *arg = kLISTOP->op_first->op_sibling; /* Skip PUSHMARK */
@@ -5400,6 +5399,12 @@ Perl_ck_sassign(pTHX_ OP *o)
                    arg = arg->op_sibling;
                }
            }
+           else if (kid->op_type == OP_QUOTEMETA) {
+               /* quotemeta has problems if the argument coincides with target. */
+               if (kLISTOP->op_first->op_type == OP_PADSV
+                   && kLISTOP->op_first->op_targ == kkid->op_targ)
+                   return o;
+           }
            kid->op_targ = kkid->op_targ;
            /* Now we do not need PADSV and SASSIGN. */
            kid->op_sibling = o->op_sibling;    /* NULL */