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 5a9c267..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
@@ -6517,7 +6537,7 @@ Perl_scan_num(pTHX_ char *start)
                s += 2;
            }
            /* check for a decimal in disguise */
-           else if (strchr(".Ee", s[1]))
+           else if (s[1] == '.' || s[1] == 'e' || s[1] == 'E')
                goto decimal;
            /* so it must be octal */
            else
@@ -6582,9 +6602,8 @@ Perl_scan_num(pTHX_ char *start)
                            dTHR;
                            overflowed = TRUE;
                            n = (NV) u;
-                           if (ckWARN_d(WARN_UNSAFE))
-                               Perl_warner(aTHX_ ((shift == 3) ?
-                                                  WARN_OCTAL : WARN_UNSAFE),
+                           if (ckWARN_d(WARN_OVERFLOW))
+                               Perl_warner(aTHX_ WARN_OVERFLOW,
                                            "Integer overflow in %s number",
                                            base);
                        } else
@@ -6613,17 +6632,17 @@ Perl_scan_num(pTHX_ char *start)
            sv = NEWSV(92,0);
            if (overflowed) {
                dTHR;
-               if (ckWARN(WARN_UNSAFE) && n > 4294967295.0)
-                   Perl_warner(aTHX_ WARN_UNSAFE,
+               if (ckWARN(WARN_PORTABLE) && n > 4294967295.0)
+                   Perl_warner(aTHX_ WARN_PORTABLE,
                                "%s number > %s non-portable",
                                Base, max);
                sv_setnv(sv, n);
            }
            else {
-#if UV_SIZEOF > 4
+#if UVSIZE > 4
                dTHR;
-               if (ckWARN(WARN_UNSAFE) && u > 0xffffffff)
-                   Perl_warner(aTHX_ WARN_UNSAFE,
+               if (ckWARN(WARN_PORTABLE) && u > 0xffffffff)
+                   Perl_warner(aTHX_ WARN_PORTABLE,
                                "%s number > %s non-portable",
                                Base, max);
 #endif
@@ -6894,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;
@@ -6974,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;