diff options
Diffstat (limited to 'toke.c')
| -rw-r--r-- | toke.c | 86 |
1 files changed, 48 insertions, 38 deletions
@@ -20,6 +20,10 @@ static char ident_too_long[] = "Identifier too long"; +static void restore_rsfp(pTHXo_ void *f); +static void restore_expect(pTHXo_ void *e); +static void restore_lex_expect(pTHXo_ void *e); + #define UTF (PL_hints & HINT_UTF8) /* * Note: we try to be careful never to call the isXXX_utf8() functions @@ -282,12 +286,12 @@ Perl_lex_start(pTHX_ SV *line) SAVESPTR(PL_linestr); SAVEPPTR(PL_lex_brackstack); SAVEPPTR(PL_lex_casestack); - SAVEDESTRUCTOR(S_restore_rsfp, PL_rsfp); + SAVEDESTRUCTOR(restore_rsfp, PL_rsfp); SAVESPTR(PL_lex_stuff); SAVEI32(PL_lex_defer); SAVESPTR(PL_lex_repl); - SAVEDESTRUCTOR(S_restore_expect, PL_tokenbuf + PL_expect); /* encode as pointer */ - SAVEDESTRUCTOR(S_restore_lex_expect, PL_tokenbuf + PL_expect); + SAVEDESTRUCTOR(restore_expect, PL_tokenbuf + PL_expect); /* encode as pointer */ + SAVEDESTRUCTOR(restore_lex_expect, PL_tokenbuf + PL_expect); PL_lex_state = LEX_NORMAL; PL_lex_defer = 0; @@ -330,32 +334,6 @@ Perl_lex_end(pTHX) } STATIC void -S_restore_rsfp(pTHX_ void *f) -{ - PerlIO *fp = (PerlIO*)f; - - if (PL_rsfp == PerlIO_stdin()) - PerlIO_clearerr(PL_rsfp); - else if (PL_rsfp && (PL_rsfp != fp)) - PerlIO_close(PL_rsfp); - PL_rsfp = fp; -} - -STATIC void -S_restore_expect(pTHX_ void *e) -{ - /* a safe way to store a small integer in a pointer */ - PL_expect = (expectation)((char *)e - PL_tokenbuf); -} - -STATIC void -S_restore_lex_expect(pTHX_ void *e) -{ - /* a safe way to store a small integer in a pointer */ - PL_lex_expect = (expectation)((char *)e - PL_tokenbuf); -} - -STATIC void S_incline(pTHX_ char *s) { dTHR; @@ -463,7 +441,6 @@ STATIC void S_check_uni(pTHX) { char *s; - char ch; char *t; dTHR; @@ -475,7 +452,7 @@ S_check_uni(pTHX) if ((t = strchr(s, '(')) && t < PL_bufptr) return; if (ckWARN_d(WARN_AMBIGUOUS)){ - ch = *s; + char ch = *s; *s = '\0'; Perl_warner(aTHX_ WARN_AMBIGUOUS, "Warning: Use of \"%s\" without parens is ambiguous", @@ -3259,8 +3236,7 @@ Perl_yylex(pTHX) } safe_bareword: - if (lastchar && strchr("*%&", lastchar) && - ckWARN_d(WARN_AMBIGUOUS)) { + if (lastchar && strchr("*%&", lastchar) && ckWARN_d(WARN_AMBIGUOUS)) { Perl_warner(aTHX_ WARN_AMBIGUOUS, "Operator or semicolon missing before %c%s", lastchar, PL_tokenbuf); @@ -6000,10 +5976,10 @@ Perl_scan_num(pTHX_ char *start) we in octal/hex/binary?" indicator to disallow hex characters when in octal mode. */ + dTHR; UV u; I32 shift; bool overflowed = FALSE; - dTHR; /* check for hex */ if (s[1] == 'x') { @@ -6071,10 +6047,13 @@ Perl_scan_num(pTHX_ char *start) digit: n = u << shift; /* make room for the digit */ if (!overflowed && (n >> shift) != u - && !(PL_hints & HINT_NEW_BINARY) && ckWARN_d(WARN_UNSAFE)) { - Perl_warner(aTHX_ WARN_UNSAFE, "Integer overflow in %s number", - (shift == 4) ? "hex" - : ((shift == 3) ? "octal" : "binary")); + && !(PL_hints & HINT_NEW_BINARY)) + { + if (ckWARN_d(WARN_UNSAFE)) + Perl_warner(aTHX_ WARN_UNSAFE, + "Integer overflow in %s number", + (shift == 4) ? "hex" + : ((shift == 3) ? "octal" : "binary")); overflowed = TRUE; } u = n | b; /* add the digit to the end */ @@ -6431,3 +6410,34 @@ Perl_yyerror(pTHX_ char *s) } +#ifdef PERL_OBJECT +#define NO_XSLOCKS +#include "XSUB.h" +#endif + +static void +restore_rsfp(pTHXo_ void *f) +{ + PerlIO *fp = (PerlIO*)f; + + if (PL_rsfp == PerlIO_stdin()) + PerlIO_clearerr(PL_rsfp); + else if (PL_rsfp && (PL_rsfp != fp)) + PerlIO_close(PL_rsfp); + PL_rsfp = fp; +} + +static void +restore_expect(pTHXo_ void *e) +{ + /* a safe way to store a small integer in a pointer */ + PL_expect = (expectation)((char *)e - PL_tokenbuf); +} + +static void +restore_lex_expect(pTHXo_ void *e) +{ + /* a safe way to store a small integer in a pointer */ + PL_lex_expect = (expectation)((char *)e - PL_tokenbuf); +} + |