This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix pointer casts.
[perl5.git] / toke.c
diff --git a/toke.c b/toke.c
index c2d51ed..df965a3 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -717,7 +717,7 @@ S_force_next(pTHX_ I32 type)
  * it calls S_force_word to stick the next word into the PL_next lookahead.
  *
  * Arguments:
- *   char *start : start of the buffer
+ *   char *start : buffer position (must be within PL_linestr)
  *   int token   : PL_next will be this type of bare word (e.g., METHOD,WORD)
  *   int check_keyword : if true, Perl checks to make sure the word isn't
  *       a keyword (do this if the word is a label, e.g. goto FOO)
@@ -4504,6 +4504,7 @@ Perl_yylex(pTHX)
          really_sub:
            {
                char tmpbuf[sizeof PL_tokenbuf];
+               SSize_t tboffset;
                expectation attrful;
                bool have_name, have_proto;
                int key = tmp;
@@ -4515,6 +4516,8 @@ Perl_yylex(pTHX)
                {
                    PL_expect = XBLOCK;
                    attrful = XATTRBLOCK;
+                   /* remember buffer pos'n for later force_word */
+                   tboffset = s - PL_oldbufptr;
                    d = scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
                    if (strchr(tmpbuf, ':'))
                        sv_setpv(PL_subname, tmpbuf);
@@ -4539,7 +4542,8 @@ Perl_yylex(pTHX)
                    if (*s == '=')
                        PL_lex_formbrack = PL_lex_brackets + 1;
                    if (have_name)
-                       (void) force_word(tmpbuf, WORD, FALSE, TRUE, TRUE);
+                       (void) force_word(PL_oldbufptr + tboffset, WORD,
+                                         FALSE, TRUE, TRUE);
                    OPERATOR(FORMAT);
                }
 
@@ -4574,7 +4578,8 @@ Perl_yylex(pTHX)
                    PL_expect = attrful;
 
                if (have_proto) {
-                   PL_nextval[PL_nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, PL_lex_stuff);
+                   PL_nextval[PL_nexttoke].opval =
+                       (OP*)newSVOP(OP_CONST, 0, PL_lex_stuff);
                    PL_lex_stuff = Nullsv;
                    force_next(THING);
                }
@@ -4582,7 +4587,8 @@ Perl_yylex(pTHX)
                    sv_setpv(PL_subname,"__ANON__");
                    TOKEN(ANONSUB);
                }
-               (void) force_word(tmpbuf, WORD, FALSE, TRUE, TRUE);
+               (void) force_word(PL_oldbufptr + tboffset, WORD,
+                                 FALSE, TRUE, TRUE);
                if (key == KEY_my)
                    TOKEN(MYSUB);
                TOKEN(SUB);
@@ -6511,7 +6517,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
@@ -6576,9 +6582,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
@@ -6607,17 +6612,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