diff options
| -rw-r--r-- | av.c | 4 | ||||
| -rw-r--r-- | doio.c | 42 | ||||
| -rw-r--r-- | doop.c | 6 | ||||
| -rw-r--r-- | dump.c | 2 | ||||
| -rw-r--r-- | gv.c | 8 | ||||
| -rw-r--r-- | hv.c | 2 | ||||
| -rw-r--r-- | malloc.c | 8 | ||||
| -rw-r--r-- | mg.c | 4 | ||||
| -rw-r--r-- | numeric.c | 18 | ||||
| -rw-r--r-- | op.c | 68 | ||||
| -rw-r--r-- | perl.c | 16 | ||||
| -rw-r--r-- | pp.c | 14 | ||||
| -rw-r--r-- | pp_ctl.c | 26 | ||||
| -rw-r--r-- | pp_hot.c | 16 | ||||
| -rw-r--r-- | pp_pack.c | 12 | ||||
| -rw-r--r-- | pp_sys.c | 26 | ||||
| -rw-r--r-- | regcomp.c | 14 | ||||
| -rw-r--r-- | regexec.c | 4 | ||||
| -rw-r--r-- | sv.c | 28 | ||||
| -rw-r--r-- | taint.c | 2 | ||||
| -rw-r--r-- | toke.c | 80 | ||||
| -rw-r--r-- | universal.c | 2 | ||||
| -rw-r--r-- | utf8.c | 8 | ||||
| -rw-r--r-- | util.c | 14 |
24 files changed, 212 insertions, 212 deletions
@@ -30,7 +30,7 @@ Perl_av_reify(pTHX_ AV *av) 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) @@ -395,7 +395,7 @@ Perl_av_clear(pTHX_ register AV *av) #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) @@ -248,7 +248,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, 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; } @@ -258,7 +258,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, 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; @@ -455,7 +455,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, 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; } @@ -504,19 +504,19 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, } 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"); } } @@ -712,7 +712,7 @@ Perl_nextargv(pTHX_ register GV *gv) 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); @@ -744,7 +744,7 @@ Perl_nextargv(pTHX_ register GV *gv) ) { 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); @@ -755,7 +755,7 @@ Perl_nextargv(pTHX_ register GV *gv) #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); @@ -771,7 +771,7 @@ Perl_nextargv(pTHX_ register GV *gv) (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); @@ -785,7 +785,7 @@ Perl_nextargv(pTHX_ register GV *gv) # 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); @@ -809,7 +809,7 @@ Perl_nextargv(pTHX_ register GV *gv) #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; @@ -843,12 +843,12 @@ Perl_nextargv(pTHX_ register GV *gv) 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)); } } @@ -1243,7 +1243,7 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp) 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); @@ -1308,7 +1308,7 @@ Perl_my_stat(pTHX) 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; } } @@ -1327,7 +1327,7 @@ Perl_my_lstat(pTHX) 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); } @@ -1338,14 +1338,14 @@ Perl_my_lstat(pTHX) 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; } @@ -1386,7 +1386,7 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp, 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; @@ -1524,7 +1524,7 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report) 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)); @@ -754,7 +754,7 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) #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; @@ -823,7 +823,7 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) #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) + @@ -910,7 +910,7 @@ Perl_do_vecset(pTHX_ SV *sv) #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; @@ -1373,7 +1373,7 @@ Perl_runops_debug(pTHX) { 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; } @@ -261,7 +261,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level) 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; } @@ -786,7 +786,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) /* 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); @@ -1173,7 +1173,7 @@ Perl_gv_check(pTHX_ HV *stash) #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)); } @@ -1220,7 +1220,7 @@ Perl_gp_free(pTHX_ GV *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; } @@ -1821,7 +1821,7 @@ Perl_unsharepvn(pTHX_ const char *str, I32 len, U32 hash) 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 @@ -1595,7 +1595,7 @@ Perl_mfree(void *mp) { 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"); } @@ -1608,7 +1608,7 @@ Perl_mfree(void *mp) { 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"); @@ -1695,7 +1695,7 @@ Perl_realloc(void *mp, size_t nbytes) { 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 " : ""); @@ -1710,7 +1710,7 @@ Perl_realloc(void *mp, size_t nbytes) { 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 @@ -1171,7 +1171,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg) 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) @@ -2374,7 +2374,7 @@ Perl_sighandler(int sig) 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)) @@ -175,7 +175,7 @@ Perl_grok_bin(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { } /* 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; @@ -198,7 +198,7 @@ Perl_grok_bin(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { goto redo; } if (ckWARN(WARN_DIGIT)) - Perl_warner(aTHX_ WARN_DIGIT, + Perl_warner(aTHX_ packWARN(WARN_DIGIT), "Illegal binary digit '%c' ignored", *s); break; } @@ -209,7 +209,7 @@ Perl_grok_bin(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { #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; @@ -290,7 +290,7 @@ Perl_grok_hex(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { } /* 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; @@ -313,7 +313,7 @@ Perl_grok_hex(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { goto redo; } if (ckWARN(WARN_DIGIT)) - Perl_warner(aTHX_ WARN_DIGIT, + Perl_warner(aTHX_ packWARN(WARN_DIGIT), "Illegal hexadecimal digit '%c' ignored", *s); break; } @@ -324,7 +324,7 @@ Perl_grok_hex(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { #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; @@ -372,7 +372,7 @@ Perl_grok_oct(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { } /* 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; @@ -399,7 +399,7 @@ Perl_grok_oct(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { * 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; @@ -411,7 +411,7 @@ Perl_grok_oct(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { #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; @@ -199,7 +199,7 @@ Perl_pad_allocmy(pTHX_ char *name) || ((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, @@ -216,9 +216,9 @@ Perl_pad_allocmy(pTHX_ char *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; } @@ -359,7 +359,7 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv, 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); } @@ -372,7 +372,7 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv, 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); } } @@ -509,7 +509,7 @@ Perl_pad_leavemy(pTHX_ I32 fill) 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. */ @@ -995,7 +995,7 @@ S_scalarboolean(pTHX_ OP *o) 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); } } @@ -1067,7 +1067,7 @@ Perl_scalar(pTHX_ OP *o) 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; } @@ -1281,7 +1281,7 @@ Perl_scalarvoid(pTHX_ OP *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; } @@ -2186,7 +2186,7 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right) 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); } @@ -2382,7 +2382,7 @@ Perl_localize(pTHX_ OP *o, I32 lex) 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"); } @@ -3357,7 +3357,7 @@ Perl_package(pTHX_ OP *o) op_free(o); } else { - deprecate_old("\"package\" with no arguments"); + deprecate("\"package\" with no arguments"); sv_setpv(PL_curstname,"<none>"); PL_curstash = Nullhv; } @@ -3898,7 +3898,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) } 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; @@ -3945,7 +3945,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) 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) @@ -4653,7 +4653,7 @@ Perl_cv_ckproto(pTHX_ CV *cv, GV *gv, char *p) 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); } } @@ -4793,7 +4793,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) 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); } @@ -4853,7 +4853,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) 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); @@ -5121,7 +5121,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) 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 */ @@ -5131,7 +5131,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) 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 */ } @@ -5212,7 +5212,7 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename) 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); @@ -5272,7 +5272,7 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename) 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 */ @@ -5281,7 +5281,7 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename) 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 */ } @@ -5318,7 +5318,7 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block) 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); @@ -5389,7 +5389,7 @@ Perl_oopsAV(pTHX_ OP *o) default: if (ckWARN_d(WARN_INTERNAL)) - Perl_warner(aTHX_ WARN_INTERNAL, "oops: oopsAV"); + Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "oops: oopsAV"); break; } return o; @@ -5414,7 +5414,7 @@ Perl_oopsHV(pTHX_ OP *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; @@ -5429,8 +5429,8 @@ Perl_newAVREF(pTHX_ OP *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)); @@ -5453,8 +5453,8 @@ Perl_newHVREF(pTHX_ OP *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)); @@ -5905,7 +5905,7 @@ Perl_ck_fun(pTHX_ OP *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]); @@ -6675,7 +6675,7 @@ Perl_ck_join(pTHX_ OP *o) 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); } @@ -7090,7 +7090,7 @@ Perl_peep(pTHX_ register OP *o) /* 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)); } @@ -7159,9 +7159,9 @@ Perl_peep(pTHX_ register OP *o) 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); } @@ -706,18 +706,18 @@ perl_destruct(pTHXx) 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); } @@ -758,7 +758,7 @@ perl_destruct(pTHXx) 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; @@ -794,7 +794,7 @@ perl_destruct(pTHXx) 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 ! */ @@ -1350,7 +1350,7 @@ print \" \\@INC:\\n @INC\\n\";"); 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); } @@ -2272,7 +2272,7 @@ Perl_moreswitches(pTHX_ char *s) 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 @@ -519,7 +519,7 @@ PP(pp_bless) 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); } @@ -555,7 +555,7 @@ PP(pp_gelem) case 'F': if (strEQ(elem, "FILEHANDLE")) { /* finally deprecated in 5.8.0 */ - deprecate_old("*glob{FILEHANDLE}"); + deprecate("*glob{FILEHANDLE}"); tmpRef = (SV*)GvIOp(gv); } else @@ -776,7 +776,7 @@ PP(pp_undef) 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: @@ -2956,7 +2956,7 @@ PP(pp_substr) 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 { @@ -2992,7 +2992,7 @@ PP(pp_substr) 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 ? */ @@ -3867,7 +3867,7 @@ PP(pp_anonhash) 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; @@ -3928,7 +3928,7 @@ PP(pp_splice) } 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); @@ -396,7 +396,7 @@ PP(pp_formline) 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; @@ -1022,27 +1022,27 @@ S_dopoptolabel(pTHX_ char *label) 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: @@ -1157,27 +1157,27 @@ S_dopoptoloop(pTHX_ I32 startingblock) 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: @@ -1268,7 +1268,7 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen) 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); } } } @@ -2913,7 +2913,7 @@ PP(pp_require) 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; } @@ -170,7 +170,7 @@ PP(pp_concat) 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'"); } } @@ -927,11 +927,11 @@ S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem) (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) { @@ -1488,7 +1488,7 @@ Perl_do_readline(pTHX) 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 @@ -1545,7 +1545,7 @@ Perl_do_readline(pTHX) } 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" : ""); @@ -2879,11 +2879,11 @@ void 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)); } } @@ -2900,7 +2900,7 @@ PP(pp_aelem) 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) @@ -207,7 +207,7 @@ S_measure_struct(pTHX_ char *pat, register char *patend) 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 '%': @@ -500,7 +500,7 @@ Perl_unpack_str(pTHX_ char *pat, register char *patend, register char *s, char * 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 '%': @@ -1794,7 +1794,7 @@ Perl_pack_cat(pTHX_ SV *cat, char *pat, register char *patend, register SV **beg 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 '%': @@ -2016,7 +2016,7 @@ Perl_pack_cat(pTHX_ SV *cat, char *pat, register char *patend, register SV **beg 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)); @@ -2025,7 +2025,7 @@ Perl_pack_cat(pTHX_ SV *cat, char *pat, register char *patend, register SV **beg 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)); @@ -2353,7 +2353,7 @@ Perl_pack_cat(pTHX_ SV *cat, char *pat, register char *patend, register SV **beg || (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)) @@ -852,7 +852,7 @@ PP(pp_untie) } 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 ) ; } @@ -1357,10 +1357,10 @@ PP(pp_leavewrite) 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)) @@ -1371,7 +1371,7 @@ PP(pp_leavewrite) 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); @@ -1443,10 +1443,10 @@ PP(pp_prtf) 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)) @@ -1680,10 +1680,10 @@ PP(pp_sysread) 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; @@ -2731,7 +2731,7 @@ PP(pp_stat) 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"); @@ -2760,7 +2760,7 @@ PP(pp_stat) 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; } @@ -2775,7 +2775,7 @@ PP(pp_stat) 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; } } @@ -3321,7 +3321,7 @@ PP(pp_fttext) 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); @@ -3422,7 +3422,7 @@ PP(pp_chdir) ) { if( MAXARG == 1 ) - deprecate_old("chdir('') or chdir(undef) as chdir()"); + deprecate("chdir('') or chdir(undef) as chdir()"); tmps = SvPV(*svp, n_a); } else { @@ -385,14 +385,14 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, #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 \ @@ -400,7 +400,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, #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 @@ -408,7 +408,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, #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 @@ -416,7 +416,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, #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 @@ -425,7 +425,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, #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 @@ -2162,7 +2162,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) *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 '?': /* (??...) */ @@ -3110,7 +3110,7 @@ S_regmatch(pTHX_ regnode *prog) 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); } @@ -3162,7 +3162,7 @@ S_regmatch(pTHX_ regnode *prog) 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); } @@ -199,7 +199,7 @@ S_del_sv(pTHX_ SV *p) } 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; @@ -546,10 +546,10 @@ void 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 */ @@ -1824,11 +1824,11 @@ S_not_a_number(pTHX_ SV *sv) } 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); } @@ -3784,7 +3784,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags) || 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", @@ -3964,7 +3964,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags) 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); @@ -4731,7 +4731,7 @@ Perl_sv_rvweaken(pTHX_ SV *sv) 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); @@ -4898,7 +4898,7 @@ Perl_sv_replace(pTHX_ register SV *sv, register SV *nsv) 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); @@ -5173,7 +5173,7 @@ Perl_sv_free(pTHX_ SV *sv) 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)); @@ -5182,7 +5182,7 @@ Perl_sv_free(pTHX_ SV *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; @@ -6520,7 +6520,7 @@ Perl_newSVsv(pTHX_ register SV *old) 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); @@ -8283,7 +8283,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, 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'"); } @@ -8420,7 +8420,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV (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 ... */ @@ -57,7 +57,7 @@ Perl_taint_proper(pTHX_ const char *f, const char *s) 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); @@ -316,7 +316,7 @@ void 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 @@ -678,7 +678,7 @@ S_check_uni(pTHX) 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; @@ -1417,7 +1417,7 @@ S_scan_const(pTHX_ char *start) 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; } @@ -1443,7 +1443,7 @@ S_scan_const(pTHX_ char *start) 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 */ @@ -3304,7 +3304,7 @@ Perl_yylex(pTHX) && 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); @@ -3337,7 +3337,7 @@ Perl_yylex(pTHX) 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') ) @@ -3481,7 +3481,7 @@ Perl_yylex(pTHX) 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); } @@ -3499,7 +3499,7 @@ Perl_yylex(pTHX) 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); } } @@ -3578,7 +3578,7 @@ Perl_yylex(pTHX) 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); } @@ -3705,7 +3705,7 @@ Perl_yylex(pTHX) 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); @@ -3848,14 +3848,14 @@ Perl_yylex(pTHX) 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 &"); } @@ -3886,7 +3886,7 @@ Perl_yylex(pTHX) 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 @@ -3901,7 +3901,7 @@ Perl_yylex(pTHX) 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; @@ -4015,7 +4015,7 @@ Perl_yylex(pTHX) 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 */ @@ -4064,7 +4064,7 @@ Perl_yylex(pTHX) 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); } } @@ -4072,10 +4072,10 @@ Perl_yylex(pTHX) 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); } @@ -4614,7 +4614,7 @@ Perl_yylex(pTHX) 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); } @@ -4690,12 +4690,12 @@ Perl_yylex(pTHX) 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; } @@ -5004,7 +5004,7 @@ Perl_yylex(pTHX) } 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; @@ -5311,7 +5311,7 @@ S_pending_ident(pTHX) && 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); } @@ -5947,7 +5947,7 @@ S_checkcomma(pTHX_ register char *s, char *name, char *what) 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); } } @@ -6220,7 +6220,7 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des 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); } @@ -6252,7 +6252,7 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des 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); } @@ -7100,7 +7100,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) if (*s == '_') { if (ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ WARN_SYNTAX, + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number"); lastub = s++; } @@ -7124,7 +7124,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) /* _ 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; @@ -7167,7 +7167,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) 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 @@ -7197,13 +7197,13 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) /* 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); @@ -7211,7 +7211,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) 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 @@ -7240,7 +7240,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) */ 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++; } @@ -7256,7 +7256,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) /* 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 @@ -7269,7 +7269,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) if (*s == '_') { if (ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ WARN_SYNTAX, + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number"); lastub = s; } @@ -7282,7 +7282,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) 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; } @@ -7292,7 +7292,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) /* 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])) { @@ -7313,7 +7313,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) /* stray preinitial _ */ if (*s == '_') { if (ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ WARN_SYNTAX, + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number"); lastub = s++; } @@ -7325,7 +7325,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) /* stray initial _ */ if (*s == '_') { if (ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ WARN_SYNTAX, + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number"); lastub = s++; } @@ -7341,7 +7341,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) 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++; } diff --git a/universal.c b/universal.c index d629dfd1c9..aeec350f5e 100644 --- a/universal.c +++ b/universal.c @@ -93,7 +93,7 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash, 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; @@ -57,7 +57,7 @@ Perl_uvuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags) 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)) @@ -72,7 +72,7 @@ Perl_uvuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags) ((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)) { @@ -469,10 +469,10 @@ malformed: 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); } } @@ -3445,25 +3445,25 @@ Perl_report_evil_fh(pTHX_ GV *gv, IO *io, I32 op) 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); } @@ -4026,7 +4026,7 @@ Perl_new_vstring(pTHX_ char *s, SV *sv) 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"); } } |