Perl_deprecate(pTHX_ char *s)
{
if (ckWARN(WARN_DEPRECATED))
- Perl_warner(aTHX_ WARN_DEPRECATED, "Use of %s is deprecated", s);
+ Perl_warner(aTHX_ packWARN(WARN_DEPRECATED), "Use of %s is deprecated", s);
+}
+
+void
+Perl_deprecate_old(pTHX_ char *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. */
+
+ if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX))
+ Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
+ "Use of %s is deprecated", s);
}
/*
STATIC void
S_depcom(pTHX)
{
- deprecate("comma-less variable list");
+ deprecate_old("comma-less variable list");
}
/*
if (ckWARN_d(WARN_AMBIGUOUS)){
char ch = *s;
*s = '\0';
- Perl_warner(aTHX_ WARN_AMBIGUOUS,
+ Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
"Warning: Use of \"%s\" without parens is ambiguous",
PL_last_uni);
*s = ch;
isDIGIT(*s) && *s != '0' && !isDIGIT(s[1]))
{
if (ckWARN(WARN_SYNTAX))
- Perl_warner(aTHX_ WARN_SYNTAX, "\\%c better written as $%c", *s, *s);
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "\\%c better written as $%c", *s, *s);
*--s = '$';
break;
}
if (ckWARN(WARN_MISC) &&
isALNUM(*s) &&
*s != '_')
- Perl_warner(aTHX_ WARN_MISC,
+ Perl_warner(aTHX_ packWARN(WARN_MISC),
"Unrecognized escape \\%c passed through",
*s);
/* default action is to copy the quoted character */
if (has_utf8)
sv_utf8_upgrade(res);
str = SvPV(res,len);
-#ifdef EBCDIC
+#ifdef EBCDIC_NEVER_MIND
+ /* charnames uses pack U and that has been
+ * recently changed to do the below uni->native
+ * mapping, so this would be redundant (and wrong,
+ * the code point would be doubly converted).
+ * But leave this in just in case the pack U change
+ * gets revoked, but the semantics is still
+ * desireable for charnames. --jhi */
{
UV uv = utf8_to_uvchr((U8*)str, 0);
SvPOK_on(sv);
if (PL_encoding && !has_utf8) {
- Perl_sv_recode_to_utf8(aTHX_ sv, PL_encoding);
+ sv_recode_to_utf8(sv, PL_encoding);
has_utf8 = TRUE;
}
if (has_utf8) {
}
}
if (PL_doextract) {
- if (*s == '#' && s[1] == '!' && instr(s,"perl"))
- PL_doextract = FALSE;
-
/* Incest with pod. */
if (*s == '=' && strnEQ(s, "=cut", 4)) {
sv_setpv(PL_linestr, "");
&& isIDFIRST_lazy_if(s,UTF) && PL_bufptr == PL_linestart)
{
CopLINE_dec(PL_curcop);
- Perl_warner(aTHX_ WARN_SEMICOLON, PL_warn_nosemi);
+ Perl_warner(aTHX_ packWARN(WARN_SEMICOLON), PL_warn_nosemi);
CopLINE_inc(PL_curcop);
}
BAop(OP_BIT_AND);
if (tmp == '~')
PMop(OP_MATCH);
if (ckWARN(WARN_SYNTAX) && tmp && isSPACE(*s) && strchr("+-*/%.^&|<",tmp))
- Perl_warner(aTHX_ WARN_SYNTAX, "Reversed %c= operator",(int)tmp);
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Reversed %c= operator",(int)tmp);
s--;
if (PL_expect == XSTATE && isALPHA(tmp) &&
(s == PL_linestart+1 || s[-2] == '\n') )
PL_bufptr = skipspace(PL_bufptr);
while (t < PL_bufend && *t != ']')
t++;
- Perl_warner(aTHX_ WARN_SYNTAX,
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"Multidimensional syntax %.*s not supported",
(t - PL_bufptr) + 1, PL_bufptr);
}
t = scan_word(t, tmpbuf, sizeof tmpbuf, TRUE, &len);
for (; isSPACE(*t); t++) ;
if (*t == ';' && get_cv(tmpbuf, FALSE))
- Perl_warner(aTHX_ WARN_SYNTAX,
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"You need to quote \"%s\"", tmpbuf);
}
}
if (*t == '}' || *t == ']') {
t++;
PL_bufptr = skipspace(PL_bufptr);
- Perl_warner(aTHX_ WARN_SYNTAX,
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"Scalar value %.*s better written as $%.*s",
t-PL_bufptr, PL_bufptr, t-PL_bufptr-1, PL_bufptr+1);
}
case '\\':
s++;
if (ckWARN(WARN_SYNTAX) && PL_lex_inwhat && isDIGIT(*s))
- Perl_warner(aTHX_ WARN_SYNTAX,"Can't use \\%c to mean $%c in expression",
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX),"Can't use \\%c to mean $%c in expression",
*s, *s);
if (PL_expect == XOPERATOR)
no_op("Backslash",s);
else { /* no override */
tmp = -tmp;
if (tmp == KEY_dump && ckWARN(WARN_MISC)) {
- Perl_warner(aTHX_ WARN_MISC,
+ Perl_warner(aTHX_ packWARN(WARN_MISC),
"dump() better written as CORE::dump()");
}
gv = Nullgv;
gvp = 0;
if (ckWARN(WARN_AMBIGUOUS) && hgv
&& tmp != KEY_x && tmp != KEY_CORE) /* never ambiguous */
- Perl_warner(aTHX_ WARN_AMBIGUOUS,
+ Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
"Ambiguous call resolved as CORE::%s(), %s",
GvENAME(hgv), "qualify as such or use &");
}
if (PL_expect == XOPERATOR) {
if (PL_bufptr == PL_linestart) {
CopLINE_dec(PL_curcop);
- Perl_warner(aTHX_ WARN_SEMICOLON, PL_warn_nosemi);
+ Perl_warner(aTHX_ packWARN(WARN_SEMICOLON), PL_warn_nosemi);
CopLINE_inc(PL_curcop);
}
else
PL_tokenbuf[len - 2] == ':' && PL_tokenbuf[len - 1] == ':')
{
if (ckWARN(WARN_BAREWORD) && ! gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVHV))
- Perl_warner(aTHX_ WARN_BAREWORD,
+ Perl_warner(aTHX_ packWARN(WARN_BAREWORD),
"Bareword \"%s\" refers to nonexistent package",
PL_tokenbuf);
len -= 2;
if (gv && GvCVu(gv)) {
CV* cv;
if (lastchar == '-' && ckWARN_d(WARN_AMBIGUOUS))
- Perl_warner(aTHX_ WARN_AMBIGUOUS,
+ Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
"Ambiguous use of -%s resolved as -&%s()",
PL_tokenbuf, PL_tokenbuf);
/* Check for a constant sub */
if (strEQ(proto, "$"))
OPERATOR(UNIOPSUB);
if (*proto == '&' && *s == '{') {
- sv_setpv(PL_subname,"__ANON__");
+ sv_setpv(PL_subname, PL_curstash ?
+ "__ANON__" : "__ANON__::__ANON__");
PREBLOCK(LSTOPSUB);
}
}
if (lastchar != '-') {
for (d = PL_tokenbuf; *d && isLOWER(*d); d++) ;
if (!*d && strNE(PL_tokenbuf,"main"))
- Perl_warner(aTHX_ WARN_RESERVED, PL_warn_reserved,
+ Perl_warner(aTHX_ packWARN(WARN_RESERVED), PL_warn_reserved,
PL_tokenbuf);
}
}
safe_bareword:
if (lastchar && strchr("*%&", lastchar) && ckWARN_d(WARN_AMBIGUOUS)) {
- Perl_warner(aTHX_ WARN_AMBIGUOUS,
+ Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
"Operator or semicolon missing before %c%s",
lastchar, PL_tokenbuf);
- Perl_warner(aTHX_ WARN_AMBIGUOUS,
+ Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
"Ambiguous use of %c resolved as operator %c",
lastchar, lastchar);
}
for (d = s; isALNUM_lazy_if(d,UTF); d++) ;
t = skipspace(d);
if (strchr("|&*+-=!?:.", *t) && ckWARN_d(WARN_PRECEDENCE))
- Perl_warner(aTHX_ WARN_PRECEDENCE,
+ Perl_warner(aTHX_ packWARN(WARN_PRECEDENCE),
"Precedence problem: open %.*s should be open(%.*s)",
d-s,s, d-s,s);
}
if (!warned && ckWARN(WARN_QW)) {
for (; !isSPACE(*d) && len; --len, ++d) {
if (*d == ',') {
- Perl_warner(aTHX_ WARN_QW,
+ Perl_warner(aTHX_ packWARN(WARN_QW),
"Possible attempt to separate words with commas");
++warned;
}
else if (*d == '#') {
- Perl_warner(aTHX_ WARN_QW,
+ Perl_warner(aTHX_ packWARN(WARN_QW),
"Possible attempt to put comments in qw() list");
++warned;
}
}
d[tmp] = '\0';
if (bad_proto && ckWARN(WARN_SYNTAX))
- Perl_warner(aTHX_ WARN_SYNTAX,
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"Illegal character in prototype for %s : %s",
SvPVX(PL_subname), d);
SvCUR(PL_lex_stuff) = tmp;
force_next(THING);
}
if (!have_name) {
- sv_setpv(PL_subname,"__ANON__");
+ sv_setpv(PL_subname,
+ PL_curstash ? "__ANON__" : "__ANON__::__ANON__");
TOKEN(ANONSUB);
}
(void) force_word(PL_oldbufptr + tboffset, WORD,
&& ckWARN(WARN_AMBIGUOUS))
{
/* Downgraded from fatal to warning 20000522 mjd */
- Perl_warner(aTHX_ WARN_AMBIGUOUS,
+ Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
"Possible unintended interpolation of %s in string",
PL_tokenbuf);
}
if (*w)
for (; *w && isSPACE(*w); w++) ;
if (!*w || !strchr(";|})]oaiuw!=", *w)) /* an advisory hack only... */
- Perl_warner(aTHX_ WARN_SYNTAX,
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"%s (...) interpreted as function",name);
}
}
if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) {
if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest)) {
const char *brack = *s == '[' ? "[...]" : "{...}";
- Perl_warner(aTHX_ WARN_AMBIGUOUS,
+ Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
"Ambiguous use of %c{%s%s} resolved to %c%s%s",
funny, dest, brack, funny, dest, brack);
}
if (ckWARN(WARN_AMBIGUOUS) &&
(keyword(dest, d - dest) || get_cv(dest, FALSE)))
{
- Perl_warner(aTHX_ WARN_AMBIGUOUS,
+ Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
"Ambiguous use of %c{%s} resolved to %c%s",
funny, dest, funny, dest);
}
else
term = '"';
if (!isALNUM_lazy_if(s,UTF))
- deprecate("bare << to mean <<\"\"");
+ deprecate_old("bare << to mean <<\"\"");
for (; isALNUM_lazy_if(s,UTF); s++) {
if (d < e)
*d++ = *s;
newUNOP(OP_RV2SV, 0,
newGVOP(OP_GV, 0, gv)));
}
- PL_lex_op->op_flags |= OPf_SPECIAL;
+ if (!readline_overriden)
+ PL_lex_op->op_flags |= OPf_SPECIAL;
/* we created the ops in PL_lex_op, so make yylval.ival a null op */
yylval.ival = OP_NULL;
}
if (*s == '_') {
if (ckWARN(WARN_SYNTAX))
- Perl_warner(aTHX_ WARN_SYNTAX,
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"Misplaced _ in number");
lastub = s++;
}
/* _ are ignored -- but warned about if consecutive */
case '_':
if (ckWARN(WARN_SYNTAX) && lastub && s == lastub + 1)
- Perl_warner(aTHX_ WARN_SYNTAX,
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"Misplaced _ in number");
lastub = s++;
break;
overflowed = TRUE;
n = (NV) u;
if (ckWARN_d(WARN_OVERFLOW))
- Perl_warner(aTHX_ WARN_OVERFLOW,
+ Perl_warner(aTHX_ packWARN(WARN_OVERFLOW),
"Integer overflow in %s number",
base);
} else
/* final misplaced underbar check */
if (s[-1] == '_') {
if (ckWARN(WARN_SYNTAX))
- Perl_warner(aTHX_ WARN_SYNTAX, "Misplaced _ in number");
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number");
}
sv = NEWSV(92,0);
if (overflowed) {
if (ckWARN(WARN_PORTABLE) && n > 4294967295.0)
- Perl_warner(aTHX_ WARN_PORTABLE,
+ Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
"%s number > %s non-portable",
Base, max);
sv_setnv(sv, n);
else {
#if UVSIZE > 4
if (ckWARN(WARN_PORTABLE) && u > 0xffffffff)
- Perl_warner(aTHX_ WARN_PORTABLE,
+ Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
"%s number > %s non-portable",
Base, max);
#endif
*/
if (*s == '_') {
if (ckWARN(WARN_SYNTAX) && lastub && s == lastub + 1)
- Perl_warner(aTHX_ WARN_SYNTAX,
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"Misplaced _ in number");
lastub = s++;
}
/* final misplaced underbar check */
if (lastub && s == lastub + 1) {
if (ckWARN(WARN_SYNTAX))
- Perl_warner(aTHX_ WARN_SYNTAX, "Misplaced _ in number");
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number");
}
/* read a decimal portion if there is one. avoid
if (*s == '_') {
if (ckWARN(WARN_SYNTAX))
- Perl_warner(aTHX_ WARN_SYNTAX,
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"Misplaced _ in number");
lastub = s;
}
Perl_croak(aTHX_ number_too_long);
if (*s == '_') {
if (ckWARN(WARN_SYNTAX) && lastub && s == lastub + 1)
- Perl_warner(aTHX_ WARN_SYNTAX,
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"Misplaced _ in number");
lastub = s;
}
/* fractional part ending in underbar? */
if (s[-1] == '_') {
if (ckWARN(WARN_SYNTAX))
- Perl_warner(aTHX_ WARN_SYNTAX,
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"Misplaced _ in number");
}
if (*s == '.' && isDIGIT(s[1])) {
/* stray preinitial _ */
if (*s == '_') {
if (ckWARN(WARN_SYNTAX))
- Perl_warner(aTHX_ WARN_SYNTAX,
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"Misplaced _ in number");
lastub = s++;
}
/* stray initial _ */
if (*s == '_') {
if (ckWARN(WARN_SYNTAX))
- Perl_warner(aTHX_ WARN_SYNTAX,
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"Misplaced _ in number");
lastub = s++;
}
if (ckWARN(WARN_SYNTAX) &&
((lastub && s == lastub + 1) ||
(!isDIGIT(s[1]) && s[1] != '_')))
- Perl_warner(aTHX_ WARN_SYNTAX,
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"Misplaced _ in number");
lastub = s++;
}
}
msg = sv_2mortal(newSVpv(s, 0));
Perl_sv_catpvf(aTHX_ msg, " at %s line %"IVdf", ",
- CopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
+ OutCopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
if (context)
Perl_sv_catpvf(aTHX_ msg, "near \"%.*s\"\n", contlen, context);
else
if (PL_error_count >= 10) {
if (PL_in_eval && SvCUR(ERRSV))
Perl_croak(aTHX_ "%"SVf"%s has too many errors.\n",
- ERRSV, CopFILE(PL_curcop));
+ ERRSV, OutCopFILE(PL_curcop));
else
Perl_croak(aTHX_ "%s has too many errors.\n",
- CopFILE(PL_curcop));
+ OutCopFILE(PL_curcop));
}
PL_in_my = 0;
PL_in_my_stash = Nullhv;
projects / p5sagit/p5-mst-13.2.git / blobdiff