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

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

diff --git a/toke.c b/toke.c
index 3c098a2..1691542 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -2425,8 +2425,24 @@ Perl_yylex(pTHX)
                 * Look for options.
                 */
                d = instr(s,"perl -");
-               if (!d)
+               if (!d) {
                    d = instr(s,"perl");
+#if defined(DOSISH)
+                   /* avoid getting into infinite loops when shebang
+                    * line contains "Perl" rather than "perl" */
+                   if (!d) {
+                       for (d = ipathend-4; d >= ipath; --d) {
+                           if ((*d == 'p' || *d == 'P')
+                               && !ibcmp(d, "perl", 4))
+                           {
+                               break;
+                           }
+                       }
+                       if (d < ipath)
+                           d = Nullch;
+                   }
+#endif
+               }
 #ifdef ALTERNATE_SHEBANG
                /*
                 * If the ALTERNATE_SHEBANG on this system starts with a
@@ -6897,7 +6913,6 @@ int
 Perl_yywarn(pTHX_ char *s)
 {
     dTHR;
-    --PL_error_count;
     PL_in_eval |= EVAL_WARNONLY;
     yyerror(s);
     PL_in_eval &= ~EVAL_WARNONLY;
@@ -6977,11 +6992,9 @@ PRId64 ")\n",
     }
     if (PL_in_eval & EVAL_WARNONLY)
        Perl_warn(aTHX_ "%_", msg);
-    else if (PL_in_eval)
-       sv_catsv(ERRSV, msg);
     else
-       PerlIO_write(PerlIO_stderr(), SvPVX(msg), SvCUR(msg));
-    if (++PL_error_count >= 10)
+       qerror(msg);
+    if (PL_error_count >= 10)
        Perl_croak(aTHX_ "%_ has too many errors.\n", GvSV(PL_curcop->cop_filegv));
     PL_in_my = 0;
     PL_in_my_stash = Nullhv;