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 354b1d4..1691542 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -213,8 +213,12 @@ S_no_op(pTHX_ char *what, char *s)
     char *oldbp = PL_bufptr;
     bool is_first = (PL_oldbufptr == PL_linestart);
 
-    assert(s >= oldbp);
-    PL_bufptr = s;
+    if (!s)
+       s = oldbp;
+    else {
+       assert(s >= oldbp);
+       PL_bufptr = s;
+    }
     yywarn(Perl_form(aTHX_ "%s found where operator expected", what));
     if (is_first)
        Perl_warn(aTHX_ "\t(Missing semicolon on previous line?)\n");
@@ -2421,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
@@ -6619,7 +6639,7 @@ Perl_scan_num(pTHX_ char *start)
                sv_setnv(sv, n);
            }
            else {
-#if UV_SIZEOF > 4
+#if UVSIZE > 4
                dTHR;
                if (ckWARN(WARN_PORTABLE) && u > 0xffffffff)
                    Perl_warner(aTHX_ WARN_PORTABLE,
@@ -6893,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;
@@ -6973,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;