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);
#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
*
}
/*
- * 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);
-}
-
-static void
-S_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.
*/
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);
}
/*
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 */
}
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;
}
/* 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;
}
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();
}
}
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);
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);
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);
}
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 &");
}
}
/* 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:
}
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);
}
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);
}
}
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;
}
#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;
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) {
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;
}
if (*s == '_') {
- if (ckWARN(WARN_SYNTAX))
- Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
+ Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
"Misplaced _ in number");
lastub = s++;
}
/* _ 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;
&& !(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 */
}
/* 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);
}
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 {
/* 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
*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;
}
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
}
/* 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" */
/* 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++;
}
/* 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++;
}
}
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++;
}
}
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);
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
https://perl5.git.perl.org / perl5.git / blobdiff