X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/e37778c28ba4f7032e74888c10d3a8b367d2b4c4..e4d771f5006ebd70b76422437cce60e9ac40c830:/toke.c diff --git a/toke.c b/toke.c index c803a80..0b4ff5c 100644 --- a/toke.c +++ b/toke.c @@ -100,7 +100,6 @@ static int S_pending_ident(pTHX); static const char ident_too_long[] = "Identifier too long"; -static const char commaless_variable_list[] = "comma-less variable list"; #ifndef PERL_NO_UTF16_FILTER static I32 utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen); @@ -124,6 +123,9 @@ static I32 utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen); # define UTF ((PL_linestr && DO_UTF8(PL_linestr)) || (PL_hints & HINT_UTF8)) #endif +/* The maximum number of characters preceding the unrecognized one to display */ +#define UNRECOGNIZED_PRECEDE_COUNT 10 + /* In variables named $^X, these are the legal values for X. * 1999-02-27 mjd-perl-patch@plover.com */ #define isCONTROLVAR(x) (isUPPER(x) || strchr("[\\]^_?", (x))) @@ -448,6 +450,13 @@ S_printbuf(pTHX_ const char *const fmt, const char *const s) #endif +static int +S_deprecate_commaless_var_list(pTHX) { + PL_expect = XTERM; + deprecate("comma-less variable list"); + return REPORT(','); /* grandfather non-comma-format format */ +} + /* * S_ao * @@ -582,37 +591,6 @@ S_feature_is_enabled(pTHX_ const char *const name, STRLEN namelen) } /* - * Perl_deprecate - */ - -void -Perl_deprecate(pTHX_ const char *const s) -{ - PERL_ARGS_ASSERT_DEPRECATE; - - if (ckWARN(WARN_DEPRECATED)) - Perl_warner(aTHX_ packWARN(WARN_DEPRECATED), "Use of %s is deprecated", s); -} - -void -Perl_deprecate_old(pTHX_ const char *const s) -{ - /* This function should NOT be called for any new deprecated warnings */ - /* Use Perl_deprecate instead */ - /* */ - /* It is here to maintain backward compatibility with the pre-5.8 */ - /* warnings category hierarchy. The "deprecated" category used to */ - /* live under the "syntax" category. It is now a top-level category */ - /* in its own right. */ - - PERL_ARGS_ASSERT_DEPRECATE_OLD; - - if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)) - Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), - "Use of %s is deprecated", s); -} - -/* * experimental text filters for win32 carriage-returns, utf16-to-utf8 and * utf16-to-utf8-reversed. */ @@ -1216,11 +1194,9 @@ S_check_uni(pTHX) if ((t = strchr(s, '(')) && t < PL_bufptr) return; - if (ckWARN_d(WARN_AMBIGUOUS)){ - Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS), - "Warning: Use of \"%.*s\" without parentheses is ambiguous", - (int)(s - PL_last_uni), PL_last_uni); - } + Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS), + "Warning: Use of \"%.*s\" without parentheses is ambiguous", + (int)(s - PL_last_uni), PL_last_uni); } /* @@ -1381,7 +1357,9 @@ S_newSV_maybe_utf8(pTHX_ const char *const start, STRLEN len) { dVAR; SV * const sv = newSVpvn_utf8(start, len, - UTF && !IN_BYTES + !IN_BYTES + && UTF + && !is_ascii_string((const U8*)start, len) && is_utf8_string((const U8*)start, len)); return sv; } @@ -2188,9 +2166,9 @@ S_scan_const(pTHX_ char *start) if (!PL_lex_inpat) /* not a regexp, so $ must be var */ break; if (s + 1 < send && !strchr("()| \r\n\t", s[1])) { - if (s[1] == '\\' && ckWARN(WARN_AMBIGUOUS)) { - Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS), - "Possible unintended interpolation of $\\ in regex"); + if (s[1] == '\\') { + Perl_ck_warner(aTHX_ packWARN(WARN_AMBIGUOUS), + "Possible unintended interpolation of $\\ in regex"); } break; /* in regexp, $ might be tail anchor */ } @@ -2206,8 +2184,7 @@ S_scan_const(pTHX_ char *start) if (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat && isDIGIT(*s) && *s != '0' && !isDIGIT(s[1])) { - if (ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "\\%c better written as $%c", *s, *s); + Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "\\%c better written as $%c", *s, *s); *--s = '$'; break; } @@ -2235,11 +2212,10 @@ S_scan_const(pTHX_ char *start) /* FALL THROUGH */ default: { - if ((isALPHA(*s) || isDIGIT(*s)) && - ckWARN(WARN_MISC)) - Perl_warner(aTHX_ packWARN(WARN_MISC), - "Unrecognized escape \\%c passed through", - *s); + if ((isALPHA(*s) || isDIGIT(*s))) + Perl_ck_warner(aTHX_ packWARN(WARN_MISC), + "Unrecognized escape \\%c passed through", + *s); /* default action is to copy the quoted character */ goto default_action; } @@ -2821,7 +2797,7 @@ S_intuit_method(pTHX_ char *start, GV *gv, CV *cv) bare_package: start_force(PL_curforce); NEXTVAL_NEXTTOKE.opval = (OP*)newSVOP(OP_CONST, 0, - newSVpvn(tmpbuf,len)); + S_newSV_maybe_utf8(aTHX_ tmpbuf, len)); NEXTVAL_NEXTTOKE.opval->op_private = OPpCONST_BARE; if (PL_madskills) curmad('X', newSVpvn(start,SvPVX(PL_linestr) + soff - start)); @@ -3652,8 +3628,17 @@ Perl_yylex(pTHX) default: if (isIDFIRST_lazy_if(s,UTF)) goto keylookup; - len = UTF ? Perl_utf8_length(aTHX_ (U8 *) PL_linestart, (U8 *) s) : (STRLEN) (s - PL_linestart); - Perl_croak(aTHX_ "Unrecognized character \\x%02X in column %d", *s & 255, (int) len + 1); + { + unsigned char c = *s; + len = UTF ? Perl_utf8_length(aTHX_ (U8 *) PL_linestart, (U8 *) s) : (STRLEN) (s - PL_linestart); + if (len > UNRECOGNIZED_PRECEDE_COUNT) { + d = UTF ? (char *) Perl_utf8_hop(aTHX_ (U8 *) s, -UNRECOGNIZED_PRECEDE_COUNT) : s - UNRECOGNIZED_PRECEDE_COUNT; + } else { + d = PL_linestart; + } + *s = '\0'; + Perl_croak(aTHX_ "Unrecognized character \\x%02X; marked by <-- HERE after %s<-- HERE near column %d", c, d, (int) len + 1); + } case 4: case 26: goto fake_eof; /* emulate EOF on ^D or ^Z */ @@ -3958,7 +3943,7 @@ Perl_yylex(pTHX) while (s < PL_bufend && isSPACE(*s)) s++; if (s < PL_bufend) { - Newxz(newargv,PL_origargc+3,char*); + Newx(newargv,PL_origargc+3,char*); newargv[1] = s; while (s < PL_bufend && !isSPACE(*s)) s++; @@ -3987,7 +3972,14 @@ Perl_yylex(pTHX) const char *d1 = d; do { - if (*d1 == 'M' || *d1 == 'm' || *d1 == 'C') { + bool baduni = FALSE; + if (*d1 == 'C') { + const char *d2 = d1 + 1; + if (parse_unicode_opts((const char **)&d2) + != PL_unicode) + baduni = TRUE; + } + if (baduni || *d1 == 'M' || *d1 == 'm') { const char * const m = d1; while (*d1 && !isSPACE(*d1)) d1++; @@ -4793,10 +4785,6 @@ Perl_yylex(pTHX) pl_yylval.ival = 0; OPERATOR(ASSIGNOP); case '!': - if (PL_expect == XSTATE && s[1] == '!' && s[2] == '!') { - s += 3; - LOP(OP_DIE,XTERM); - } s++; { const char tmp = *s++; @@ -4866,9 +4854,7 @@ Perl_yylex(pTHX) if (PL_expect == XOPERATOR) { if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) { - PL_expect = XTERM; - deprecate_old(commaless_variable_list); - return REPORT(','); /* grandfather non-comma-format format */ + return deprecate_commaless_var_list(); } } @@ -5048,10 +5034,6 @@ Perl_yylex(pTHX) AOPERATOR(DORDOR); } case '?': /* may either be conditional or pattern */ - if (PL_expect == XSTATE && s[1] == '?' && s[2] == '?') { - s += 3; - LOP(OP_WARN,XTERM); - } if (PL_expect == XOPERATOR) { char tmp = *s++; if(tmp == '?') { @@ -5128,9 +5110,7 @@ Perl_yylex(pTHX) DEBUG_T( { printbuf("### Saw string before %s\n", s); } ); if (PL_expect == XOPERATOR) { if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) { - PL_expect = XTERM; - deprecate_old(commaless_variable_list); - return REPORT(','); /* grandfather non-comma-format format */ + return deprecate_commaless_var_list(); } else no_op("String",s); @@ -5145,9 +5125,7 @@ Perl_yylex(pTHX) DEBUG_T( { printbuf("### Saw string before %s\n", s); } ); if (PL_expect == XOPERATOR) { if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) { - PL_expect = XTERM; - deprecate_old(commaless_variable_list); - return REPORT(','); /* grandfather non-comma-format format */ + return deprecate_commaless_var_list(); } else no_op("String",s); @@ -5177,9 +5155,9 @@ Perl_yylex(pTHX) case '\\': s++; - if (PL_lex_inwhat && isDIGIT(*s) && ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ packWARN(WARN_SYNTAX),"Can't use \\%c to mean $%c in expression", - *s, *s); + if (PL_lex_inwhat && isDIGIT(*s)) + Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),"Can't use \\%c to mean $%c in expression", + *s, *s); if (PL_expect == XOPERATOR) no_op("Backslash",s); OPERATOR(REFGEN); @@ -5267,14 +5245,17 @@ Perl_yylex(pTHX) /* Is this a label? */ if (!tmp && PL_expect == XSTATE && d < PL_bufend && *d == ':' && *(d + 1) != ':') { + tmp = keyword(PL_tokenbuf, len, 0); + if (tmp) + Perl_croak(aTHX_ "Can't use keyword '%s' as a label", PL_tokenbuf); s = d + 1; pl_yylval.pval = CopLABEL_alloc(PL_tokenbuf); CLINE; TOKEN(LABEL); } - - /* Check for keywords */ - tmp = keyword(PL_tokenbuf, len, 0); + else + /* Check for keywords */ + tmp = keyword(PL_tokenbuf, len, 0); /* Is this a word before a => operator? */ if (*d == '=' && d[1] == '>') { @@ -5319,17 +5300,16 @@ Perl_yylex(pTHX) } else { /* no override */ tmp = -tmp; - if (tmp == KEY_dump && ckWARN(WARN_MISC)) { - Perl_warner(aTHX_ packWARN(WARN_MISC), - "dump() better written as CORE::dump()"); + if (tmp == KEY_dump) { + Perl_ck_warner(aTHX_ packWARN(WARN_MISC), + "dump() better written as CORE::dump()"); } gv = NULL; gvp = 0; - if (hgv && tmp != KEY_x && tmp != KEY_CORE - && ckWARN(WARN_AMBIGUOUS)) /* never ambiguous */ - Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS), - "Ambiguous call resolved as CORE::%s(), %s", - GvENAME(hgv), "qualify as such or use &"); + if (hgv && tmp != KEY_x && tmp != KEY_CORE) /* never ambiguous */ + Perl_ck_warner(aTHX_ packWARN(WARN_AMBIGUOUS), + "Ambiguous call resolved as CORE::%s(), %s", + GvENAME(hgv), "qualify as such or use &"); } } @@ -5569,10 +5549,10 @@ Perl_yylex(pTHX) /* Not a method, so call it a subroutine (if defined) */ if (cv) { - if (lastchar == '-' && ckWARN_d(WARN_AMBIGUOUS)) - Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS), - "Ambiguous use of -%s resolved as -&%s()", - PL_tokenbuf, PL_tokenbuf); + if (lastchar == '-') + Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS), + "Ambiguous use of -%s resolved as -&%s()", + PL_tokenbuf, PL_tokenbuf); /* Check for a constant sub */ if ((sv = gv_const_sv(gv))) { its_constant: @@ -5685,10 +5665,22 @@ Perl_yylex(pTHX) /* Call it a bare word */ - bareword: if (PL_hints & HINT_STRICT_SUBS) pl_yylval.opval->op_private |= OPpCONST_STRICT; else { + bareword: + /* after "print" and similar functions (corresponding to + * "F? L" in opcode.pl), whatever wasn't already parsed as + * a filehandle should be subject to "strict subs". + * Likewise for the optional indirect-object argument to system + * or exec, which can't be a bareword */ + if ((PL_last_lop_op == OP_PRINT + || PL_last_lop_op == OP_PRTF + || PL_last_lop_op == OP_SAY + || PL_last_lop_op == OP_SYSTEM + || PL_last_lop_op == OP_EXEC) + && (PL_hints & HINT_STRICT_SUBS)) + pl_yylval.opval->op_private |= OPpCONST_STRICT; if (lastchar != '-') { if (ckWARN(WARN_RESERVED)) { d = PL_tokenbuf; @@ -5702,14 +5694,13 @@ Perl_yylex(pTHX) } safe_bareword: - if ((lastchar == '*' || lastchar == '%' || lastchar == '&') - && ckWARN_d(WARN_AMBIGUOUS)) { - Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS), - "Operator or semicolon missing before %c%s", - lastchar, PL_tokenbuf); - Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS), - "Ambiguous use of %c resolved as operator %c", - lastchar, lastchar); + if ((lastchar == '*' || lastchar == '%' || lastchar == '&')) { + Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS), + "Operator or semicolon missing before %c%s", + lastchar, PL_tokenbuf); + Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS), + "Ambiguous use of %c resolved as operator %c", + lastchar, lastchar); } TOKEN(WORD); } @@ -6382,6 +6373,7 @@ Perl_yylex(pTHX) case KEY_package: s = force_word(s,WORD,FALSE,TRUE,FALSE); + s = force_version(s, FALSE); OPERATOR(PACKAGE); case KEY_pipe: @@ -7143,16 +7135,15 @@ S_pending_ident(pTHX) GV *const gv = gv_fetchpvn_flags(PL_tokenbuf + 1, tokenbuf_len - 1, 0, SVt_PVAV); if ((!gv || ((PL_tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv))) - && ckWARN(WARN_AMBIGUOUS) /* DO NOT warn for @- and @+ */ && !( PL_tokenbuf[2] == '\0' && ( PL_tokenbuf[1] == '-' || PL_tokenbuf[1] == '+' )) ) { /* Downgraded from fatal to warning 20000522 mjd */ - Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS), - "Possible unintended interpolation of %s in string", - PL_tokenbuf); + Perl_ck_warner(aTHX_ packWARN(WARN_AMBIGUOUS), + "Possible unintended interpolation of %s in string", + PL_tokenbuf); } } @@ -8693,8 +8684,7 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords) name[4] == 'i' && name[5] == 'f') { /* elseif */ - if(ckWARN_d(WARN_SYNTAX)) - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "elseif should be elsif"); + Perl_ck_warner_d(aTHX_ packWARN(WARN_SYNTAX), "elseif should be elsif"); } goto unknown; @@ -11019,11 +11009,10 @@ S_scan_pat(pTHX_ char *start, I32 type) } #endif /* issue a warning if /c is specified,but /g is not */ - if ((pm->op_pmflags & PMf_CONTINUE) && !(pm->op_pmflags & PMf_GLOBAL) - && ckWARN(WARN_REGEXP)) + if ((pm->op_pmflags & PMf_CONTINUE) && !(pm->op_pmflags & PMf_GLOBAL)) { - Perl_warner(aTHX_ packWARN(WARN_REGEXP), - "Use of /c modifier is meaningless without /g" ); + Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), + "Use of /c modifier is meaningless without /g" ); } PL_lex_op = (OP*)pm; @@ -11105,8 +11094,8 @@ S_scan_subst(pTHX_ char *start) PL_thismad = 0; } #endif - if ((pm->op_pmflags & PMf_CONTINUE) && ckWARN(WARN_REGEXP)) { - Perl_warner(aTHX_ packWARN(WARN_REGEXP), "Use of /c modifier is meaningless in s///" ); + if ((pm->op_pmflags & PMf_CONTINUE)) { + Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), "Use of /c modifier is meaningless in s///" ); } if (es) { @@ -11274,7 +11263,7 @@ S_scan_heredoc(pTHX_ register char *s) else term = '"'; if (!isALNUM_lazy_if(s,UTF)) - deprecate_old("bare << to mean <<\"\""); + deprecate("bare << to mean <<\"\""); for (; isALNUM_lazy_if(s,UTF); s++) { if (d < e) *d++ = *s; @@ -12118,8 +12107,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) } if (*s == '_') { - if (ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), + Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number"); lastub = s++; } @@ -12142,9 +12130,9 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) /* _ are ignored -- but warned about if consecutive */ case '_': - if (lastub && s == lastub + 1 && ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), - "Misplaced _ in number"); + if (lastub && s == lastub + 1) + Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), + "Misplaced _ in number"); lastub = s++; break; @@ -12186,10 +12174,9 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) && !(PL_hints & HINT_NEW_BINARY)) { overflowed = TRUE; n = (NV) u; - if (ckWARN_d(WARN_OVERFLOW)) - Perl_warner(aTHX_ packWARN(WARN_OVERFLOW), - "Integer overflow in %s number", - base); + Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW), + "Integer overflow in %s number", + base); } else u = x | b; /* add the digit to the end */ } @@ -12216,24 +12203,23 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) /* final misplaced underbar check */ if (s[-1] == '_') { - if (ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number"); + Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number"); } sv = newSV(0); if (overflowed) { - if (n > 4294967295.0 && ckWARN(WARN_PORTABLE)) - Perl_warner(aTHX_ packWARN(WARN_PORTABLE), - "%s number > %s non-portable", - Base, max); + if (n > 4294967295.0) + Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), + "%s number > %s non-portable", + Base, max); sv_setnv(sv, n); } else { #if UVSIZE > 4 - if (u > 0xffffffff && ckWARN(WARN_PORTABLE)) - Perl_warner(aTHX_ packWARN(WARN_PORTABLE), - "%s number > %s non-portable", - Base, max); + if (u > 0xffffffff) + Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), + "%s number > %s non-portable", + Base, max); #endif sv_setuv(sv, u); } @@ -12262,9 +12248,9 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) if -w is on */ if (*s == '_') { - if (lastub && s == lastub + 1 && ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), - "Misplaced _ in number"); + if (lastub && s == lastub + 1) + Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), + "Misplaced _ in number"); lastub = s++; } else { @@ -12278,8 +12264,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) /* final misplaced underbar check */ if (lastub && s == lastub + 1) { - if (ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number"); + Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number"); } /* read a decimal portion if there is one. avoid @@ -12291,9 +12276,8 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) *d++ = *s++; if (*s == '_') { - if (ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), - "Misplaced _ in number"); + Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), + "Misplaced _ in number"); lastub = s; } @@ -12304,9 +12288,9 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) if (d >= e) Perl_croak(aTHX_ number_too_long); if (*s == '_') { - if (lastub && s == lastub + 1 && ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), - "Misplaced _ in number"); + if (lastub && s == lastub + 1) + Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), + "Misplaced _ in number"); lastub = s; } else @@ -12314,9 +12298,8 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) } /* fractional part ending in underbar? */ if (s[-1] == '_') { - if (ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), - "Misplaced _ in number"); + Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), + "Misplaced _ in number"); } if (*s == '.' && isDIGIT(s[1])) { /* oops, it's really a v-string, but without the "v" */ @@ -12335,9 +12318,8 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) /* stray preinitial _ */ if (*s == '_') { - if (ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), - "Misplaced _ in number"); + Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), + "Misplaced _ in number"); lastub = s++; } @@ -12347,9 +12329,8 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) /* stray initial _ */ if (*s == '_') { - if (ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), - "Misplaced _ in number"); + Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), + "Misplaced _ in number"); lastub = s++; } @@ -12362,10 +12343,9 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) } else { if (((lastub && s == lastub + 1) || - (!isDIGIT(s[1]) && s[1] != '_')) - && ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), - "Misplaced _ in number"); + (!isDIGIT(s[1]) && s[1] != '_'))) + Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), + "Misplaced _ in number"); lastub = s++; } } @@ -12689,8 +12669,7 @@ Perl_yyerror(pTHX_ const char *const s) PL_multi_end = 0; } if (PL_in_eval & EVAL_WARNONLY) { - if (ckWARN_d(WARN_SYNTAX)) - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "%"SVf, SVfARG(msg)); + Perl_ck_warner_d(aTHX_ packWARN(WARN_SYNTAX), "%"SVf, SVfARG(msg)); } else qerror(msg); @@ -12933,9 +12912,9 @@ Perl_scan_vstring(pTHX_ const char *s, const char *const e, SV *sv) const UV orev = rev; rev += (*end - '0') * mult; mult *= 10; - if (orev > rev && ckWARN_d(WARN_OVERFLOW)) - Perl_warner(aTHX_ packWARN(WARN_OVERFLOW), - "Integer overflow in decimal number"); + if (orev > rev) + Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW), + "Integer overflow in decimal number"); } } #ifdef EBCDIC