return;
#ifdef DEBUGGING
if (SvTIED_mg((SV*)av, PERL_MAGIC_tied) && ckWARN_d(WARN_DEBUGGING))
- Perl_warner(aTHX_ WARN_DEBUGGING, "av_reify called on tied array");
+ Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "av_reify called on tied array");
#endif
key = AvMAX(av) + 1;
while (key > AvFILLp(av) + 1)
#ifdef DEBUGGING
if (SvREFCNT(av) == 0 && ckWARN_d(WARN_DEBUGGING)) {
- Perl_warner(aTHX_ WARN_DEBUGGING, "Attempt to clear deleted array");
+ Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "Attempt to clear deleted array");
}
#endif
if (!av)
if (*name == '\0') {
/* command is missing 19990114 */
if (ckWARN(WARN_PIPE))
- Perl_warner(aTHX_ WARN_PIPE, "Missing command in piped open");
+ Perl_warner(aTHX_ packWARN(WARN_PIPE), "Missing command in piped open");
errno = EPIPE;
goto say_false;
}
if (!num_svs && name[len-1] == '|') {
name[--len] = '\0' ;
if (ckWARN(WARN_PIPE))
- Perl_warner(aTHX_ WARN_PIPE, "Can't open bidirectional pipe");
+ Perl_warner(aTHX_ packWARN(WARN_PIPE), "Can't open bidirectional pipe");
}
mode[0] = 'w';
writing = 1;
if (*name == '\0') {
/* command is missing 19990114 */
if (ckWARN(WARN_PIPE))
- Perl_warner(aTHX_ WARN_PIPE, "Missing command in piped open");
+ Perl_warner(aTHX_ packWARN(WARN_PIPE), "Missing command in piped open");
errno = EPIPE;
goto say_false;
}
}
if (!fp) {
if (ckWARN(WARN_NEWLINE) && IoTYPE(io) == IoTYPE_RDONLY && strchr(name, '\n'))
- Perl_warner(aTHX_ WARN_NEWLINE, PL_warn_nl, "open");
+ Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
goto say_false;
}
if (ckWARN(WARN_IO)) {
if ((IoTYPE(io) == IoTYPE_RDONLY) &&
(fp == PerlIO_stdout() || fp == PerlIO_stderr())) {
- Perl_warner(aTHX_ WARN_IO,
+ Perl_warner(aTHX_ packWARN(WARN_IO),
"Filehandle STD%s opened only for input",
(fp == PerlIO_stdout()) ? "OUT" : "ERR");
}
else if ((IoTYPE(io) == IoTYPE_WRONLY) && fp == PerlIO_stdin()) {
- Perl_warner(aTHX_ WARN_IO,
+ Perl_warner(aTHX_ packWARN(WARN_IO),
"Filehandle STDIN opened only for output");
}
}
filegid = PL_statbuf.st_gid;
if (!S_ISREG(PL_filemode)) {
if (ckWARN_d(WARN_INPLACE))
- Perl_warner(aTHX_ WARN_INPLACE,
+ Perl_warner(aTHX_ packWARN(WARN_INPLACE),
"Can't do inplace edit: %s is not a regular file",
PL_oldname );
do_close(gv,FALSE);
)
{
if (ckWARN_d(WARN_INPLACE))
- Perl_warner(aTHX_ WARN_INPLACE,
+ Perl_warner(aTHX_ packWARN(WARN_INPLACE),
"Can't do inplace edit: %s would not be unique",
SvPVX(sv));
do_close(gv,FALSE);
#if !defined(DOSISH) && !defined(__CYGWIN__)
if (PerlLIO_rename(PL_oldname,SvPVX(sv)) < 0) {
if (ckWARN_d(WARN_INPLACE))
- Perl_warner(aTHX_ WARN_INPLACE,
+ Perl_warner(aTHX_ packWARN(WARN_INPLACE),
"Can't rename %s to %s: %s, skipping file",
PL_oldname, SvPVX(sv), Strerror(errno) );
do_close(gv,FALSE);
(void)UNLINK(SvPVX(sv));
if (link(PL_oldname,SvPVX(sv)) < 0) {
if (ckWARN_d(WARN_INPLACE))
- Perl_warner(aTHX_ WARN_INPLACE,
+ Perl_warner(aTHX_ packWARN(WARN_INPLACE),
"Can't rename %s to %s: %s, skipping file",
PL_oldname, SvPVX(sv), Strerror(errno) );
do_close(gv,FALSE);
# ifndef VMS /* Don't delete; use automatic file versioning */
if (UNLINK(PL_oldname) < 0) {
if (ckWARN_d(WARN_INPLACE))
- Perl_warner(aTHX_ WARN_INPLACE,
+ Perl_warner(aTHX_ packWARN(WARN_INPLACE),
"Can't remove %s: %s, skipping file",
PL_oldname, Strerror(errno) );
do_close(gv,FALSE);
#endif
{
if (ckWARN_d(WARN_INPLACE))
- Perl_warner(aTHX_ WARN_INPLACE, "Can't do inplace edit on %s: %s",
+ Perl_warner(aTHX_ packWARN(WARN_INPLACE), "Can't do inplace edit on %s: %s",
PL_oldname, Strerror(errno) );
do_close(gv,FALSE);
continue;
if (PerlLIO_stat(PL_oldname, &PL_statbuf) >= 0
&& !S_ISREG(PL_statbuf.st_mode))
{
- Perl_warner(aTHX_ WARN_INPLACE,
+ Perl_warner(aTHX_ packWARN(WARN_INPLACE),
"Can't do inplace edit: %s is not a regular file",
PL_oldname);
}
else
- Perl_warner(aTHX_ WARN_INPLACE, "Can't open %s: %s",
+ Perl_warner(aTHX_ packWARN(WARN_INPLACE), "Can't open %s: %s",
PL_oldname, Strerror(eno));
}
}
if (!sv_utf8_downgrade((sv = sv_mortalcopy(sv)), TRUE)
&& ckWARN_d(WARN_UTF8))
{
- Perl_warner(aTHX_ WARN_UTF8, "Wide character in print");
+ Perl_warner(aTHX_ packWARN(WARN_UTF8), "Wide character in print");
}
}
tmps = SvPV(sv, len);
PL_laststype = OP_STAT;
PL_laststatval = PerlLIO_stat(s, &PL_statcache);
if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(s, '\n'))
- Perl_warner(aTHX_ WARN_NEWLINE, PL_warn_nl, "stat");
+ Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat");
return PL_laststatval;
}
}
return PL_laststatval;
}
if (ckWARN(WARN_IO)) {
- Perl_warner(aTHX_ WARN_IO, "Use of -l on filehandle %s",
+ Perl_warner(aTHX_ packWARN(WARN_IO), "Use of -l on filehandle %s",
GvENAME(cGVOP_gv));
return (PL_laststatval = -1);
}
sv = POPs;
PUTBACK;
if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV && ckWARN(WARN_IO)) {
- Perl_warner(aTHX_ WARN_IO, "Use of -l on filehandle %s",
+ Perl_warner(aTHX_ packWARN(WARN_IO), "Use of -l on filehandle %s",
GvENAME((GV*) SvRV(sv)));
return (PL_laststatval = -1);
}
sv_setpv(PL_statname,SvPV(sv, n_a));
PL_laststatval = PerlLIO_lstat(SvPV(sv, n_a),&PL_statcache);
if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, n_a), '\n'))
- Perl_warner(aTHX_ WARN_NEWLINE, PL_warn_nl, "lstat");
+ Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "lstat");
return PL_laststatval;
}
else
PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv));
if (ckWARN(WARN_EXEC))
- Perl_warner(aTHX_ WARN_EXEC, "Can't exec \"%s\": %s",
+ Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
(really ? tmps : PL_Argv[0]), Strerror(errno));
if (do_report) {
int e = errno;
int e = errno;
if (ckWARN(WARN_EXEC))
- Perl_warner(aTHX_ WARN_EXEC, "Can't exec \"%s\": %s",
+ Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
PL_Argv[0], Strerror(errno));
if (do_report) {
PerlLIO_write(fd, (void*)&e, sizeof(int));
#ifdef UV_IS_QUAD
else if (size == 64) {
if (ckWARN(WARN_PORTABLE))
- Perl_warner(aTHX_ WARN_PORTABLE,
+ Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
"Bit vector size > 32 non-portable");
if (offset >= srclen)
retnum = 0;
#ifdef UV_IS_QUAD
else if (size == 64) {
if (ckWARN(WARN_PORTABLE))
- Perl_warner(aTHX_ WARN_PORTABLE,
+ Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
"Bit vector size > 32 non-portable");
retnum =
((UV) s[offset ] << 56) +
#ifdef UV_IS_QUAD
else if (size == 64) {
if (ckWARN(WARN_PORTABLE))
- Perl_warner(aTHX_ WARN_PORTABLE,
+ Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
"Bit vector size > 32 non-portable");
s[offset ] = (lval >> 56) & 0xff;
s[offset+1] = (lval >> 48) & 0xff;
{
if (!PL_op) {
if (ckWARN_d(WARN_DEBUGGING))
- Perl_warner(aTHX_ WARN_DEBUGGING, "NULL OP IN RUN");
+ Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
return 0;
}
HV* basestash = gv_stashsv(sv, FALSE);
if (!basestash) {
if (ckWARN(WARN_MISC))
- Perl_warner(aTHX_ WARN_MISC, "Can't locate package %s for @%s::ISA",
+ Perl_warner(aTHX_ packWARN(WARN_MISC), "Can't locate package %s for @%s::ISA",
SvPVX(sv), HvNAME(stash));
continue;
}
/* Adding a new symbol */
if (add & GV_ADDWARN && ckWARN_d(WARN_INTERNAL))
- Perl_warner(aTHX_ WARN_INTERNAL, "Had to create %s unexpectedly", nambeg);
+ Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "Had to create %s unexpectedly", nambeg);
gv_init(gv, stash, name, len, add & GV_ADDMULTI);
gv_init_sv(gv, sv_type);
#else
CopFILEGV(PL_curcop) = gv_fetchfile(file);
#endif
- Perl_warner(aTHX_ WARN_ONCE,
+ Perl_warner(aTHX_ packWARN(WARN_ONCE),
"Name \"%s::%s\" used only once: possible typo",
HvNAME(stash), GvNAME(gv));
}
return;
if (gp->gp_refcnt == 0) {
if (ckWARN_d(WARN_INTERNAL))
- Perl_warner(aTHX_ WARN_INTERNAL,
+ Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
"Attempt to free unreferenced glob pointers");
return;
}
if (str != save)
Safefree(str);
if (!found && ckWARN_d(WARN_INTERNAL))
- Perl_warner(aTHX_ WARN_INTERNAL, "Attempt to free non-existent shared string '%s'",str);
+ Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "Attempt to free non-existent shared string '%s'",str);
}
/* get a (constant) string ptr from the global string table
{
dTHX;
if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
- Perl_warner(aTHX_ WARN_MALLOC, "%s free() ignored (RMAGIC, PERL_CORE)",
+ Perl_warner(aTHX_ packWARN(WARN_MALLOC), "%s free() ignored (RMAGIC, PERL_CORE)",
ovp->ov_rmagic == RMAGIC - 1 ?
"Duplicate" : "Bad");
}
{
dTHX;
if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
- Perl_warner(aTHX_ WARN_MALLOC, "%s", "Bad free() ignored (PERL_CORE)");
+ Perl_warner(aTHX_ packWARN(WARN_MALLOC), "%s", "Bad free() ignored (PERL_CORE)");
}
#else
warn("%s", "Bad free() ignored");
{
dTHX;
if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
- Perl_warner(aTHX_ WARN_MALLOC, "%srealloc() %signored",
+ Perl_warner(aTHX_ packWARN(WARN_MALLOC), "%srealloc() %signored",
(ovp->ov_rmagic == RMAGIC - 1 ? "" : "Bad "),
ovp->ov_rmagic == RMAGIC - 1
? "of freed memory " : "");
{
dTHX;
if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
- Perl_warner(aTHX_ WARN_MALLOC, "%s",
+ Perl_warner(aTHX_ packWARN(WARN_MALLOC), "%s",
"Bad realloc() ignored");
}
#else
i = whichsig(s); /* ...no, a brick */
if (!i) {
if (ckWARN(WARN_SIGNAL))
- Perl_warner(aTHX_ WARN_SIGNAL, "No such signal: SIG%s", s);
+ Perl_warner(aTHX_ packWARN(WARN_SIGNAL), "No such signal: SIG%s", s);
return 0;
}
#if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS) || defined(FAKE_DEFAULT_SIGNAL_HANDLERS)
if (!cv || !CvROOT(cv)) {
if (ckWARN(WARN_SIGNAL))
- Perl_warner(aTHX_ WARN_SIGNAL, "SIG%s handler \"%s\" not defined.\n",
+ Perl_warner(aTHX_ packWARN(WARN_SIGNAL), "SIG%s handler \"%s\" not defined.\n",
PL_sig_name[sig], (gv ? GvENAME(gv)
: ((cv && CvGV(cv))
? GvENAME(CvGV(cv))
}
/* Bah. We're just overflowed. */
if (ckWARN_d(WARN_OVERFLOW))
- Perl_warner(aTHX_ WARN_OVERFLOW,
+ Perl_warner(aTHX_ packWARN(WARN_OVERFLOW),
"Integer overflow in binary number");
overflowed = TRUE;
value_nv = (NV) value;
goto redo;
}
if (ckWARN(WARN_DIGIT))
- Perl_warner(aTHX_ WARN_DIGIT,
+ Perl_warner(aTHX_ packWARN(WARN_DIGIT),
"Illegal binary digit '%c' ignored", *s);
break;
}
#endif
) {
if (ckWARN(WARN_PORTABLE))
- Perl_warner(aTHX_ WARN_PORTABLE,
+ Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
"Binary number > 0b11111111111111111111111111111111 non-portable");
}
*len_p = s - start;
}
/* Bah. We're just overflowed. */
if (ckWARN_d(WARN_OVERFLOW))
- Perl_warner(aTHX_ WARN_OVERFLOW,
+ Perl_warner(aTHX_ packWARN(WARN_OVERFLOW),
"Integer overflow in hexadecimal number");
overflowed = TRUE;
value_nv = (NV) value;
goto redo;
}
if (ckWARN(WARN_DIGIT))
- Perl_warner(aTHX_ WARN_DIGIT,
+ Perl_warner(aTHX_ packWARN(WARN_DIGIT),
"Illegal hexadecimal digit '%c' ignored", *s);
break;
}
#endif
) {
if (ckWARN(WARN_PORTABLE))
- Perl_warner(aTHX_ WARN_PORTABLE,
+ Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
"Hexadecimal number > 0xffffffff non-portable");
}
*len_p = s - start;
}
/* Bah. We're just overflowed. */
if (ckWARN_d(WARN_OVERFLOW))
- Perl_warner(aTHX_ WARN_OVERFLOW,
+ Perl_warner(aTHX_ packWARN(WARN_OVERFLOW),
"Integer overflow in octal number");
overflowed = TRUE;
value_nv = (NV) value;
* someone seems to want to use the digits eight and nine). */
if (digit == 8 || digit == 9) {
if (ckWARN(WARN_DIGIT))
- Perl_warner(aTHX_ WARN_DIGIT,
+ Perl_warner(aTHX_ packWARN(WARN_DIGIT),
"Illegal octal digit '%c' ignored", *s);
}
break;
#endif
) {
if (ckWARN(WARN_PORTABLE))
- Perl_warner(aTHX_ WARN_PORTABLE,
+ Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
"Octal number > 037777777777 non-portable");
}
*len_p = s - start;
|| ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash))
&& strEQ(name, SvPVX(sv)))
{
- Perl_warner(aTHX_ WARN_MISC,
+ Perl_warner(aTHX_ packWARN(WARN_MISC),
"\"%s\" variable %s masks earlier declaration in same %s",
(PL_in_my == KEY_our ? "our" : "my"),
name,
&& ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash)
&& strEQ(name, SvPVX(sv)))
{
- Perl_warner(aTHX_ WARN_MISC,
+ Perl_warner(aTHX_ packWARN(WARN_MISC),
"\"our\" variable %s redeclared", name);
- Perl_warner(aTHX_ WARN_MISC,
+ Perl_warner(aTHX_ packWARN(WARN_MISC),
"\t(Did you mean \"local\" instead of \"our\"?)\n");
break;
}
if (ckWARN(WARN_CLOSURE)
&& !CvUNIQUE(bcv) && !CvUNIQUE(cv))
{
- Perl_warner(aTHX_ WARN_CLOSURE,
+ Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
"Variable \"%s\" may be unavailable",
name);
}
if (ckWARN(WARN_CLOSURE) && !SvFAKE(sv) && !CvUNIQUE(cv)
&& !(SvFLAGS(sv) & SVpad_OUR))
{
- Perl_warner(aTHX_ WARN_CLOSURE,
+ Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
"Variable \"%s\" will not stay shared", name);
}
}
if (PL_min_intro_pending && fill < PL_min_intro_pending) {
for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
if ((sv = svp[off]) && sv != &PL_sv_undef && ckWARN_d(WARN_INTERNAL))
- Perl_warner(aTHX_ WARN_INTERNAL, "%s never introduced", SvPVX(sv));
+ Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "%s never introduced", SvPVX(sv));
}
}
/* "Deintroduce" my variables that are leaving with this scope. */
if (PL_copline != NOLINE)
CopLINE_set(PL_curcop, PL_copline);
- Perl_warner(aTHX_ WARN_SYNTAX, "Found = in conditional, should be ==");
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Found = in conditional, should be ==");
CopLINE_set(PL_curcop, oldline);
}
}
break;
case OP_SORT:
if (ckWARN(WARN_VOID))
- Perl_warner(aTHX_ WARN_VOID, "Useless use of sort in scalar context");
+ Perl_warner(aTHX_ packWARN(WARN_VOID), "Useless use of sort in scalar context");
}
return o;
}
break;
}
if (useless && ckWARN(WARN_VOID))
- Perl_warner(aTHX_ WARN_VOID, "Useless use of %s in void context", useless);
+ Perl_warner(aTHX_ packWARN(WARN_VOID), "Useless use of %s in void context", useless);
return o;
}
const char *sample = ((left->op_type == OP_RV2AV ||
left->op_type == OP_PADAV)
? "@array" : "%hash");
- Perl_warner(aTHX_ WARN_MISC,
+ Perl_warner(aTHX_ packWARN(WARN_MISC),
"Applying %s to %s will act on scalar(%s)",
desc, sample, sample);
}
s++;
if (*s == ';' || *s == '=')
- Perl_warner(aTHX_ WARN_PARENTHESIS,
+ Perl_warner(aTHX_ packWARN(WARN_PARENTHESIS),
"Parentheses missing around \"%s\" list",
lex ? (PL_in_my == KEY_our ? "our" : "my") : "local");
}
op_free(o);
}
else {
- deprecate_old("\"package\" with no arguments");
+ deprecate("\"package\" with no arguments");
sv_setpv(PL_curstname,"<none>");
PL_curstash = Nullhv;
}
}
if (first->op_type == OP_CONST) {
if (ckWARN(WARN_BAREWORD) && (first->op_private & OPpCONST_BARE))
- Perl_warner(aTHX_ WARN_BAREWORD, "Bareword found in conditional");
+ Perl_warner(aTHX_ packWARN(WARN_BAREWORD), "Bareword found in conditional");
if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
op_free(first);
*firstp = Nullop;
if (warnop) {
line_t oldline = CopLINE(PL_curcop);
CopLINE_set(PL_curcop, PL_copline);
- Perl_warner(aTHX_ WARN_MISC,
+ Perl_warner(aTHX_ packWARN(WARN_MISC),
"Value of %s%s can be \"0\"; test with defined()",
PL_op_desc[warnop],
((warnop == OP_READLINE || warnop == OP_GLOB)
Perl_sv_catpvf(aTHX_ msg, "(%s)", p);
else
sv_catpv(msg, "none");
- Perl_warner(aTHX_ WARN_PROTOTYPE, "%"SVf, msg);
+ Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE), "%"SVf, msg);
}
}
if (!SvPOK((SV*)gv) && !(SvIOK((SV*)gv) && SvIVX((SV*)gv) == -1)
&& ckWARN_d(WARN_PROTOTYPE))
{
- Perl_warner(aTHX_ WARN_PROTOTYPE, "Runaway prototype");
+ Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE), "Runaway prototype");
}
cv_ckproto((CV*)gv, NULL, ps);
}
line_t oldline = CopLINE(PL_curcop);
if (PL_copline != NOLINE)
CopLINE_set(PL_curcop, PL_copline);
- Perl_warner(aTHX_ WARN_REDEFINE,
+ Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
CvCONST(cv) ? "Constant subroutine %s redefined"
: "Subroutine %s redefined", name);
CopLINE_set(PL_curcop, oldline);
PL_checkav = newAV();
DEBUG_x( dump_sub(gv) );
if (PL_main_start && ckWARN(WARN_VOID))
- Perl_warner(aTHX_ WARN_VOID, "Too late to run CHECK block");
+ Perl_warner(aTHX_ packWARN(WARN_VOID), "Too late to run CHECK block");
av_unshift(PL_checkav, 1);
av_store(PL_checkav, 0, (SV*)cv);
GvCV(gv) = 0; /* cv has been hijacked */
PL_initav = newAV();
DEBUG_x( dump_sub(gv) );
if (PL_main_start && ckWARN(WARN_VOID))
- Perl_warner(aTHX_ WARN_VOID, "Too late to run INIT block");
+ Perl_warner(aTHX_ packWARN(WARN_VOID), "Too late to run INIT block");
av_push(PL_initav, (SV*)cv);
GvCV(gv) = 0; /* cv has been hijacked */
}
line_t oldline = CopLINE(PL_curcop);
if (PL_copline != NOLINE)
CopLINE_set(PL_curcop, PL_copline);
- Perl_warner(aTHX_ WARN_REDEFINE,
+ Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
CvCONST(cv) ? "Constant subroutine %s redefined"
: "Subroutine %s redefined"
,name);
if (!PL_checkav)
PL_checkav = newAV();
if (PL_main_start && ckWARN(WARN_VOID))
- Perl_warner(aTHX_ WARN_VOID, "Too late to run CHECK block");
+ Perl_warner(aTHX_ packWARN(WARN_VOID), "Too late to run CHECK block");
av_unshift(PL_checkav, 1);
av_store(PL_checkav, 0, (SV*)cv);
GvCV(gv) = 0; /* cv has been hijacked */
if (!PL_initav)
PL_initav = newAV();
if (PL_main_start && ckWARN(WARN_VOID))
- Perl_warner(aTHX_ WARN_VOID, "Too late to run INIT block");
+ Perl_warner(aTHX_ packWARN(WARN_VOID), "Too late to run INIT block");
av_push(PL_initav, (SV*)cv);
GvCV(gv) = 0; /* cv has been hijacked */
}
line_t oldline = CopLINE(PL_curcop);
if (PL_copline != NOLINE)
CopLINE_set(PL_curcop, PL_copline);
- Perl_warner(aTHX_ WARN_REDEFINE, "Format %s redefined",name);
+ Perl_warner(aTHX_ packWARN(WARN_REDEFINE), "Format %s redefined",name);
CopLINE_set(PL_curcop, oldline);
}
SvREFCNT_dec(cv);
default:
if (ckWARN_d(WARN_INTERNAL))
- Perl_warner(aTHX_ WARN_INTERNAL, "oops: oopsAV");
+ Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "oops: oopsAV");
break;
}
return o;
default:
if (ckWARN_d(WARN_INTERNAL))
- Perl_warner(aTHX_ WARN_INTERNAL, "oops: oopsHV");
+ Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "oops: oopsHV");
break;
}
return o;
return o;
}
else if ((o->op_type == OP_RV2AV || o->op_type == OP_PADAV)
- && ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)) {
- Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
+ && ckWARN(WARN_DEPRECATED)) {
+ Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
"Using an array as a reference is deprecated");
}
return newUNOP(OP_RV2AV, 0, scalar(o));
return o;
}
else if ((o->op_type == OP_RV2HV || o->op_type == OP_PADHV)
- && ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)) {
- Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
+ && ckWARN(WARN_DEPRECATED)) {
+ Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
"Using a hash as a reference is deprecated");
}
return newUNOP(OP_RV2HV, 0, scalar(o));
case OA_AVREF:
if ((type == OP_PUSH || type == OP_UNSHIFT)
&& !kid->op_sibling && ckWARN(WARN_SYNTAX))
- Perl_warner(aTHX_ WARN_SYNTAX,
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"Useless use of %s with no values",
PL_op_desc[type]);
char *pmstr = "STRING";
if (PM_GETRE(kPMOP))
pmstr = PM_GETRE(kPMOP)->precomp;
- Perl_warner(aTHX_ WARN_SYNTAX,
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"/%s/ should probably be written as \"%s\"",
pmstr, pmstr);
}
/* XXX could check prototype here instead of just carping */
SV *sv = sv_newmortal();
gv_efullname3(sv, gv, Nullch);
- Perl_warner(aTHX_ WARN_PROTOTYPE,
+ Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE),
"%s() called too early to check prototype",
SvPV_nolen(sv));
}
line_t oldline = CopLINE(PL_curcop);
CopLINE_set(PL_curcop, CopLINE((COP*)o->op_next));
- Perl_warner(aTHX_ WARN_EXEC,
+ Perl_warner(aTHX_ packWARN(WARN_EXEC),
"Statement unlikely to be reached");
- Perl_warner(aTHX_ WARN_EXEC,
+ Perl_warner(aTHX_ packWARN(WARN_EXEC),
"\t(Maybe you meant system() when you said exec()?)\n");
CopLINE_set(PL_curcop, oldline);
}
FREETMPS;
if (destruct_level >= 2 && ckWARN_d(WARN_INTERNAL)) {
if (PL_scopestack_ix != 0)
- Perl_warner(aTHX_ WARN_INTERNAL,
+ Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
"Unbalanced scopes: %ld more ENTERs than LEAVEs\n",
(long)PL_scopestack_ix);
if (PL_savestack_ix != 0)
- Perl_warner(aTHX_ WARN_INTERNAL,
+ Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
"Unbalanced saves: %ld more saves than restores\n",
(long)PL_savestack_ix);
if (PL_tmps_floor != -1)
- Perl_warner(aTHX_ WARN_INTERNAL,"Unbalanced tmps: %ld more allocs than frees\n",
+ Perl_warner(aTHX_ packWARN(WARN_INTERNAL),"Unbalanced tmps: %ld more allocs than frees\n",
(long)PL_tmps_floor + 1);
if (cxstack_ix != -1)
- Perl_warner(aTHX_ WARN_INTERNAL,"Unbalanced context: %ld more PUSHes than POPs\n",
+ Perl_warner(aTHX_ packWARN(WARN_INTERNAL),"Unbalanced context: %ld more PUSHes than POPs\n",
(long)cxstack_ix + 1);
}
hent = array[0];
for (;;) {
if (hent && ckWARN_d(WARN_INTERNAL)) {
- Perl_warner(aTHX_ WARN_INTERNAL,
+ Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
"Unbalanced string table refcount: (%d) for \"%s\"",
HeVAL(hent) - Nullsv, HeKEY(hent));
HeVAL(hent) = Nullsv;
SvREADONLY_off(&PL_sv_undef);
if (PL_sv_count != 0 && ckWARN_d(WARN_INTERNAL))
- Perl_warner(aTHX_ WARN_INTERNAL,"Scalars leaked: %ld\n", (long)PL_sv_count);
+ Perl_warner(aTHX_ packWARN(WARN_INTERNAL),"Scalars leaked: %ld\n", (long)PL_sv_count);
#if defined(PERLIO_LAYERS)
/* No more IO - including error messages ! */
Sighandler_t sigstate = rsignal_state(SIGCHLD);
if (sigstate == SIG_IGN) {
if (ckWARN(WARN_SIGNAL))
- Perl_warner(aTHX_ WARN_SIGNAL,
+ Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
"Can't ignore signal CHLD, forcing to default");
(void)rsignal(SIGCHLD, (Sighandler_t)SIG_DFL);
}
PL_debug |= DEBUG_TOP_FLAG;
#else
if (ckWARN_d(WARN_DEBUGGING))
- Perl_warner(aTHX_ WARN_DEBUGGING,
+ Perl_warner(aTHX_ packWARN(WARN_DEBUGGING),
"Recompile perl with -DDEBUGGING to use -D switch\n");
for (s++; isALNUM(*s); s++) ;
#endif
Perl_croak(aTHX_ "Attempt to bless into a reference");
ptr = SvPV(ssv,len);
if (ckWARN(WARN_MISC) && len == 0)
- Perl_warner(aTHX_ WARN_MISC,
+ Perl_warner(aTHX_ packWARN(WARN_MISC),
"Explicit blessing to '' (assuming package main)");
stash = gv_stashpvn(ptr, len, TRUE);
}
case 'F':
if (strEQ(elem, "FILEHANDLE")) {
/* finally deprecated in 5.8.0 */
- deprecate_old("*glob{FILEHANDLE}");
+ deprecate("*glob{FILEHANDLE}");
tmpRef = (SV*)GvIOp(gv);
}
else
break;
case SVt_PVCV:
if (ckWARN(WARN_MISC) && cv_const_sv((CV*)sv))
- Perl_warner(aTHX_ WARN_MISC, "Constant subroutine %s undefined",
+ Perl_warner(aTHX_ packWARN(WARN_MISC), "Constant subroutine %s undefined",
CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv)));
/* FALL THROUGH */
case SVt_PVFM:
if (lvalue || repl)
Perl_croak(aTHX_ "substr outside of string");
if (ckWARN(WARN_SUBSTR))
- Perl_warner(aTHX_ WARN_SUBSTR, "substr outside of string");
+ Perl_warner(aTHX_ packWARN(WARN_SUBSTR), "substr outside of string");
RETPUSHUNDEF;
}
else {
STRLEN n_a;
SvPV_force(sv,n_a);
if (ckWARN(WARN_SUBSTR))
- Perl_warner(aTHX_ WARN_SUBSTR,
+ Perl_warner(aTHX_ packWARN(WARN_SUBSTR),
"Attempt to use reference as lvalue in substr");
}
if (SvOK(sv)) /* is it defined ? */
if (MARK < SP)
sv_setsv(val, *++MARK);
else if (ckWARN(WARN_MISC))
- Perl_warner(aTHX_ WARN_MISC, "Odd number of elements in anonymous hash");
+ Perl_warner(aTHX_ packWARN(WARN_MISC), "Odd number of elements in anonymous hash");
(void)hv_store_ent(hv,key,val,0);
}
SP = ORIGMARK;
}
if (offset > AvFILLp(ary) + 1) {
if (ckWARN(WARN_MISC))
- Perl_warner(aTHX_ WARN_MISC, "splice() offset past end of array" );
+ Perl_warner(aTHX_ packWARN(WARN_MISC), "splice() offset past end of array" );
offset = AvFILLp(ary) + 1;
}
after = AvFILLp(ary) + 1 - (offset + length);
else {
sv = &PL_sv_no;
if (ckWARN(WARN_SYNTAX))
- Perl_warner(aTHX_ WARN_SYNTAX, "Not enough format arguments");
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Not enough format arguments");
}
break;
switch (CxTYPE(cx)) {
case CXt_SUBST:
if (ckWARN(WARN_EXITING))
- Perl_warner(aTHX_ WARN_EXITING, "Exiting substitution via %s",
+ Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting substitution via %s",
OP_NAME(PL_op));
break;
case CXt_SUB:
if (ckWARN(WARN_EXITING))
- Perl_warner(aTHX_ WARN_EXITING, "Exiting subroutine via %s",
+ Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting subroutine via %s",
OP_NAME(PL_op));
break;
case CXt_FORMAT:
if (ckWARN(WARN_EXITING))
- Perl_warner(aTHX_ WARN_EXITING, "Exiting format via %s",
+ Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting format via %s",
OP_NAME(PL_op));
break;
case CXt_EVAL:
if (ckWARN(WARN_EXITING))
- Perl_warner(aTHX_ WARN_EXITING, "Exiting eval via %s",
+ Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting eval via %s",
OP_NAME(PL_op));
break;
case CXt_NULL:
if (ckWARN(WARN_EXITING))
- Perl_warner(aTHX_ WARN_EXITING, "Exiting pseudo-block via %s",
+ Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting pseudo-block via %s",
OP_NAME(PL_op));
return -1;
case CXt_LOOP:
switch (CxTYPE(cx)) {
case CXt_SUBST:
if (ckWARN(WARN_EXITING))
- Perl_warner(aTHX_ WARN_EXITING, "Exiting substitution via %s",
+ Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting substitution via %s",
OP_NAME(PL_op));
break;
case CXt_SUB:
if (ckWARN(WARN_EXITING))
- Perl_warner(aTHX_ WARN_EXITING, "Exiting subroutine via %s",
+ Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting subroutine via %s",
OP_NAME(PL_op));
break;
case CXt_FORMAT:
if (ckWARN(WARN_EXITING))
- Perl_warner(aTHX_ WARN_EXITING, "Exiting format via %s",
+ Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting format via %s",
OP_NAME(PL_op));
break;
case CXt_EVAL:
if (ckWARN(WARN_EXITING))
- Perl_warner(aTHX_ WARN_EXITING, "Exiting eval via %s",
+ Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting eval via %s",
OP_NAME(PL_op));
break;
case CXt_NULL:
if (ckWARN(WARN_EXITING))
- Perl_warner(aTHX_ WARN_EXITING, "Exiting pseudo-block via %s",
+ Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting pseudo-block via %s",
OP_NAME(PL_op));
return -1;
case CXt_LOOP:
sv_catpvn(err, message, msglen);
if (ckWARN(WARN_MISC)) {
STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1;
- Perl_warner(aTHX_ WARN_MISC, SvPVX(err)+start);
+ Perl_warner(aTHX_ packWARN(WARN_MISC), SvPVX(err)+start);
}
}
}
PERL_VERSION, PERL_SUBVERSION);
}
if (ckWARN(WARN_PORTABLE))
- Perl_warner(aTHX_ WARN_PORTABLE,
+ Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
"v-string in use/require non-portable");
RETPUSHYES;
}
if (llen >= 2 && lpv[llen - 2] == '1' && lpv[llen - 1] == '9'
&& (llen == 2 || !isDIGIT(lpv[llen - 3])))
{
- Perl_warner(aTHX_ WARN_Y2K, "Possible Y2K bug: %s",
+ Perl_warner(aTHX_ packWARN(WARN_Y2K), "Possible Y2K bug: %s",
"about to append an integer to '19'");
}
}
(SvTYPE(SvRV(*relem)) == SVt_PVAV ||
SvTYPE(SvRV(*relem)) == SVt_PVHV))
{
- Perl_warner(aTHX_ WARN_MISC,
+ Perl_warner(aTHX_ packWARN(WARN_MISC),
"Reference found where even-sized list expected");
}
else
- Perl_warner(aTHX_ WARN_MISC,
+ Perl_warner(aTHX_ packWARN(WARN_MISC),
"Odd number of elements in hash assignment");
}
if (SvTYPE(hash) == SVt_PVAV) {
if (ckWARN2(WARN_GLOB, WARN_CLOSED)
&& (!io || !(IoFLAGS(io) & IOf_START))) {
if (type == OP_GLOB)
- Perl_warner(aTHX_ WARN_GLOB,
+ Perl_warner(aTHX_ packWARN(WARN_GLOB),
"glob failed (can't start child: %s)",
Strerror(errno));
else
}
else if (type == OP_GLOB) {
if (!do_close(PL_last_in_gv, FALSE) && ckWARN(WARN_GLOB)) {
- Perl_warner(aTHX_ WARN_GLOB,
+ Perl_warner(aTHX_ packWARN(WARN_GLOB),
"glob failed (child exited with status %d%s)",
(int)(STATUS_CURRENT >> 8),
(STATUS_CURRENT & 0x80) ? ", core dumped" : "");
Perl_sub_crush_depth(pTHX_ CV *cv)
{
if (CvANON(cv))
- Perl_warner(aTHX_ WARN_RECURSION, "Deep recursion on anonymous subroutine");
+ Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on anonymous subroutine");
else {
SV* tmpstr = sv_newmortal();
gv_efullname3(tmpstr, CvGV(cv), Nullch);
- Perl_warner(aTHX_ WARN_RECURSION, "Deep recursion on subroutine \"%s\"",
+ Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on subroutine \"%s\"",
SvPVX(tmpstr));
}
}
SV *sv;
if (SvROK(elemsv) && !SvGAMAGIC(elemsv) && ckWARN(WARN_MISC))
- Perl_warner(aTHX_ WARN_MISC, "Use of reference \"%s\" as array index", SvPV_nolen(elemsv));
+ Perl_warner(aTHX_ packWARN(WARN_MISC), "Use of reference \"%s\" as array index", SvPV_nolen(elemsv));
if (elem > 0)
elem -= PL_curcop->cop_arybase;
if (SvTYPE(av) != SVt_PVAV)
Perl_croak(aTHX_ "%s not allowed in length fields", buf);
case ',': /* grandfather in commas but with a warning */
if (commas++ == 0 && ckWARN(WARN_UNPACK))
- Perl_warner(aTHX_ WARN_UNPACK,
+ Perl_warner(aTHX_ packWARN(WARN_UNPACK),
"Invalid type in unpack: '%c'", (int)datumtype);
/* FALL THROUGH */
case '%':
Perl_croak(aTHX_ "Invalid type in unpack: '%c'", (int)datumtype);
case ',': /* grandfather in commas but with a warning */
if (commas++ == 0 && ckWARN(WARN_UNPACK))
- Perl_warner(aTHX_ WARN_UNPACK,
+ Perl_warner(aTHX_ packWARN(WARN_UNPACK),
"Invalid type in unpack: '%c'", (int)datumtype);
break;
case '%':
Perl_croak(aTHX_ "Invalid type in pack: '%c'", (int)datumtype);
case ',': /* grandfather in commas but with a warning */
if (commas++ == 0 && ckWARN(WARN_PACK))
- Perl_warner(aTHX_ WARN_PACK,
+ Perl_warner(aTHX_ packWARN(WARN_PACK),
"Invalid type in pack: '%c'", (int)datumtype);
break;
case '%':
aint = SvIV(fromstr);
if ((aint < 0 || aint > 255) &&
ckWARN(WARN_PACK))
- Perl_warner(aTHX_ WARN_PACK,
+ Perl_warner(aTHX_ packWARN(WARN_PACK),
"Character in \"C\" format wrapped");
achar = aint & 255;
sv_catpvn(cat, &achar, sizeof(char));
aint = SvIV(fromstr);
if ((aint < -128 || aint > 127) &&
ckWARN(WARN_PACK))
- Perl_warner(aTHX_ WARN_PACK,
+ Perl_warner(aTHX_ packWARN(WARN_PACK),
"Character in \"c\" format wrapped");
achar = aint & 255;
sv_catpvn(cat, &achar, sizeof(char));
|| (SvPADTMP(fromstr)
&& !SvREADONLY(fromstr))))
{
- Perl_warner(aTHX_ WARN_PACK,
+ Perl_warner(aTHX_ packWARN(WARN_PACK),
"Attempt to pack pointer to temporary value");
}
if (SvPOK(fromstr) || SvNIOK(fromstr))
}
else if (ckWARN(WARN_UNTIE)) {
if (mg && SvREFCNT(obj) > 1)
- Perl_warner(aTHX_ WARN_UNTIE,
+ Perl_warner(aTHX_ packWARN(WARN_UNTIE),
"untie attempted while %"UVuf" inner references still exist",
(UV)SvREFCNT(obj) - 1 ) ;
}
name = SvPV_nolen(sv);
}
if (name && *name)
- Perl_warner(aTHX_ WARN_IO,
+ Perl_warner(aTHX_ packWARN(WARN_IO),
"Filehandle %s opened only for input", name);
else
- Perl_warner(aTHX_ WARN_IO,
+ Perl_warner(aTHX_ packWARN(WARN_IO),
"Filehandle opened only for input");
}
else if (ckWARN(WARN_CLOSED))
else {
if ((IoLINES_LEFT(io) -= FmLINES(PL_formtarget)) < 0) {
if (ckWARN(WARN_IO))
- Perl_warner(aTHX_ WARN_IO, "page overflow");
+ Perl_warner(aTHX_ packWARN(WARN_IO), "page overflow");
}
if (!do_print(PL_formtarget, fp))
PUSHs(&PL_sv_no);
name = SvPV_nolen(sv);
}
if (name && *name)
- Perl_warner(aTHX_ WARN_IO,
+ Perl_warner(aTHX_ packWARN(WARN_IO),
"Filehandle %s opened only for input", name);
else
- Perl_warner(aTHX_ WARN_IO,
+ Perl_warner(aTHX_ packWARN(WARN_IO),
"Filehandle opened only for input");
}
else if (ckWARN(WARN_CLOSED))
name = SvPV_nolen(sv);
}
if (name && *name)
- Perl_warner(aTHX_ WARN_IO,
+ Perl_warner(aTHX_ packWARN(WARN_IO),
"Filehandle %s opened only for output", name);
else
- Perl_warner(aTHX_ WARN_IO,
+ Perl_warner(aTHX_ packWARN(WARN_IO),
"Filehandle opened only for output");
}
goto say_undef;
if (PL_op->op_type == OP_LSTAT) {
if (gv != PL_defgv) {
if (ckWARN(WARN_IO))
- Perl_warner(aTHX_ WARN_IO,
+ Perl_warner(aTHX_ packWARN(WARN_IO),
"lstat() on filehandle %s", GvENAME(gv));
} else if (PL_laststype != OP_LSTAT)
Perl_croak(aTHX_ "The stat preceding lstat() wasn't an lstat");
else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
gv = (GV*)SvRV(sv);
if (PL_op->op_type == OP_LSTAT && ckWARN(WARN_IO))
- Perl_warner(aTHX_ WARN_IO,
+ Perl_warner(aTHX_ packWARN(WARN_IO),
"lstat() on filehandle %s", GvENAME(gv));
goto do_fstat;
}
PL_laststatval = PerlLIO_stat(SvPV(PL_statname, n_a), &PL_statcache);
if (PL_laststatval < 0) {
if (ckWARN(WARN_NEWLINE) && strchr(SvPV(PL_statname, n_a), '\n'))
- Perl_warner(aTHX_ WARN_NEWLINE, PL_warn_nl, "stat");
+ Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat");
max = 0;
}
}
sv_setpv(PL_statname, SvPV(sv, n_a));
if (!(fp = PerlIO_open(SvPVX(PL_statname), "r"))) {
if (ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, n_a), '\n'))
- Perl_warner(aTHX_ WARN_NEWLINE, PL_warn_nl, "open");
+ Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
RETPUSHUNDEF;
}
PL_laststatval = PerlLIO_fstat(PerlIO_fileno(fp), &PL_statcache);
)
{
if( MAXARG == 1 )
- deprecate_old("chdir('') or chdir(undef) as chdir()");
+ deprecate("chdir('') or chdir(undef) as chdir()");
tmps = SvPV(*svp, n_a);
}
else {
#define vWARN(loc,m) \
STMT_START { \
IV offset = loc - RExC_precomp; \
- Perl_warner(aTHX_ WARN_REGEXP, "%s" REPORT_LOCATION,\
+ Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s" REPORT_LOCATION,\
m, (int)offset, RExC_precomp, RExC_precomp + offset); \
} STMT_END \
#define vWARNdep(loc,m) \
STMT_START { \
IV offset = loc - RExC_precomp; \
- Perl_warner(aTHX_ packWARN3(WARN_DEPRECATED, WARN_REGEXP, WARN_SYNTAX), "%s" REPORT_LOCATION,\
+ Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_REGEXP), "%s" REPORT_LOCATION,\
m, (int)offset, RExC_precomp, RExC_precomp + offset); \
} STMT_END \
#define vWARN2(loc, m, a1) \
STMT_START { \
IV offset = loc - RExC_precomp; \
- Perl_warner(aTHX_ WARN_REGEXP, m REPORT_LOCATION,\
+ Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,\
a1, \
(int)offset, RExC_precomp, RExC_precomp + offset); \
} STMT_END
#define vWARN3(loc, m, a1, a2) \
STMT_START { \
IV offset = loc - RExC_precomp; \
- Perl_warner(aTHX_ WARN_REGEXP, m REPORT_LOCATION, \
+ Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \
a1, a2, \
(int)offset, RExC_precomp, RExC_precomp + offset); \
} STMT_END
#define vWARN4(loc, m, a1, a2, a3) \
STMT_START { \
IV offset = loc - RExC_precomp; \
- Perl_warner(aTHX_ WARN_REGEXP, m REPORT_LOCATION,\
+ Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,\
a1, a2, a3, \
(int)offset, RExC_precomp, RExC_precomp + offset); \
} STMT_END
#define vWARN5(loc, m, a1, a2, a3, a4) \
STMT_START { \
IV offset = loc - RExC_precomp; \
- Perl_warner(aTHX_ WARN_REGEXP, m REPORT_LOCATION, \
+ Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \
a1, a2, a3, a4, \
(int)offset, RExC_precomp, RExC_precomp + offset); \
} STMT_END
*flagp = TRYAGAIN;
return NULL;
case 'p': /* (?p...) */
- if (SIZE_ONLY && ckWARN3(WARN_DEPRECATED, WARN_REGEXP, WARN_SYNTAX))
+ if (SIZE_ONLY && ckWARN2(WARN_DEPRECATED, WARN_REGEXP))
vWARNdep(RExC_parse, "(?p{}) is deprecated - use (??{})");
/* FALL THROUGH*/
case '?': /* (??...) */
if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
&& !(PL_reg_flags & RF_warned)) {
PL_reg_flags |= RF_warned;
- Perl_warner(aTHX_ WARN_REGEXP, "%s limit (%d) exceeded",
+ Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s limit (%d) exceeded",
"Complex regular subexpression recursion",
REG_INFTY - 1);
}
if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
&& !(PL_reg_flags & RF_warned)) {
PL_reg_flags |= RF_warned;
- Perl_warner(aTHX_ WARN_REGEXP, "%s limit (%d) exceeded",
+ Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s limit (%d) exceeded",
"Complex regular subexpression recursion",
REG_INFTY - 1);
}
}
if (!ok) {
if (ckWARN_d(WARN_INTERNAL))
- Perl_warner(aTHX_ WARN_INTERNAL,
+ Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
"Attempt to free non-arena SV: 0x%"UVxf,
PTR2UV(p));
return;
Perl_report_uninit(pTHX)
{
if (PL_op)
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit,
+ Perl_warner(aTHX_ packWARN(WARN_UNINITIALIZED), PL_warn_uninit,
" in ", OP_DESC(PL_op));
else
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit, "", "");
+ Perl_warner(aTHX_ packWARN(WARN_UNINITIALIZED), PL_warn_uninit, "", "");
}
/* grab a new IV body from the free list, allocating more if necessary */
}
if (PL_op)
- Perl_warner(aTHX_ WARN_NUMERIC,
+ Perl_warner(aTHX_ packWARN(WARN_NUMERIC),
"Argument \"%s\" isn't numeric in %s", pv,
OP_DESC(PL_op));
else
- Perl_warner(aTHX_ WARN_NUMERIC,
+ Perl_warner(aTHX_ packWARN(WARN_NUMERIC),
"Argument \"%s\" isn't numeric", pv);
}
|| sv_cmp(cv_const_sv(cv),
cv_const_sv((CV*)sref)))))
{
- Perl_warner(aTHX_ WARN_REDEFINE,
+ Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
CvCONST(cv)
? "Constant subroutine %s redefined"
: "Subroutine %s redefined",
else {
if (dtype == SVt_PVGV) {
if (ckWARN(WARN_MISC))
- Perl_warner(aTHX_ WARN_MISC, "Undefined value assigned to typeglob");
+ Perl_warner(aTHX_ packWARN(WARN_MISC), "Undefined value assigned to typeglob");
}
else
(void)SvOK_off(dstr);
Perl_croak(aTHX_ "Can't weaken a nonreference");
else if (SvWEAKREF(sv)) {
if (ckWARN(WARN_MISC))
- Perl_warner(aTHX_ WARN_MISC, "Reference is already weak");
+ Perl_warner(aTHX_ packWARN(WARN_MISC), "Reference is already weak");
return sv;
}
tsv = SvRV(sv);
U32 refcnt = SvREFCNT(sv);
SV_CHECK_THINKFIRST(sv);
if (SvREFCNT(nsv) != 1 && ckWARN_d(WARN_INTERNAL))
- Perl_warner(aTHX_ WARN_INTERNAL, "Reference miscount in sv_replace()");
+ Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "Reference miscount in sv_replace()");
if (SvMAGICAL(sv)) {
if (SvMAGICAL(nsv))
mg_free(nsv);
return;
}
if (ckWARN_d(WARN_INTERNAL))
- Perl_warner(aTHX_ WARN_INTERNAL, "Attempt to free unreferenced scalar");
+ Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "Attempt to free unreferenced scalar");
return;
}
ATOMIC_DEC_AND_TEST(refcount_is_zero, SvREFCNT(sv));
#ifdef DEBUGGING
if (SvTEMP(sv)) {
if (ckWARN_d(WARN_DEBUGGING))
- Perl_warner(aTHX_ WARN_DEBUGGING,
+ Perl_warner(aTHX_ packWARN(WARN_DEBUGGING),
"Attempt to free temp prematurely: SV 0x%"UVxf,
PTR2UV(sv));
return;
return Nullsv;
if (SvTYPE(old) == SVTYPEMASK) {
if (ckWARN_d(WARN_INTERNAL))
- Perl_warner(aTHX_ WARN_INTERNAL, "semi-panic: attempt to dup freed string");
+ Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "semi-panic: attempt to dup freed string");
return Nullsv;
}
new_SV(sv);
if (n >= 2 && s[n-2] == '1' && s[n-1] == '9'
&& (n == 2 || !isDIGIT(s[n-3])))
{
- Perl_warner(aTHX_ WARN_Y2K,
+ Perl_warner(aTHX_ packWARN(WARN_Y2K),
"Possible Y2K bug: %%%c %s",
c, "format string following '19'");
}
(UV)c & 0xFF);
} else
sv_catpv(msg, "end of string");
- Perl_warner(aTHX_ WARN_PRINTF, "%"SVf, msg); /* yes, this is reentrant */
+ Perl_warner(aTHX_ packWARN(WARN_PRINTF), "%"SVf, msg); /* yes, this is reentrant */
}
/* output mangled stuff ... */
ug = " while running with -T switch";
if (PL_unsafe || PL_taint_warn) {
if(ckWARN(WARN_TAINT))
- Perl_warner(aTHX_ WARN_TAINT, f, s, ug);
+ Perl_warner(aTHX_ packWARN(WARN_TAINT), f, s, ug);
}
else {
Perl_croak(aTHX_ f, s, ug);
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
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 */
&& 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 (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;
&& 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);
}
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++;
}
HV* basestash = gv_stashsv(sv, FALSE);
if (!basestash) {
if (ckWARN(WARN_MISC))
- Perl_warner(aTHX_ WARN_SYNTAX,
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"Can't locate package %s for @%s::ISA",
SvPVX(sv), HvNAME(stash));
continue;
if (ckWARN(WARN_UTF8)) {
if (UNICODE_IS_SURROGATE(uv) &&
!(flags & UNICODE_ALLOW_SURROGATE))
- Perl_warner(aTHX_ WARN_UTF8, "UTF-16 surrogate 0x%04"UVxf, uv);
+ Perl_warner(aTHX_ packWARN(WARN_UTF8), "UTF-16 surrogate 0x%04"UVxf, uv);
else if (
((uv >= 0xFDD0 && uv <= 0xFDEF &&
!(flags & UNICODE_ALLOW_FDD0))
((uv <= PERL_UNICODE_MAX) ||
!(flags & UNICODE_ALLOW_SUPER))
)
- Perl_warner(aTHX_ WARN_UTF8,
+ Perl_warner(aTHX_ packWARN(WARN_UTF8),
"Unicode character 0x%04"UVxf" is illegal", uv);
}
if (UNI_IS_INVARIANT(uv)) {
char *s = SvPVX(sv);
if (PL_op)
- Perl_warner(aTHX_ WARN_UTF8,
+ Perl_warner(aTHX_ packWARN(WARN_UTF8),
"%s in %s", s, OP_DESC(PL_op));
else
- Perl_warner(aTHX_ WARN_UTF8, "%s", s);
+ Perl_warner(aTHX_ packWARN(WARN_UTF8), "%s", s);
}
}
if (op == OP_phoney_OUTPUT_ONLY || op == OP_phoney_INPUT_ONLY) {
if (name && *name)
- Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for %sput",
+ Perl_warner(aTHX_ packWARN(WARN_IO), "Filehandle %s opened only for %sput",
name,
(op == OP_phoney_INPUT_ONLY ? "in" : "out"));
else
- Perl_warner(aTHX_ WARN_IO, "Filehandle opened only for %sput",
+ Perl_warner(aTHX_ packWARN(WARN_IO), "Filehandle opened only for %sput",
(op == OP_phoney_INPUT_ONLY ? "in" : "out"));
} else if (name && *name) {
- Perl_warner(aTHX_ warn_type,
+ Perl_warner(aTHX_ packWARN(warn_type),
"%s%s on %s %s %s", func, pars, vile, type, name);
if (io && IoDIRP(io) && !(IoFLAGS(io) & IOf_FAKE_DIRP))
- Perl_warner(aTHX_ warn_type,
+ Perl_warner(aTHX_ packWARN(warn_type),
"\t(Are you trying to call %s%s on dirhandle %s?)\n",
func, pars, name);
}
else {
- Perl_warner(aTHX_ warn_type,
+ Perl_warner(aTHX_ packWARN(warn_type),
"%s%s on %s %s", func, pars, vile, type);
if (gv && io && IoDIRP(io) && !(IoFLAGS(io) & IOf_FAKE_DIRP))
- Perl_warner(aTHX_ warn_type,
+ Perl_warner(aTHX_ packWARN(warn_type),
"\t(Are you trying to call %s%s on dirhandle?)\n",
func, pars);
}
rev += (*end - '0') * mult;
mult *= 10;
if (orev > rev && ckWARN_d(WARN_OVERFLOW))
- Perl_warner(aTHX_ WARN_OVERFLOW,
+ Perl_warner(aTHX_ packWARN(WARN_OVERFLOW),
"Integer overflow in decimal number");
}
}
projects / p5sagit/p5-mst-13.2.git / commitdiff