From eb4d7e8e8e2be4900331788e018ab65a9833f1b7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dagfinn=20Ilmari=20Manns=C3=A5ker?= Date: Tue, 18 Mar 2025 18:49:09 +0000 Subject: [PATCH] Stop calling Perl_*warn*() manually in core Except reg*.[ch], which are also compiled "outside" core for re.pm --- amigaos4/amigaio.c | 4 +- av.c | 4 +- builtin.c | 12 +-- class.c | 3 +- cygwin/cygwin.c | 4 +- doio.c | 113 ++++++++++----------- doop.c | 8 +- dquote.c | 8 +- dump.c | 2 +- gv.c | 34 +++---- hv.c | 26 ++--- keywords.c | 4 +- keywords.h | 2 +- locale.c | 18 ++-- malloc.c | 8 +- mg.c | 36 +++---- numeric.c | 30 +++--- op.c | 245 ++++++++++++++++++++++----------------------- os2/os2.c | 16 +-- pad.c | 26 ++--- peep.c | 14 +-- perl.c | 40 ++++---- perlio.c | 26 ++--- pp.c | 56 +++++------ pp_ctl.c | 26 ++--- pp_hot.c | 46 ++++----- pp_pack.c | 48 ++++----- pp_sys.c | 70 ++++++------- regen/keywords.pl | 2 +- sv.c | 96 +++++++++--------- taint.c | 2 +- toke.c | 244 +++++++++++++++++++++----------------------- universal.c | 17 ++-- utf8.c | 105 ++++++++++--------- util.c | 12 +-- vms/vms.c | 12 +-- win32/win32.c | 6 +- 37 files changed, 693 insertions(+), 732 deletions(-) diff --git a/amigaos4/amigaio.c b/amigaos4/amigaio.c index 698165fe6b07..119ad288fb9c 100644 --- a/amigaos4/amigaio.c +++ b/amigaos4/amigaio.c @@ -632,8 +632,8 @@ static void S_exec_failed(pTHX_ const char *cmd, int fd, int do_report) if (e) { if (ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC), - "Can't exec \"%s\": %s", cmd, Strerror(e)); + warner(packWARN(WARN_EXEC), + "Can't exec \"%s\": %s", cmd, Strerror(e)); } if (do_report) { diff --git a/av.c b/av.c index f5e44221c12a..8ced00f47c63 100644 --- a/av.c +++ b/av.c @@ -31,7 +31,7 @@ Perl_av_reify(pTHX_ AV *av) return; #ifdef DEBUGGING if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied)) - Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "av_reify called on tied array"); + ck_warner_d(packWARN(WARN_DEBUGGING), "av_reify called on tied array"); #endif key = AvMAX(av) + 1; while (key > AvFILLp(av) + 1) @@ -641,7 +641,7 @@ Perl_av_clear(pTHX_ AV *av) #ifdef DEBUGGING if (SvREFCNT(av) == 0) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "Attempt to clear deleted array"); + ck_warner_d(packWARN(WARN_DEBUGGING), "Attempt to clear deleted array"); } #endif diff --git a/builtin.c b/builtin.c index ba5ea1dec9d5..899445a7fb59 100644 --- a/builtin.c +++ b/builtin.c @@ -33,8 +33,8 @@ struct BuiltinFuncDescriptor { static void S_warn_experimental_builtin(pTHX_ const char *name) { /* diag_listed_as: Built-in function '%s' is experimental */ - Perl_ck_warner_d(aTHX_ packWARN(WARN_EXPERIMENTAL__BUILTIN), - "Built-in function 'builtin::%s' is experimental", name); + ck_warner_d(packWARN(WARN_EXPERIMENTAL__BUILTIN), + "Built-in function 'builtin::%s' is experimental", name); } /* These three utilities might want to live elsewhere to be reused from other @@ -498,13 +498,13 @@ Perl_XS_builtin_indexed(pTHX_ CV *cv) switch(GIMME_V) { case G_VOID: - Perl_ck_warner(aTHX_ packWARN(WARN_VOID), - "Useless use of %s in void context", "builtin::indexed"); + ck_warner(packWARN(WARN_VOID), + "Useless use of %s in void context", "builtin::indexed"); XSRETURN(0); case G_SCALAR: - Perl_ck_warner(aTHX_ packWARN(WARN_SCALAR), - "Useless use of %s in scalar context", "builtin::indexed"); + ck_warner(packWARN(WARN_SCALAR), + "Useless use of %s in scalar context", "builtin::indexed"); ST(0) = sv_2mortal(newSViv(items * 2)); XSRETURN(1); diff --git a/class.c b/class.c index 6d545370b4a6..a5a21819b9e4 100644 --- a/class.c +++ b/class.c @@ -102,8 +102,7 @@ PP(pp_initfield) STRLEN svcount = PL_stack_sp - svp + 1; if(svcount % 2) - Perl_warner(aTHX_ - packWARN(WARN_MISC), "Odd number of elements in hash field initialization"); + warner(packWARN(WARN_MISC), "Odd number of elements in hash field initialization"); while(svp <= PL_stack_sp) { SV *key = *svp; svp++; diff --git a/cygwin/cygwin.c b/cygwin/cygwin.c index 023a54b8e85c..262ae223e4fa 100644 --- a/cygwin/cygwin.c +++ b/cygwin/cygwin.c @@ -42,8 +42,8 @@ do_spawnvp (const char *path, const char * const *argv) if (childpid < 0) { status = -1; if(ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC),"Can't spawn \"%s\": %s", - path,Strerror (errno)); + warner(packWARN(WARN_EXEC),"Can't spawn \"%s\": %s", + path, Strerror(errno)); } else { do { result = wait4pid(childpid, &status, 0); diff --git a/doio.c b/doio.c index c3428c421b07..3c8dddcee243 100644 --- a/doio.c +++ b/doio.c @@ -636,8 +636,7 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len, #ifdef USE_STDIO if (SvROK(*svp) && !memchr(oname, '&', len)) { if (ckWARN(WARN_IO)) - Perl_warner(aTHX_ packWARN(WARN_IO), - "Can't open a reference"); + warner(packWARN(WARN_IO), "Can't open a reference"); SETERRNO(EINVAL, LIB_INVARG); fp = NULL; goto say_false; @@ -685,7 +684,7 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len, if (*name == '\0') { /* command is missing 19990114 */ if (ckWARN(WARN_PIPE)) - Perl_warner(aTHX_ packWARN(WARN_PIPE), "Missing command in piped open"); + warner(packWARN(WARN_PIPE), "Missing command in piped open"); errno = EPIPE; fp = NULL; goto say_false; @@ -696,7 +695,7 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len, if (!num_svs && name[len-1] == '|') { name[--len] = '\0' ; if (ckWARN(WARN_PIPE)) - Perl_warner(aTHX_ packWARN(WARN_PIPE), "Can't open bidirectional pipe"); + warner(packWARN(WARN_PIPE), "Can't open bidirectional pipe"); } mode[0] = 'w'; writing = 1; @@ -919,7 +918,7 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len, if (*name == '\0') { /* command is missing 19990114 */ if (ckWARN(WARN_PIPE)) - Perl_warner(aTHX_ packWARN(WARN_PIPE), "Missing command in piped open"); + warner(packWARN(WARN_PIPE), "Missing command in piped open"); errno = EPIPE; fp = NULL; goto say_false; @@ -1004,7 +1003,7 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, ) { GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral); /* PL_warn_nl is constant */ - Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open"); + warner(packWARN(WARN_NEWLINE), PL_warn_nl, "open"); GCC_DIAG_RESTORE_STMT; } goto say_false; @@ -1013,17 +1012,16 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, if (ckWARN(WARN_IO)) { if ((IoTYPE(io) == IoTYPE_RDONLY) && (fp == PerlIO_stdout() || fp == PerlIO_stderr())) { - Perl_warner(aTHX_ packWARN(WARN_IO), - "Filehandle STD%s reopened as %" HEKf - " only for input", - ((fp == PerlIO_stdout()) ? "OUT" : "ERR"), - HEKfARG(GvENAME_HEK(gv))); + warner(packWARN(WARN_IO), + "Filehandle STD%s reopened as %" HEKf + " only for input", + ((fp == PerlIO_stdout()) ? "OUT" : "ERR"), + HEKfARG(GvENAME_HEK(gv))); } else if ((IoTYPE(io) == IoTYPE_WRONLY) && fp == PerlIO_stdin()) { - Perl_warner(aTHX_ packWARN(WARN_IO), - "Filehandle STDIN reopened as %" HEKf " only for output", - HEKfARG(GvENAME_HEK(gv)) - ); + warner(packWARN(WARN_IO), + "Filehandle STDIN reopened as %" HEKf " only for output", + HEKfARG(GvENAME_HEK(gv))); } } @@ -1440,9 +1438,9 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen) } else { if (is_fork_open(PL_oldname)) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE), - "Forked open '%s' not meaningful in <>", - PL_oldname); + ck_warner_d(packWARN(WARN_INPLACE), + "Forked open '%s' not meaningful in <>", + PL_oldname); continue; } @@ -1485,9 +1483,9 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen) fileuid = statbuf.st_uid; filegid = statbuf.st_gid; if (!S_ISREG(PL_filemode)) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE), - "Can't do inplace edit: %s is not a regular file", - PL_oldname ); + ck_warner_d(packWARN(WARN_INPLACE), + "Can't do inplace edit: %s is not a regular file", + PL_oldname ); do_close(gv,FALSE); continue; } @@ -1514,10 +1512,10 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen) && statbuf.st_ino == fileino) ) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE), - "Can't do inplace edit: %" - SVf " would not be unique", - SVfARG(sv)); + ck_warner_d(packWARN(WARN_INPLACE), + "Can't do inplace edit: %" + SVf " would not be unique", + SVfARG(sv)); goto cleanup_argv; } #endif @@ -1530,8 +1528,8 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen) if (!S_openindirtemp(aTHX_ PL_argvoutgv, GvSV(gv), temp_name_sv)) { SvREFCNT_dec(temp_name_sv); /* diag_listed_as: Can't do inplace edit on %s: %s */ - Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE), "Can't do inplace edit on %s: Cannot make temp name: %s", - PL_oldname, Strerror(errno) ); + ck_warner_d(packWARN(WARN_INPLACE), "Can't do inplace edit on %s: Cannot make temp name: %s", + PL_oldname, Strerror(errno) ); #ifndef FLEXFILENAMES cleanup_argv: #endif @@ -1583,13 +1581,13 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen) Stat_t statbuf; if (PerlLIO_stat(PL_oldname, &statbuf) >= 0 && !S_ISREG(statbuf.st_mode)) { - Perl_warner(aTHX_ packWARN(WARN_INPLACE), - "Can't do inplace edit: %s is not a regular file", - PL_oldname); + warner(packWARN(WARN_INPLACE), + "Can't do inplace edit: %s is not a regular file", + PL_oldname); } else { - Perl_warner(aTHX_ packWARN(WARN_INPLACE), "Can't open %s: %s", - PL_oldname, Strerror(eno)); + warner(packWARN(WARN_INPLACE), "Can't open %s: %s", + PL_oldname, Strerror(eno)); } } } @@ -1964,16 +1962,16 @@ Perl_io_close(pTHX_ IO *io, GV *gv, bool is_explict, bool warn_on_fail) if (warn_on_fail && !retval) { if (gv) - Perl_ck_warner_d(aTHX_ packWARN(WARN_IO), - "Warning: unable to close filehandle %" - HEKf " properly: %" SVf, - HEKfARG(GvNAME_HEK(gv)), - SVfARG(get_sv("!",GV_ADD))); + ck_warner_d(packWARN(WARN_IO), + "Warning: unable to close filehandle %" + HEKf " properly: %" SVf, + HEKfARG(GvNAME_HEK(gv)), + SVfARG(get_sv("!",GV_ADD))); else - Perl_ck_warner_d(aTHX_ packWARN(WARN_IO), - "Warning: unable to close filehandle " - "properly: %" SVf, - SVfARG(get_sv("!",GV_ADD))); + ck_warner_d(packWARN(WARN_IO), + "Warning: unable to close filehandle " + "properly: %" SVf, + SVfARG(get_sv("!",GV_ADD))); } } else if (is_explict) { @@ -2249,10 +2247,9 @@ Perl_do_print(pTHX_ SV *sv, PerlIO *fp) if (! utf8_to_bytes_new_pv(&tmps, &len, &free_me)) { /* Non-utf8 output stream, but string only representable in utf8 */ - Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), - "Wide character in %s", - PL_op ? OP_DESC(PL_op) : "print" - ); + ck_warner_d(packWARN(WARN_UTF8), + "Wide character in %s", + PL_op ? OP_DESC(PL_op) : "print"); /* Could also check that isn't one of the things to avoid * in utf8 by using check_utf8_print(), but not doing so, * since the stream isn't a UTF8 stream */ @@ -2337,7 +2334,7 @@ Perl_my_stat_flags(pTHX_ const U32 flags) } if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && should_warn_nl(s)) { GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral); /* PL_warn_nl is constant */ - Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat"); + warner(packWARN(WARN_NEWLINE), PL_warn_nl, "stat"); GCC_DIAG_RESTORE_STMT; } return PL_laststatval; @@ -2364,9 +2361,9 @@ Perl_my_lstat_flags(pTHX_ const U32 flags) PL_laststatval = -1; if (ckWARN(WARN_IO)) { /* diag_listed_as: Use of -l on filehandle%s */ - Perl_warner(aTHX_ packWARN(WARN_IO), - "Use of -l on filehandle %" HEKf, - HEKfARG(GvENAME_HEK(cGVOP_gv))); + warner(packWARN(WARN_IO), + "Use of -l on filehandle %" HEKf, + HEKfARG(GvENAME_HEK(cGVOP_gv))); } SETERRNO(EBADF,RMS_IFI); return -1; @@ -2388,14 +2385,14 @@ Perl_my_lstat_flags(pTHX_ const U32 flags) && ckWARN(WARN_IO)) { if (isio) /* diag_listed_as: Use of -l on filehandle%s */ - Perl_warner(aTHX_ packWARN(WARN_IO), - "Use of -l on filehandle"); + warner(packWARN(WARN_IO), + "Use of -l on filehandle"); else /* diag_listed_as: Use of -l on filehandle%s */ - Perl_warner(aTHX_ packWARN(WARN_IO), - "Use of -l on filehandle %" HEKf, - HEKfARG(GvENAME_HEK((const GV *) - (SvROK(sv) ? SvRV(sv) : sv)))); + warner(packWARN(WARN_IO), + "Use of -l on filehandle %" HEKf, + HEKfARG(GvENAME_HEK((const GV *) + (SvROK(sv) ? SvRV(sv) : sv)))); } file = SvPV_flags_const(sv, len, flags); sv_setpv(PL_statname,file); @@ -2407,7 +2404,7 @@ Perl_my_lstat_flags(pTHX_ const U32 flags) } if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && should_warn_nl(file)) { GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral); /* PL_warn_nl is constant */ - Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "lstat"); + warner(packWARN(WARN_NEWLINE), PL_warn_nl, "lstat"); GCC_DIAG_RESTORE_STMT; } return PL_laststatval; @@ -2420,7 +2417,7 @@ S_exec_failed(pTHX_ const char *cmd, int fd, int do_report) PERL_ARGS_ASSERT_EXEC_FAILED; if (ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s", + warner(packWARN(WARN_EXEC), "Can't exec \"%s\": %s", cmd, Strerror(e)); if (do_report) { /* XXX silently ignore failures */ @@ -3523,7 +3520,7 @@ Perl_vms_start_glob LEAVE; if (!fp && ckWARN(WARN_GLOB)) { - Perl_warner(aTHX_ packWARN(WARN_GLOB), "glob failed (can't start child: %s)", + warner(packWARN(WARN_GLOB), "glob failed (can't start child: %s)", Strerror(errno)); } diff --git a/doop.c b/doop.c index 62aec05977dd..1d7411a03d82 100644 --- a/doop.c +++ b/doop.c @@ -833,8 +833,8 @@ Perl_do_vecget(pTHX_ SV *sv, STRLEN offset, int size) #ifdef UV_IS_QUAD if (size == 64) { - Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), - "Bit vector size > 32 non-portable"); + ck_warner(packWARN(WARN_PORTABLE), + "Bit vector size > 32 non-portable"); } #endif if (offset > Size_t_MAX / n - 1) /* would overflow */ @@ -961,8 +961,8 @@ Perl_do_vecset(pTHX_ SV *sv) #ifdef UV_IS_QUAD case 64: - Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), - "Bit vector size > 32 non-portable"); + ck_warner(packWARN(WARN_PORTABLE), + "Bit vector size > 32 non-portable"); s[offset+7] = (U8)( lval ); /* = size - 64 */ s[offset+6] = (U8)( lval >> 8); /* = size - 56 */ s[offset+5] = (U8)( lval >> 16); /* = size - 48 */ diff --git a/dquote.c b/dquote.c index 18e2842af65e..dcfa8eff540b 100644 --- a/dquote.c +++ b/dquote.c @@ -71,7 +71,7 @@ Perl_grok_bslash_c(pTHX_ const char source, *packed_warn = packWARN(WARN_SYNTAX); } else { - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), format, source, clearer); + warner(packWARN(WARN_SYNTAX), format, source, clearer); } } @@ -360,7 +360,7 @@ Perl_grok_bslash_o(pTHX_ char **s, const char * const send, UV *uv, *packed_warn = packWARN(WARN_DIGIT); } else { - Perl_warner(aTHX_ packWARN(WARN_DIGIT), "%s", failure); + warner(packWARN(WARN_DIGIT), "%s", failure); } } } @@ -467,7 +467,7 @@ Perl_grok_bslash_x(pTHX_ char ** s, const char * const send, UV *uv, send, UTF, FALSE); if (! packed_warn) { - Perl_warner(aTHX_ packWARN(WARN_DIGIT), "%s", failure); + warner(packWARN(WARN_DIGIT), "%s", failure); } else { *message = failure; @@ -546,7 +546,7 @@ Perl_grok_bslash_x(pTHX_ char ** s, const char * const send, UV *uv, const char * failure = form_alien_digit_msg(16, numbers_len, *s, send, UTF, TRUE); if (! packed_warn) { - Perl_warner(aTHX_ packWARN(WARN_DIGIT), "%s", failure); + warner(packWARN(WARN_DIGIT), "%s", failure); } else { *message = failure; diff --git a/dump.c b/dump.c index 6fa955000ee7..c3d82ec2de04 100644 --- a/dump.c +++ b/dump.c @@ -2964,7 +2964,7 @@ Perl_runops_debug(pTHX) #endif if (!PL_op) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN"); + ck_warner_d(packWARN(WARN_DEBUGGING), "NULL OP IN RUN"); return 0; } DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n")); diff --git a/gv.c b/gv.c index b43b7466d00d..60cc495f710c 100644 --- a/gv.c +++ b/gv.c @@ -950,23 +950,23 @@ S_gv_fetchmeth_internal(pTHX_ HV* stash, SV* meth, const char* name, STRLEN len, ( len && name[0] == '(' ) /* overload.pm related, in particular "()" */ || ( memEQs( name, len, "DESTROY") ) ) { - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), - "Can't locate package %" SVf " for @%" HEKf "::ISA", - SVfARG(linear_sv), - HEKfARG(HvNAME_HEK(stash))); + ck_warner(packWARN(WARN_SYNTAX), + "Can't locate package %" SVf " for @%" HEKf "::ISA", + SVfARG(linear_sv), + HEKfARG(HvNAME_HEK(stash))); } else if( memEQs( name, len, "AUTOLOAD") ) { /* gobble this warning */ } else { - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), - "While trying to resolve method call %.*s->%.*s()" - " can not locate package %" SVf_QUOTEDPREFIX " yet it is mentioned in @%.*s::ISA" - " (perhaps you forgot to load %" SVf_QUOTEDPREFIX "?)", - (int) hvnamelen, hvname, - (int) len, name, - SVfARG(linear_sv), - (int) hvnamelen, hvname, - SVfARG(linear_sv)); + ck_warner(packWARN(WARN_SYNTAX), + "While trying to resolve method call %.*s->%.*s()" + " can not locate package %" SVf_QUOTEDPREFIX " yet it is mentioned in @%.*s::ISA" + " (perhaps you forgot to load %" SVf_QUOTEDPREFIX "?)", + (int) hvnamelen, hvname, + (int) len, name, + SVfARG(linear_sv), + (int) hvnamelen, hvname, + SVfARG(linear_sv)); } } continue; @@ -2698,7 +2698,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, faking_it = SvOK(gv); if (add & GV_ADDWARN) - Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), + ck_warner_d(packWARN(WARN_INTERNAL), "Had to create %" UTF8f " unexpectedly", UTF8fARG(is_utf8, name_end-nambeg, nambeg)); gv_init_pvn(gv, stash, name, len, (add & GV_ADDMULTI)|is_utf8); @@ -2920,9 +2920,9 @@ Perl_gp_free(pTHX_ GV *gv) if (!gv || !isGV_with_GP(gv) || !(gp = GvGP(gv))) return; if (gp->gp_refcnt == 0) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), - "Attempt to free unreferenced glob pointers" - pTHX__FORMAT pTHX__VALUE); + ck_warner_d(packWARN(WARN_INTERNAL), + "Attempt to free unreferenced glob pointers" + pTHX__FORMAT pTHX__VALUE); return; } if (gp->gp_refcnt > 1) { diff --git a/hv.c b/hv.c index 9974dc921c96..2d97fe9530b9 100644 --- a/hv.c +++ b/hv.c @@ -1058,10 +1058,10 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, /* Currently this makes various tests warn in annoying ways. * So Silenced for now. - Yves | bogus end of comment =>* / if (HvAUX(hv)->xhv_riter != -1) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), - "[TESTING] Inserting into a hash during each() traversal results in undefined behavior" - pTHX__FORMAT - pTHX__VALUE); + ck_warner_d(packWARN(WARN_INTERNAL), + "[TESTING] Inserting into a hash during each() traversal results in undefined behavior" + pTHX__FORMAT + pTHX__VALUE); } */ MAYBE_UPDATE_HASH_RAND_BITS_KEY(key,klen); @@ -3090,10 +3090,10 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) #ifdef PERL_HASH_RANDOMIZE_KEYS if (iter->xhv_last_rand != iter->xhv_rand) { if (iter->xhv_riter != -1) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), - "Use of each() on hash after insertion without resetting hash iterator results in undefined behavior" - pTHX__FORMAT - pTHX__VALUE); + ck_warner_d(packWARN(WARN_INTERNAL), + "Use of each() on hash after insertion without resetting hash iterator results in undefined behavior" + pTHX__FORMAT + pTHX__VALUE); } iter->xhv_last_rand = iter->xhv_rand; } @@ -3352,11 +3352,11 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash) } if (!entry) - Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), - "Attempt to free nonexistent shared string '%s'%s" - pTHX__FORMAT, - hek ? HEK_KEY(hek) : str, - ((k_flags & HVhek_UTF8) ? " (utf8)" : "") pTHX__VALUE); + ck_warner_d(packWARN(WARN_INTERNAL), + "Attempt to free nonexistent shared string '%s'%s" + pTHX__FORMAT, + hek ? HEK_KEY(hek) : str, + ((k_flags & HVhek_UTF8) ? " (utf8)" : "") pTHX__VALUE); if (k_flags & HVhek_FREEKEY) Safefree(str); } diff --git a/keywords.c b/keywords.c index 53877c7366cd..1b1fcc24943e 100644 --- a/keywords.c +++ b/keywords.c @@ -1613,7 +1613,7 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords) name[4] == 'i' && name[5] == 'f') { /* elseif */ - Perl_ck_warner_d(aTHX_ packWARN(WARN_SYNTAX), "elseif should be elsif"); + ck_warner_d(packWARN(WARN_SYNTAX), "elseif should be elsif"); } goto unknown; @@ -3590,5 +3590,5 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords) } /* Generated from: - * ad2656c0264d45b03ee74855fdffeffd57799d21d85991fbad0c541b732c9880 regen/keywords.pl + * cc0991530edda2eb87e845d9347acc0f8d2debabab27608ef65ebd2b8d221c08 regen/keywords.pl * ex: set ro ft=c: */ diff --git a/keywords.h b/keywords.h index 922065bc9482..b3f5ec4244ce 100644 --- a/keywords.h +++ b/keywords.h @@ -282,5 +282,5 @@ #define KEY_y 266 /* Generated from: - * ad2656c0264d45b03ee74855fdffeffd57799d21d85991fbad0c541b732c9880 regen/keywords.pl + * cc0991530edda2eb87e845d9347acc0f8d2debabab27608ef65ebd2b8d221c08 regen/keywords.pl * ex: set ro ft=c: */ diff --git a/locale.c b/locale.c index 4ba27fa0f68c..59d833db21ca 100644 --- a/locale.c +++ b/locale.c @@ -3859,7 +3859,7 @@ S_new_ctype(pTHX_ const char *newctype, bool force) " or crash the interpreter", newctype); if (IN_LC(LC_CTYPE)) { - Perl_warner(aTHX_ packWARN(WARN_LOCALE), "%s", msg); + warner(packWARN(WARN_LOCALE), "%s", msg); } else { PL_warn_locale = newSV(0); @@ -4067,8 +4067,7 @@ S_new_ctype(pTHX_ const char *newctype, bool force) if (IN_LC(LC_CTYPE) || UNLIKELY(DEBUG_L_TEST)) { /* The '0' below suppresses a bogus gcc compiler warning */ - Perl_warner(aTHX_ packWARN(WARN_LOCALE), SvPVX(PL_warn_locale), - 0); + warner(packWARN(WARN_LOCALE), SvPVX(PL_warn_locale), 0); if (IN_LC(LC_CTYPE)) { SvREFCNT_dec_NN(PL_warn_locale); PL_warn_locale = NULL; @@ -4088,9 +4087,9 @@ Perl_warn_problematic_locale() * CHECK_AND_WARN_PROBLEMATIC_LOCALE_ */ if (PL_warn_locale) { - Perl_ck_warner(aTHX_ packWARN(WARN_LOCALE), - SvPVX(PL_warn_locale), - 0 /* dummy to avoid compiler warning */ ); + ck_warner(packWARN(WARN_LOCALE), + SvPVX(PL_warn_locale), + 0 /* dummy to avoid compiler warning */ ); SvREFCNT_dec_NN(PL_warn_locale); PL_warn_locale = NULL; } @@ -4498,10 +4497,9 @@ Perl_setlocale(const int category, const char * locale) } /* diag_listed_as: Unknown locale category %d; can't set it to %s */ - Perl_warner(aTHX_ - packWARN(WARN_LOCALE), - "Unknown locale category %d%s%s", - category, conditional_warn_text, locale); + warner(packWARN(WARN_LOCALE), + "Unknown locale category %d%s%s", + category, conditional_warn_text, locale); } SET_EINVAL; diff --git a/malloc.c b/malloc.c index dc13f81661c1..3463c12b61f0 100644 --- a/malloc.c +++ b/malloc.c @@ -1837,11 +1837,11 @@ Perl_mfree(Malloc_t where) if (!PERL_IS_ALIVE || !PL_curcop) { #ifdef RCHECK if (ovp->ov_rmagic == RMAGIC - 1) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_MALLOC), "Duplicate free() ignored"); + ck_warner_d(packWARN(WARN_MALLOC), "Duplicate free() ignored"); return; } #endif - Perl_ck_warner_d(aTHX_ packWARN(WARN_MALLOC), "Bad free() ignored"); + ck_warner_d(packWARN(WARN_MALLOC), "Bad free() ignored"); } } return; /* sanity */ @@ -1939,11 +1939,11 @@ Perl_realloc(void *mp, size_t nbytes) if (!PERL_IS_ALIVE || !PL_curcop) { #ifdef RCHECK if (ovp->ov_rmagic == RMAGIC - 1) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_MALLOC), "realloc() of freed memory ignored"); + ck_warner_d(packWARN(WARN_MALLOC), "realloc() of freed memory ignored"); return NULL; } #endif - Perl_ck_warner_d(aTHX_ packWARN(WARN_MALLOC), "Bad realloc() ignored"); + ck_warner_d(packWARN(WARN_MALLOC), "Bad realloc() ignored"); } } return NULL; /* sanity */ diff --git a/mg.c b/mg.c index 86b6ad80f8b8..1b97569f93aa 100644 --- a/mg.c +++ b/mg.c @@ -1312,7 +1312,7 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg) } else { if (!sv_utf8_downgrade(keysv, /* fail_ok */ TRUE)) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), "Wide character in %s", "setenv key (encoding to utf8)"); + ck_warner_d(packWARN(WARN_UTF8), "Wide character in %s", "setenv key (encoding to utf8)"); } key = SvPV_const(keysv,klen); @@ -1327,7 +1327,7 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg) (void)SvPV_force_nomg_nolen(sv); (void)sv_utf8_downgrade(sv, /* fail_ok */ TRUE); if (SvUTF8(sv)) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), "Wide character in %s", "setenv"); + ck_warner_d(packWARN(WARN_UTF8), "Wide character in %s", "setenv"); SvUTF8_off(sv); } s = SvPVX(sv); @@ -1778,8 +1778,8 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg) if (i <= 0) { if (sv) { SV *tmp = sv_newmortal(); - Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL), "No such signal: SIG%s", - pv_pretty(tmp, s, len, 0, NULL, NULL, 0)); + ck_warner(packWARN(WARN_SIGNAL), "No such signal: SIG%s", + pv_pretty(tmp, s, len, 0, NULL, NULL, 0)); } return 0; } @@ -2388,8 +2388,8 @@ Perl_magic_setarylen(pTHX_ SV *sv, MAGIC *mg) if (obj) { av_fill(obj, SvIV(sv)); } else { - Perl_ck_warner(aTHX_ packWARN(WARN_MISC), - "Attempt to set length of freed array"); + ck_warner(packWARN(WARN_MISC), + "Attempt to set length of freed array"); } return 0; } @@ -2487,7 +2487,7 @@ Perl_magic_getsubstr(pTHX_ SV *sv, MAGIC *mg) negoff ? -(IV)offs : (IV)offs, !negoff, negrem ? -(IV)rem : (IV)rem, !negrem, &offs, &rem )) { - Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR), "substr outside of string"); + ck_warner(packWARN(WARN_SUBSTR), "substr outside of string"); sv_set_undef(sv); return 0; } @@ -2516,9 +2516,8 @@ Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg) SvGETMAGIC(lsv); if (SvROK(lsv)) - Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR), - "Attempt to use reference as lvalue in substr" - ); + ck_warner(packWARN(WARN_SUBSTR), + "Attempt to use reference as lvalue in substr"); SvPV_force_nomg(lsv,lsv_len); if (SvUTF8(lsv)) lsv_len = sv_len_utf8_nomg(lsv); if (!translate_substr_offsets( @@ -3520,7 +3519,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) that same (UTF8-encoded) value. */ sv_utf8_encode(GvSV(mg->mg_obj)); - Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), "Wide character in %s", "$0"); + ck_warner_d(packWARN(WARN_UTF8), "Wide character in %s", "$0"); } LOCK_DOLLARZERO_MUTEX; @@ -3697,13 +3696,14 @@ Perl_perly_sighandler(int sig, Siginfo_t *sip PERL_UNUSED_DECL, ? CvNAME_HEK(cv) : cv && CvGV(cv) ? GvENAME_HEK(CvGV(cv)) : NULL; if (hek) - Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL), - "SIG%s handler \"%" HEKf "\" not defined.\n", - PL_sig_name[sig], HEKfARG(hek)); - /* diag_listed_as: SIG%s handler "%s" not defined */ - else Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL), - "SIG%s handler \"__ANON__\" not defined.\n", - PL_sig_name[sig]); + ck_warner(packWARN(WARN_SIGNAL), + "SIG%s handler \"%" HEKf "\" not defined.\n", + PL_sig_name[sig], HEKfARG(hek)); + else + /* diag_listed_as: SIG%s handler "%s" not defined */ + ck_warner(packWARN(WARN_SIGNAL), + "SIG%s handler \"__ANON__\" not defined.\n", + PL_sig_name[sig]); goto cleanup; } diff --git a/numeric.c b/numeric.c index 3d5d15551e83..61b9fa5278e8 100644 --- a/numeric.c +++ b/numeric.c @@ -361,7 +361,7 @@ S_output_non_portable(pTHX_ const U8 base) * are the first word, it would be hard for a user to find them there * starting with a %s */ /* diag_listed_as: Hexadecimal number > 0xffffffff non-portable */ - Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), "%s non-portable", which); + ck_warner(packWARN(WARN_PORTABLE), "%s non-portable", which); } UV @@ -529,12 +529,12 @@ Perl_grok_bin_oct_hex(pTHX_ const char *start, if ( ! (input_flags & PERL_SCAN_SILENT_OVERFLOW) && ckWARN_d(WARN_OVERFLOW)) { - Perl_warner(aTHX_ packWARN(WARN_OVERFLOW), - "Integer overflow in %s number", - (base == 16) ? "hexadecimal" - : (base == 2) - ? "binary" - : "octal"); + warner(packWARN(WARN_OVERFLOW), + "Integer overflow in %s number", + (base == 16) ? "hexadecimal" + : (base == 2) + ? "binary" + : "octal"); } } continue; @@ -561,12 +561,12 @@ Perl_grok_bin_oct_hex(pTHX_ const char *start, && ckWARN(WARN_DIGIT)) { if (base != 8) { - Perl_warner(aTHX_ packWARN(WARN_DIGIT), - "Illegal %s digit '%c' ignored", - ((base == 2) - ? "binary" - : "hexadecimal"), - *s); + warner(packWARN(WARN_DIGIT), + "Illegal %s digit '%c' ignored", + ((base == 2) + ? "binary" + : "hexadecimal"), + *s); } else if (isDIGIT(*s)) { /* octal base */ @@ -575,8 +575,8 @@ Perl_grok_bin_oct_hex(pTHX_ const char *start, * complain only if someone seems to want to use the digits * eight and nine. Since we know it is not octal, then if * isDIGIT, must be an 8 or 9). */ - Perl_warner(aTHX_ packWARN(WARN_DIGIT), - "Illegal octal digit '%c' ignored", *s); + warner(packWARN(WARN_DIGIT), + "Illegal octal digit '%c' ignored", *s); } } diff --git a/op.c b/op.c index 9136b76e3076..69ff030e88eb 100644 --- a/op.c +++ b/op.c @@ -1866,7 +1866,7 @@ S_scalarboolean(pTHX_ OP *o) of the conditional, not the last. */ CopLINE_set(PL_curcop, PL_parser->copline); } - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Found = in conditional, should be =="); + warner(packWARN(WARN_SYNTAX), "Found = in conditional, should be =="); CopLINE_set(PL_curcop, oldline); } } @@ -1950,9 +1950,9 @@ Perl_warn_elem_scalar_context(pTHX_ const OP *o, SV *name, bool is_hash, bool is PERL_DIAG_WARN_SYNTAX( "%%%" SVf "%c%s%c in scalar context better written as $%" SVf "%c%s%c"); - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), msg, - SVfARG(name), lbrack, keypv, rbrack, - SVfARG(name), lbrack, keypv, rbrack); + warner(packWARN(WARN_SYNTAX), msg, + SVfARG(name), lbrack, keypv, rbrack, + SVfARG(name), lbrack, keypv, rbrack); } else { msg = is_slice ? @@ -1963,9 +1963,9 @@ Perl_warn_elem_scalar_context(pTHX_ const OP *o, SV *name, bool is_hash, bool is PERL_DIAG_WARN_SYNTAX( "%%%" SVf "%c%" SVf "%c in scalar context better written as $%" SVf "%c%" SVf "%c"); - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), msg, - SVfARG(name), lbrack, SVfARG(keysv), rbrack, - SVfARG(name), lbrack, SVfARG(keysv), rbrack); + warner(packWARN(WARN_SYNTAX), msg, + SVfARG(name), lbrack, SVfARG(keysv), rbrack, + SVfARG(name), lbrack, SVfARG(keysv), rbrack); } } @@ -2068,7 +2068,7 @@ Perl_scalar(pTHX_ OP *o) break; case OP_SORT: - Perl_ck_warner(aTHX_ packWARN(WARN_SCALAR), "Useless use of %s in scalar context", "sort"); + ck_warner(packWARN(WARN_SCALAR), "Useless use of %s in scalar context", "sort"); break; case OP_KVHSLICE: @@ -2489,14 +2489,14 @@ Perl_scalarvoid(pTHX_ OP *arg) if (useless_sv) { /* mortalise it, in case warnings are fatal. */ - Perl_ck_warner(aTHX_ packWARN(WARN_VOID), - "Useless use of %" SVf " in void context", - SVfARG(sv_2mortal(useless_sv))); + ck_warner(packWARN(WARN_VOID), + "Useless use of %" SVf " in void context", + SVfARG(sv_2mortal(useless_sv))); } else if (useless) { - Perl_ck_warner(aTHX_ packWARN(WARN_VOID), - "Useless use of %s in void context", - useless); + ck_warner(packWARN(WARN_VOID), + "Useless use of %s in void context", + useless); } get_next_op: @@ -3490,9 +3490,8 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags) if (!FEATURE_MYREF_IS_ENABLED) croak("The experimental declared_refs " "feature is not enabled"); - Perl_ck_warner_d(aTHX_ - packWARN(WARN_EXPERIMENTAL__DECLARED_REFS), - "Declaring references is experimental"); + ck_warner_d(packWARN(WARN_EXPERIMENTAL__DECLARED_REFS), + "Declaring references is experimental"); next_kid = cUNOPo->op_first; goto do_next; } @@ -3516,9 +3515,8 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags) if (!FEATURE_REFALIASING_IS_ENABLED) croak( "Experimental aliasing via reference not enabled"); - Perl_ck_warner_d(aTHX_ - packWARN(WARN_EXPERIMENTAL__REFALIASING), - "Aliasing via reference is experimental"); + ck_warner_d(packWARN(WARN_EXPERIMENTAL__REFALIASING), + "Aliasing via reference is experimental"); } } if (o->op_type == OP_REFGEN) @@ -3578,8 +3576,8 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags) case 0: break; case -1: - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), - "Useless localization of %s", OP_DESC(o)); + ck_warner(packWARN(WARN_SYNTAX), + "Useless localization of %s", OP_DESC(o)); } } else if (type != OP_GREPSTART && type != OP_ENTERSUB @@ -4040,9 +4038,9 @@ S_move_proto_attr(pTHX_ OP **proto, OP **attrs, const GV * name, if (new_proto && ckWARN(WARN_MISC)) { STRLEN new_len; const char * newp = SvPV(cSVOPo_sv, new_len); - Perl_warner(aTHX_ packWARN(WARN_MISC), - "Attribute prototype(%" UTF8f ") discards earlier prototype attribute in same sub", - UTF8fARG(SvUTF8(cSVOPo_sv), new_len, newp)); + warner(packWARN(WARN_MISC), + "Attribute prototype(%" UTF8f ") discards earlier prototype attribute in same sub", + UTF8fARG(SvUTF8(cSVOPo_sv), new_len, newp)); } op_free(new_proto); new_proto = o; @@ -4087,12 +4085,12 @@ S_move_proto_attr(pTHX_ OP **proto, OP **attrs, const GV * name, sv_catsv(svname, (SV *)name); } - Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE), - "Prototype '%" UTF8f "' overridden by attribute 'prototype(%" UTF8f ")'" - " in %" SVf, - UTF8fARG(SvUTF8(cSVOPx_sv(*proto)), old_len, oldp), - UTF8fARG(SvUTF8(cSVOPx_sv(new_proto)), new_len, newp), - SVfARG(svname)); + warner(packWARN(WARN_PROTOTYPE), + "Prototype '%" UTF8f "' overridden by attribute 'prototype(%" UTF8f ")'" + " in %" SVf, + UTF8fARG(SvUTF8(cSVOPx_sv(*proto)), old_len, oldp), + UTF8fARG(SvUTF8(cSVOPx_sv(new_proto)), new_len, newp), + SVfARG(svname)); } op_free(*proto); *proto = new_proto; @@ -4158,9 +4156,8 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp) if (!FEATURE_MYREF_IS_ENABLED) croak("The experimental declared_refs " "feature is not enabled"); - Perl_ck_warner_d(aTHX_ - packWARN(WARN_EXPERIMENTAL__DECLARED_REFS), - "Declaring references is experimental"); + ck_warner_d(packWARN(WARN_EXPERIMENTAL__DECLARED_REFS), + "Declaring references is experimental"); /* Kid is a nulled OP_LIST, handled above. */ my_kid(cUNOPo->op_first, attrs, imopsp); return o; @@ -4271,15 +4268,15 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right) const bool isary = ltype == OP_RV2AV || ltype == OP_PADAV; SV * const name = op_varname(left); if (name) - Perl_warner(aTHX_ packWARN(WARN_MISC), - "Applying %s to %" SVf " will act on scalar(%" SVf ")", - desc, SVfARG(name), SVfARG(name)); + warner(packWARN(WARN_MISC), + "Applying %s to %" SVf " will act on scalar(%" SVf ")", + desc, SVfARG(name), SVfARG(name)); else { const char * const sample = (isary ? "@array" : "%hash"); - Perl_warner(aTHX_ packWARN(WARN_MISC), - "Applying %s to %s will act on scalar(%s)", - desc, sample, sample); + warner(packWARN(WARN_MISC), + "Applying %s to %s will act on scalar(%s)", + desc, sample, sample); } } @@ -4317,9 +4314,8 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right) } else { if (left->op_type == OP_NOT && !(left->op_flags & OPf_PARENS)) { - Perl_ck_warner(aTHX_ packWARN(WARN_PRECEDENCE), - "Possible precedence problem between ! and %s", PL_op_desc[rtype] - ); + ck_warner(packWARN(WARN_PRECEDENCE), + "Possible precedence problem between ! and %s", PL_op_desc[rtype]); } right->op_flags |= OPf_STACKED; if (rtype != OP_MATCH && rtype != OP_TRANSR && @@ -4382,8 +4378,8 @@ S_is_control_transfer(pTHX_ OP *op) sub { not FEATURE and return or do_stuff(); } */ if (!op->op_folded && !(op->op_flags & OPf_PARENS)) - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), - "Possible precedence issue with control flow operator (%s)", OP_DESC(op)); + ck_warner(packWARN(WARN_SYNTAX), + "Possible precedence issue with control flow operator (%s)", OP_DESC(op)); return true; } @@ -4845,15 +4841,15 @@ Perl_localize(pTHX_ OP *o, I32 lex) break; } if (sigil && (*s == ';' || *s == '=')) { - Perl_warner(aTHX_ packWARN(WARN_PARENTHESIS), - "Parentheses missing around \"%s\" list", - lex - ? (PL_parser->in_my == KEY_our - ? "our" - : PL_parser->in_my == KEY_state - ? "state" - : "my") - : "local"); + warner(packWARN(WARN_PARENTHESIS), + "Parentheses missing around \"%s\" list", + lex + ? (PL_parser->in_my == KEY_our + ? "our" + : PL_parser->in_my == KEY_state + ? "state" + : "my") + : "local"); } } } @@ -7469,9 +7465,9 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl) Safefree(r_map); if(del && rlen != 0 && r_count == t_count) { - Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Useless use of /d modifier in transliteration operator"); + ck_warner(packWARN(WARN_MISC), "Useless use of /d modifier in transliteration operator"); } else if(r_count > t_count) { - Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Replacement list is longer than search list"); + ck_warner(packWARN(WARN_MISC), "Replacement list is longer than search list"); } op_free(expr); @@ -9086,7 +9082,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) if (cstop->op_private & OPpCONST_STRICT) no_bareword_allowed(cstop); else if ((cstop->op_private & OPpCONST_BARE)) - Perl_ck_warner(aTHX_ packWARN(WARN_BAREWORD), "Bareword found in conditional"); + ck_warner(packWARN(WARN_BAREWORD), "Bareword found in conditional"); if ((type == OP_AND && SvTRUE(cSVOPx(cstop)->op_sv)) || (type == OP_OR && !SvTRUE(cSVOPx(cstop)->op_sv)) || (type == OP_DOR && !SvOK(cSVOPx(cstop)->op_sv))) { @@ -9169,11 +9165,11 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) /* This ensures that warnings are reported at the first line of the construction, not the last. */ CopLINE_set(PL_curcop, PL_parser->copline); - 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) - ? " construct" : "() operator")); + warner(packWARN(WARN_MISC), + "Value of %s%s can be \"0\"; test with defined()", + PL_op_desc[warnop], + ((warnop == OP_READLINE || warnop == OP_GLOB) + ? " construct" : "() operator")); CopLINE_set(PL_curcop, oldline); } } @@ -10395,7 +10391,7 @@ Perl_cv_ckproto_len_flags(pTHX_ const CV *cv, const GV *gv, const char *p, sv_catpvf(msg, "(%" UTF8f ")", UTF8fARG(flags & SVf_UTF8,len,p)); else sv_catpvs(msg, "none"); - Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE), "%" SVf, SVfARG(msg)); + warner(packWARN(WARN_PROTOTYPE), "%" SVf, SVfARG(msg)); } static void const_sv_xsub(pTHX_ CV* cv); @@ -10516,7 +10512,7 @@ S_already_defined(pTHX_ CV *const cv, OP * const block, OP * const o, { /* protect against fatal warnings leaking compcv */ SAVEFREESV(PL_compcv); - Perl_warner(aTHX_ packWARN(WARN_MISC), "lvalue attribute ignored after the subroutine has been defined"); + warner(packWARN(WARN_MISC), "lvalue attribute ignored after the subroutine has been defined"); SvREFCNT_inc_simple_void_NN(PL_compcv); } CvFLAGS(cv) |= @@ -11120,10 +11116,10 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, * nonexistent sub. */ if (proto) /* diag_listed_as: %s on BEGIN block ignored */ - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Prototype on BEGIN block ignored"); + warner(packWARN(WARN_SYNTAX), "Prototype on BEGIN block ignored"); if (attrs) /* diag_listed_as: %s on BEGIN block ignored */ - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Attribute on BEGIN block ignored"); + warner(packWARN(WARN_SYNTAX), "Attribute on BEGIN block ignored"); proto = NULL; attrs = NULL; } @@ -11253,9 +11249,9 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, || SvTYPE(SvRV(gv)) == SVt_PVAV || sv_cmp(SvRV(gv), const_sv) ))) { assert(cSVOPo); - Perl_warner(aTHX_ packWARN(WARN_REDEFINE), - "Constant subroutine %" SVf " redefined", - SVfARG(cSVOPo->op_sv)); + warner(packWARN(WARN_REDEFINE), + "Constant subroutine %" SVf " redefined", + SVfARG(cSVOPo->op_sv)); } SvREFCNT_inc_simple_void_NN(PL_compcv); @@ -11689,8 +11685,8 @@ S_process_special_blocks(pTHX_ I32 floor, const char *const fullname, if (strEQ(name, "CHECK")) { if (PL_main_start) /* diag_listed_as: Too late to run %s block */ - Perl_ck_warner(aTHX_ packWARN(WARN_VOID), - "Too late to run CHECK block"); + ck_warner(packWARN(WARN_VOID), + "Too late to run CHECK block"); Perl_av_create_and_unshift_one(aTHX_ &PL_checkav, MUTABLE_SV(cv)); } else @@ -11721,8 +11717,8 @@ S_process_special_blocks(pTHX_ I32 floor, const char *const fullname, #endif if (PL_main_start) /* diag_listed_as: Too late to run %s block */ - Perl_ck_warner(aTHX_ packWARN(WARN_VOID), - "Too late to run INIT block"); + ck_warner(packWARN(WARN_VOID), + "Too late to run INIT block"); Perl_av_create_and_push(aTHX_ &PL_initav, MUTABLE_SV(cv)); } else @@ -12128,12 +12124,12 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block) if (PL_parser && PL_parser->copline != NOLINE) CopLINE_set(PL_curcop, PL_parser->copline); if (o) { - Perl_warner(aTHX_ packWARN(WARN_REDEFINE), - "Format %" SVf " redefined", SVfARG(cSVOPo->op_sv)); + warner(packWARN(WARN_REDEFINE), + "Format %" SVf " redefined", SVfARG(cSVOPo->op_sv)); } else { /* diag_listed_as: Format %s redefined */ - Perl_warner(aTHX_ packWARN(WARN_REDEFINE), - "Format STDOUT redefined"); + warner(packWARN(WARN_REDEFINE), + "Format STDOUT redefined"); } CopLINE_set(PL_curcop, oldline); } @@ -12265,7 +12261,7 @@ Perl_oopsAV(pTHX_ OP *o) break; default: - Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), "oops: oopsAV"); + ck_warner_d(packWARN(WARN_INTERNAL), "oops: oopsAV"); break; } return o; @@ -12292,7 +12288,7 @@ Perl_oopsHV(pTHX_ OP *o) break; default: - Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), "oops: oopsHV"); + ck_warner_d(packWARN(WARN_INTERNAL), "oops: oopsHV"); break; } return o; @@ -12517,17 +12513,17 @@ Perl_ck_bitop(pTHX_ OP *o) (left->op_flags & OPf_PARENS) == 0) || (OP_IS_NUMCOMPARE(right->op_type) && (right->op_flags & OPf_PARENS) == 0)) - Perl_ck_warner(aTHX_ packWARN(WARN_PRECEDENCE), - "Possible precedence problem on bitwise %s operator", - o->op_type == OP_BIT_OR - ||o->op_type == OP_NBIT_OR ? "|" - : o->op_type == OP_BIT_AND - ||o->op_type == OP_NBIT_AND ? "&" - : o->op_type == OP_BIT_XOR - ||o->op_type == OP_NBIT_XOR ? "^" - : o->op_type == OP_SBIT_OR ? "|." - : o->op_type == OP_SBIT_AND ? "&." : "^." - ); + ck_warner(packWARN(WARN_PRECEDENCE), + "Possible precedence problem on bitwise %s operator", + o->op_type == OP_BIT_OR + ||o->op_type == OP_NBIT_OR ? "|" + : o->op_type == OP_BIT_AND + ||o->op_type == OP_NBIT_AND ? "&" + : o->op_type == OP_BIT_XOR + ||o->op_type == OP_NBIT_XOR ? "^" + : o->op_type == OP_SBIT_OR ? "|." + : o->op_type == OP_SBIT_AND ? "&." : "^." + ); } return o; } @@ -12551,7 +12547,7 @@ check_precedence_not_vs_cmp(pTHX_ const OP *const o) || cUNOPx(left)->op_first->op_type != OP_NOT ) ) { - Perl_ck_warner(aTHX_ packWARN(WARN_PRECEDENCE), + ck_warner(packWARN(WARN_PRECEDENCE), "Possible precedence problem between ! and %s", OP_DESC(o) ); } @@ -12600,8 +12596,8 @@ Perl_ck_cmp(pTHX_ OP *o) ) ) ) - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), - "$[ used in %s (did you mean $] ?)", OP_DESC(o)); + warner(packWARN(WARN_SYNTAX), + "$[ used in %s (did you mean $] ?)", OP_DESC(o)); } check_precedence_not_vs_cmp(aTHX_ o); @@ -13135,12 +13131,12 @@ Perl_ck_ftst(pTHX_ OP *o) SV *name = S_op_varname_subscript(aTHX_ (OP*)kid, 2); if (name) { /* diag_listed_as: Array passed to stat will be coerced to a scalar%s */ - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "%s (did you want stat %" SVf "?)", - array_passed_to_stat, name); + warner(packWARN(WARN_SYNTAX), "%s (did you want stat %" SVf "?)", + array_passed_to_stat, name); } else { /* diag_listed_as: Array passed to stat will be coerced to a scalar%s */ - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "%s", array_passed_to_stat); + warner(packWARN(WARN_SYNTAX), "%s", array_passed_to_stat); } } scalar((OP *) kid); @@ -13239,9 +13235,9 @@ Perl_ck_fun(pTHX_ OP *o) case OA_AVREF: if ((type == OP_PUSH || type == OP_UNSHIFT) && !OpHAS_SIBLING(kid)) - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), - "Useless use of %s with no values", - PL_op_desc[type]); + ck_warner(packWARN(WARN_SYNTAX), + "Useless use of %s with no values", + PL_op_desc[type]); if (kid->op_type == OP_CONST && ( !SvROK(cSVOPx_sv(kid)) @@ -14023,9 +14019,8 @@ Perl_ck_refassign(pTHX_ OP *o) if (!FEATURE_REFALIASING_IS_ENABLED) croak( "Experimental aliasing via reference not enabled"); - Perl_ck_warner_d(aTHX_ - packWARN(WARN_EXPERIMENTAL__REFALIASING), - "Aliasing via reference is experimental"); + ck_warner_d(packWARN(WARN_EXPERIMENTAL__REFALIASING), + "Aliasing via reference is experimental"); if (stacked) { o->op_flags |= OPf_STACKED; op_sibling_splice(o, right, 1, varop); @@ -14352,12 +14347,10 @@ S_simplify_sort(pTHX_ OP *o) && ( PadnamePV(name)[1] == 'a' || PadnamePV(name)[1] == 'b' )) /* diag_listed_as: "my %s" used in sort comparison */ - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), - "\"%s %s\" used in sort comparison", - PadnameIsSTATE(name) - ? "state" - : "my", - PadnamePV(name)); + warner(packWARN(WARN_SYNTAX), + "\"%s %s\" used in sort comparison", + PadnameIsSTATE(name) ? "state" : "my", + PadnamePV(name)); } } while ((kid = OpSIBLING(kid))); return; @@ -14437,8 +14430,8 @@ Perl_ck_split(pTHX_ OP *o) assert(kid->op_type == OP_MATCH || kid->op_type == OP_SPLIT); if (kPMOP->op_pmflags & PMf_GLOBAL) { - Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), - "Use of /g modifier is meaningless in split"); + ck_warner(packWARN(WARN_REGEXP), + "Use of /g modifier is meaningless in split"); } /* eliminate the split op, and move the match op (plus any children) @@ -14516,9 +14509,9 @@ Perl_ck_join(pTHX_ OP *o) ? newSVpvn_flags( RX_PRECOMP_const(re), RX_PRELEN(re), SVs_TEMP | ( RX_UTF8(re) ? SVf_UTF8 : 0 ) ) : newSVpvs_flags( "STRING", SVs_TEMP ); - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), - "/%" SVf "/ should probably be written as \"%" SVf "\"", - SVfARG(msg), SVfARG(msg)); + warner(packWARN(WARN_SYNTAX), + "/%" SVf "/ should probably be written as \"%" SVf "\"", + SVfARG(msg), SVfARG(msg)); } } if (kid @@ -15563,7 +15556,7 @@ Perl_ck_each(pTHX_ OP *o) OP *k = S_last_non_null_kid(cUNOPx(kid)->op_first); if (k && k->op_type == OP_ANONHASH) { /* diag_listed_as: each on anonymous %s will always start from the beginning */ - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "each on anonymous hash will always start from the beginning"); + warner(packWARN(WARN_SYNTAX), "each on anonymous hash will always start from the beginning"); } } break; @@ -15577,7 +15570,7 @@ Perl_ck_each(pTHX_ OP *o) OP *k = S_last_non_null_kid(cUNOPx(kid)->op_first); if (k && k->op_type == OP_ANONLIST) { /* diag_listed_as: each on anonymous %s will always start from the beginning */ - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "each on anonymous array will always start from the beginning"); + warner(packWARN(WARN_SYNTAX), "each on anonymous array will always start from the beginning"); } } /* FALLTHROUGH */ @@ -15631,18 +15624,18 @@ Perl_ck_length(pTHX_ OP *o) return o; } if (name) - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), + warner(packWARN(WARN_SYNTAX), "length() used on %" SVf " (did you mean \"scalar(%s%" SVf ")\"?)", SVfARG(name), hash ? "keys " : "", SVfARG(name) ); else if (hash) /* diag_listed_as: length() used on %s (did you mean "scalar(%s)"?) */ - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), + warner(packWARN(WARN_SYNTAX), "length() used on %%hash (did you mean \"scalar(keys %%hash)\"?)"); else /* diag_listed_as: length() used on %s (did you mean "scalar(%s)"?) */ - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), + warner(packWARN(WARN_SYNTAX), "length() used on @array (did you mean \"scalar(@array)\"?)"); } } @@ -15667,7 +15660,7 @@ Perl_ck_isa(pTHX_ OP *o) OP *const objop = cBINOPo->op_first; /* !$x isa Some::Class # probably meant !($x isa Some::Class) */ if (objop->op_type == OP_NOT && !(objop->op_flags & OPf_PARENS)) { - Perl_ck_warner(aTHX_ packWARN(WARN_PRECEDENCE), + ck_warner(packWARN(WARN_PRECEDENCE), "Possible precedence problem between ! and %s", OP_DESC(o) ); } @@ -16179,13 +16172,13 @@ Perl_report_redefined_cv(pTHX_ const SV *name, const CV *old_cv, sv_cmp(old_const_sv, *new_const_svp)) ) ) { - Perl_warner(aTHX_ packWARN(WARN_REDEFINE), - is_const - ? "Constant subroutine %" SVf " redefined" - : CvIsMETHOD(old_cv) - ? "Method %" SVf " redefined" - : "Subroutine %" SVf " redefined", - SVfARG(name)); + warner(packWARN(WARN_REDEFINE), + is_const + ? "Constant subroutine %" SVf " redefined" + : CvIsMETHOD(old_cv) + ? "Method %" SVf " redefined" + : "Subroutine %" SVf " redefined", + SVfARG(name)); } } diff --git a/os2/os2.c b/os2/os2.c index 51162c5c3ae0..2575ddd823a3 100644 --- a/os2/os2.c +++ b/os2/os2.c @@ -1057,7 +1057,7 @@ do_spawn_ve(pTHX_ SV *really, const char **argv, U32 flag, U32 execf, char *inic if (flag == P_NOWAIT) flag = P_PM; else if ((flag & 7) != P_PM && (flag & 7) != P_SESSION && ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC), "Starting PM process with flag=%d, mytype=%d", + warner(packWARN(WARN_EXEC), "Starting PM process with flag=%d, mytype=%d", flag, os2_mytype); } } @@ -1068,7 +1068,7 @@ do_spawn_ve(pTHX_ SV *really, const char **argv, U32 flag, U32 execf, char *inic if (flag == P_NOWAIT) flag = P_SESSION; else if ((flag & 7) != P_SESSION && ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC), "Starting Full Screen process with flag=%d, mytype=%d", + warner(packWARN(WARN_EXEC), "Starting Full Screen process with flag=%d, mytype=%d", flag, os2_mytype); } } @@ -1166,7 +1166,7 @@ do_spawn_ve(pTHX_ SV *really, const char **argv, U32 flag, U32 execf, char *inic if (PerlIO_close(file) != 0) { /* Failure */ panic_file: if (ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC), "Error reading \"%s\": %s", + warner(packWARN(WARN_EXEC), "Error reading \"%s\": %s", scr, Strerror(errno)); buf = ""; /* Not #! */ goto doshell_args; @@ -1210,7 +1210,7 @@ do_spawn_ve(pTHX_ SV *really, const char **argv, U32 flag, U32 execf, char *inic *s++ = 0; } if (nargs == -1) { - Perl_warner(aTHX_ packWARN(WARN_EXEC), "Too many args on %.*s line of \"%s\"", + warner(packWARN(WARN_EXEC), "Too many args on %.*s line of \"%s\"", s1 - buf, buf, scr); nargs = 4; argsp = fargs; @@ -1301,14 +1301,14 @@ do_spawn_ve(pTHX_ SV *really, const char **argv, U32 flag, U32 execf, char *inic } } else if (errno == ENOEXEC) { /* Cannot transfer `real_name' via shell. */ if (rc < 0 && ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s script `%s' with ARGV[0] being `%s'", + warner(packWARN(WARN_EXEC), "Can't %s script `%s' with ARGV[0] being `%s'", ((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC) ? "spawn" : "exec"), real_name, argv[0]); goto warned; } else if (errno == ENOENT) { /* Cannot transfer `real_name' via shell. */ if (rc < 0 && ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s `%s' with ARGV[0] being `%s' (looking for executables only, not found)", + warner(packWARN(WARN_EXEC), "Can't %s `%s' with ARGV[0] being `%s' (looking for executables only, not found)", ((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC) ? "spawn" : "exec"), real_name, argv[0]); @@ -1326,7 +1326,7 @@ do_spawn_ve(pTHX_ SV *really, const char **argv, U32 flag, U32 execf, char *inic } } if (rc < 0 && ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s \"%s\": %s\n", + warner(packWARN(WARN_EXEC), "Can't %s \"%s\": %s\n", ((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC) ? "spawn" : "exec"), real_name, Strerror(errno)); @@ -1437,7 +1437,7 @@ do_spawn3(pTHX_ char *cmd, int execf, int flag) rc = result(aTHX_ P_WAIT, spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0)); if (rc < 0 && ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s \"%s\": %s", + warner(packWARN(WARN_EXEC), "Can't %s \"%s\": %s", (execf == EXECF_SPAWN ? "spawn" : "exec"), shell, Strerror(errno)); if (rc < 0) diff --git a/pad.c b/pad.c index 11fc12ba7cde..c33ddc5ea8f9 100644 --- a/pad.c +++ b/pad.c @@ -900,7 +900,7 @@ S_pad_check_dup(pTHX_ PADNAME *name, U32 flags, const HV *ourstash) PadnameFIELDINFO(pn)->fieldstash != PL_curstash) break; /* field of a different class */ /* diag_listed_as: "%s" variable %s masks earlier declaration in same %s */ - Perl_warner(aTHX_ packWARN(WARN_SHADOW), + warner(packWARN(WARN_SHADOW), "\"%s\" %s %" PNf " masks earlier declaration in same %s", ( is_our ? "our" : PL_parser->in_my == KEY_my ? "my" : @@ -927,10 +927,10 @@ S_pad_check_dup(pTHX_ PADNAME *name, U32 flags, const HV *ourstash) && PadnameOURSTASH(pn) == ourstash && memEQ(PadnamePV(pn), PadnamePV(name), PadnameLEN(name))) { - Perl_warner(aTHX_ packWARN(WARN_SHADOW), + warner(packWARN(WARN_SHADOW), "\"our\" variable %" PNf " redeclared", PNfARG(pn)); if (off <= PL_comppad_name_floor) - Perl_warner(aTHX_ packWARN(WARN_SHADOW), + warner(packWARN(WARN_SHADOW), "\t(Did you mean \"local\" instead of \"our\"?)\n"); break; } @@ -1092,12 +1092,12 @@ static void S_unavailable(pTHX_ PADNAME *name) { /* diag_listed_as: Variable "%s" is not available */ - Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE), - "%s \"%" PNf "\" is not available", - *PadnamePV(name) == '&' - ? "Subroutine" - : "Variable", - PNfARG(name)); + ck_warner(packWARN(WARN_CLOSURE), + "%s \"%" PNf "\" is not available", + *PadnamePV(name) == '&' + ? "Subroutine" + : "Variable", + PNfARG(name)); } STATIC PADOFFSET @@ -1216,7 +1216,7 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv, newwarn = 0; /* diag_listed_as: Variable "%s" will not stay shared */ - Perl_warner(aTHX_ packWARN(WARN_CLOSURE), + warner(packWARN(WARN_CLOSURE), "%s \"%" UTF8f "\" will not stay shared", *namepv == '&' ? "Subroutine" : "Variable", UTF8fARG(1, namelen, namepv)); @@ -1516,9 +1516,9 @@ Perl_pad_leavemy(pTHX) for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) { const PADNAME * const name = svp[off]; if (name && PadnameLEN(name) && !PadnameOUTER(name)) - Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), - "%" PNf " never introduced", - PNfARG(name)); + ck_warner_d(packWARN(WARN_INTERNAL), + "%" PNf " never introduced", + PNfARG(name)); } } /* "Deintroduce" my variables that are leaving with this scope. */ diff --git a/peep.c b/peep.c index 032fbbfc0728..5980ea1c2fca 100644 --- a/peep.c +++ b/peep.c @@ -1053,7 +1053,7 @@ S_warn_implicit_snail_cvsig(pTHX_ OP *o) cv = CvOUTSIDE(cv); if(cv && CvSIGNATURE(cv)) - Perl_ck_warner_d(aTHX_ packWARN(WARN_EXPERIMENTAL__ARGS_ARRAY_WITH_SIGNATURES), + ck_warner_d(packWARN(WARN_EXPERIMENTAL__ARGS_ARRAY_WITH_SIGNATURES), "Implicit use of @_ in %s with signatured subroutine is experimental", OP_DESC(o)); } @@ -1116,7 +1116,7 @@ S_optimize_op(pTHX_ OP* o) while(OP_TYPE_IS(parent, OP_NULL)) parent = op_parent(parent); - Perl_ck_warner_d(aTHX_ packWARN(WARN_EXPERIMENTAL__ARGS_ARRAY_WITH_SIGNATURES), + ck_warner_d(packWARN(WARN_EXPERIMENTAL__ARGS_ARRAY_WITH_SIGNATURES), "Use of @_ in %s with signatured subroutine is experimental", OP_DESC(parent)); } break; @@ -1259,9 +1259,9 @@ S_finalize_op(pTHX_ OP* o) if (type != OP_EXIT && type != OP_WARN && type != OP_DIE) { const line_t oldline = CopLINE(PL_curcop); CopLINE_set(PL_curcop, CopLINE((COP*)sib)); - Perl_warner(aTHX_ packWARN(WARN_EXEC), + warner(packWARN(WARN_EXEC), "Statement unlikely to be reached"); - Perl_warner(aTHX_ packWARN(WARN_EXEC), + warner(packWARN(WARN_EXEC), "\t(Maybe you meant system() when you said exec()?)\n"); CopLINE_set(PL_curcop, oldline); } @@ -1276,9 +1276,9 @@ S_finalize_op(pTHX_ OP* o) /* XXX could check prototype here instead of just carping */ SV * const sv = sv_newmortal(); gv_efullname3(sv, gv, NULL); - Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE), - "%" SVf "() called too early to check prototype", - SVfARG(sv)); + warner(packWARN(WARN_PROTOTYPE), + "%" SVf "() called too early to check prototype", + SVfARG(sv)); } } break; diff --git a/perl.c b/perl.c index cf137dc73136..b25f4514532c 100644 --- a/perl.c +++ b/perl.c @@ -1304,19 +1304,19 @@ perl_destruct(pTHXx) FREETMPS; if (destruct_level >= 2) { if (PL_scopestack_ix != 0) - Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), - "Unbalanced scopes: %ld more ENTERs than LEAVEs\n", - (long)PL_scopestack_ix); + ck_warner_d(packWARN(WARN_INTERNAL), + "Unbalanced scopes: %ld more ENTERs than LEAVEs\n", + (long)PL_scopestack_ix); if (PL_savestack_ix != 0) - Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), - "Unbalanced saves: %ld more saves than restores\n", - (long)PL_savestack_ix); + ck_warner_d(packWARN(WARN_INTERNAL), + "Unbalanced saves: %ld more saves than restores\n", + (long)PL_savestack_ix); if (PL_tmps_floor != -1) - Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),"Unbalanced tmps: %ld more allocs than frees\n", - (long)PL_tmps_floor + 1); + ck_warner_d(packWARN(WARN_INTERNAL),"Unbalanced tmps: %ld more allocs than frees\n", + (long)PL_tmps_floor + 1); if (cxstack_ix != -1) - Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),"Unbalanced context: %ld more PUSHes than POPs\n", - (long)cxstack_ix + 1); + ck_warner_d(packWARN(WARN_INTERNAL),"Unbalanced context: %ld more PUSHes than POPs\n", + (long)cxstack_ix + 1); } #ifdef USE_ITHREADS @@ -1371,9 +1371,9 @@ perl_destruct(pTHXx) for (;;) { if (hent && ckWARN_d(WARN_INTERNAL)) { HE * const next = HeNEXT(hent); - Perl_warner(aTHX_ packWARN(WARN_INTERNAL), - "Unbalanced string table refcount: (%ld) for \"%s\"", - (long)hent->he_valu.hent_refcount, HeKEY(hent)); + warner(packWARN(WARN_INTERNAL), + "Unbalanced string table refcount: (%ld) for \"%s\"", + (long)hent->he_valu.hent_refcount, HeKEY(hent)); Safefree(hent); hent = next; } @@ -1424,7 +1424,7 @@ perl_destruct(pTHXx) } if (PL_sv_count != 0 && ckWARN_d(WARN_INTERNAL)) - Perl_warner(aTHX_ packWARN(WARN_INTERNAL),"Scalars leaked: %ld\n", (long)PL_sv_count); + warner(packWARN(WARN_INTERNAL),"Scalars leaked: %ld\n", (long)PL_sv_count); #ifdef DEBUG_LEAKING_SCALARS if (PL_sv_count != 0) { @@ -2559,7 +2559,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) #endif Sighandler_t sigstate = rsignal_state(SIGCHLD); if (sigstate == (Sighandler_t) SIG_IGN) { - Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL), + ck_warner(packWARN(WARN_SIGNAL), "Can't ignore signal CHLD, forcing to default"); (void)rsignal(SIGCHLD, (Sighandler_t)SIG_DFL); } @@ -3646,7 +3646,7 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp) if (d) uv |= 1 << (d - debopts); else if (ckWARN_d(WARN_DEBUGGING)) - Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), + warner(packWARN(WARN_DEBUGGING), "invalid option -D%c, use -D'' to see choices\n", **s); } } @@ -3805,7 +3805,7 @@ Perl_moreswitches(pTHX_ const char *s) PL_debug = get_debug_opts( (const char **)&s, 1) | DEBUG_TOP_FLAG; #else /* !DEBUGGING */ if (ckWARN_d(WARN_DEBUGGING)) - Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), + warner(packWARN(WARN_DEBUGGING), "Recompile perl with -DDEBUGGING to use -D switch (did you mean -d ?)\n"); for (s++; isWORDCHAR(*s); s++) ; #endif @@ -4734,9 +4734,9 @@ Perl_init_argv_symbols(pTHX_ int argc, char **argv) } if (PL_inplace && (!PL_argvgv || AvFILL(GvAV(PL_argvgv)) == -1)) - Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE), - "-i used with no filenames on the command line, " - "reading from STDIN"); + ck_warner_d(packWARN(WARN_INPLACE), + "-i used with no filenames on the command line, " + "reading from STDIN"); } STATIC void diff --git a/perlio.c b/perlio.c index 90afd9990e66..3f611442021b 100644 --- a/perlio.c +++ b/perlio.c @@ -903,9 +903,9 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names) * seen as an invalid separator character. */ const char q = ((*s == '\'') ? '"' : '\''); - Perl_ck_warner(aTHX_ packWARN(WARN_LAYER), - "Invalid separator character %c%c%c in PerlIO layer specification %s", - q, *s, q, s); + ck_warner(packWARN(WARN_LAYER), + "Invalid separator character %c%c%c in PerlIO layer specification %s", + q, *s, q, s); SETERRNO(EINVAL, LIB_INVARG); return -1; } @@ -937,9 +937,9 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names) /* Fall through */ case '\0': e--; - Perl_ck_warner(aTHX_ packWARN(WARN_LAYER), - "Argument list not closed for PerlIO layer \"%.*s\"", - (int) (e - s), s); + ck_warner(packWARN(WARN_LAYER), + "Argument list not closed for PerlIO layer \"%.*s\"", + (int) (e - s), s); return -1; default: /* @@ -961,8 +961,8 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names) SvREFCNT_dec(arg); } else { - Perl_ck_warner(aTHX_ packWARN(WARN_LAYER), "Unknown PerlIO layer \"%.*s\"", - (int) llen, s); + ck_warner(packWARN(WARN_LAYER), "Unknown PerlIO layer \"%.*s\"", + (int) llen, s); return -1; } } @@ -1087,7 +1087,7 @@ PerlIOScalar_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg, if (SvREADONLY(SvRV(arg)) && !SvIsCOW(SvRV(arg)) && mode && *mode != 'r') { if (ckWARN(WARN_LAYER)) - Perl_warner(aTHX_ packWARN(WARN_LAYER), "%s", PL_no_modify); + warner(packWARN(WARN_LAYER), "%s", PL_no_modify); SETERRNO(EACCES, RMS_PRV); return -1; } @@ -1116,7 +1116,7 @@ PerlIOScalar_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg, } if (SvUTF8(s->var) && !sv_utf8_downgrade(s->var, TRUE)) { if (ckWARN(WARN_UTF8)) - Perl_warner(aTHX_ packWARN(WARN_UTF8), code_point_warning); + warner(packWARN(WARN_UTF8), code_point_warning); SETERRNO(EINVAL, SS_IVCHAN); SvREFCNT_dec(s->var); s->var = NULL; @@ -1182,7 +1182,7 @@ PerlIOScalar_seek(pTHX_ PerlIO * f, Off_t offset, int whence) } if (new_posn < 0) { if (ckWARN(WARN_LAYER)) - Perl_warner(aTHX_ packWARN(WARN_LAYER), "Offset outside string"); + warner(packWARN(WARN_LAYER), "Offset outside string"); SETERRNO(EINVAL, SS_IVCHAN); return -1; } @@ -1222,7 +1222,7 @@ PerlIOScalar_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) } else { if (ckWARN(WARN_UTF8)) - Perl_warner(aTHX_ packWARN(WARN_UTF8), code_point_warning); + warner(packWARN(WARN_UTF8), code_point_warning); SETERRNO(EINVAL, SS_IVCHAN); return -1; } @@ -1266,7 +1266,7 @@ PerlIOScalar_write(pTHX_ PerlIO * f, const void *vbuf, Size_t count) if (SvOK(sv)) SvPV_force_nomg_nolen(sv); if (SvUTF8(sv) && !sv_utf8_downgrade(sv, TRUE)) { if (ckWARN(WARN_UTF8)) - Perl_warner(aTHX_ packWARN(WARN_UTF8), code_point_warning); + warner(packWARN(WARN_UTF8), code_point_warning); SETERRNO(EINVAL, SS_IVCHAN); return 0; } diff --git a/pp.c b/pp.c index 7a2952d33073..b24cd428496b 100644 --- a/pp.c +++ b/pp.c @@ -617,8 +617,8 @@ PP(pp_bless) } else ptr = SvPV_nomg_const(ssv,len); if (len == 0) - Perl_ck_warner(aTHX_ packWARN(WARN_MISC), - "Explicit blessing to '' (assuming package main)"); + ck_warner(packWARN(WARN_MISC), + "Explicit blessing to '' (assuming package main)"); stash = gv_stashpvn(ptr, len, GV_ADD|SvUTF8(ssv)); } @@ -972,16 +972,16 @@ PP(pp_undef) break; case SVt_PVCV: if (cv_const_sv((const CV *)sv)) - Perl_ck_warner(aTHX_ packWARN(WARN_MISC), - "Constant subroutine %" SVf " undefined", - SVfARG(CvANON((const CV *)sv) - ? newSVpvs_flags("(anonymous)", SVs_TEMP) - : newSVhek_mortal( - CvNAMED(sv) - ? CvNAME_HEK((CV *)sv) - : GvENAME_HEK(CvGV((const CV *)sv)) - ) - )); + ck_warner(packWARN(WARN_MISC), + "Constant subroutine %" SVf " undefined", + SVfARG(CvANON((const CV *)sv) + ? newSVpvs_flags("(anonymous)", SVs_TEMP) + : newSVhek_mortal( + CvNAMED(sv) + ? CvNAME_HEK((CV *)sv) + : GvENAME_HEK(CvGV((const CV *)sv)) + ) + )); /* FALLTHROUGH */ case SVt_PVFM: /* let user-undef'd sub keep its identity */ @@ -1830,12 +1830,12 @@ PP_wrapped(pp_repeat, count = SvIV_nomg(sv); if (infnan) { - Perl_ck_warner(aTHX_ packWARN(WARN_NUMERIC), - "Non-finite repeat count does nothing"); + ck_warner(packWARN(WARN_NUMERIC), + "Non-finite repeat count does nothing"); } else if (count < 0) { count = 0; - Perl_ck_warner(aTHX_ packWARN(WARN_NUMERIC), - "Negative repeat count does nothing"); + ck_warner(packWARN(WARN_NUMERIC), + "Negative repeat count does nothing"); } if (gimme == G_LIST && PL_op->op_private & OPpREPEAT_DOLIST) { @@ -3269,8 +3269,8 @@ PP_wrapped(pp_srand, MAXARG, 0) flags = grok_number(pv, len, &anum); if (!(flags & IS_NUMBER_IN_UV)) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW), - "Integer overflow in srand"); + ck_warner_d(packWARN(WARN_OVERFLOW), + "Integer overflow in srand"); anum = UV_MAX; } } @@ -3640,9 +3640,8 @@ PP_wrapped(pp_substr, repl = SvPV_const(repl_sv, repl_len); SvGETMAGIC(sv); if (SvROK(sv)) - Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR), - "Attempt to use reference as lvalue in substr" - ); + ck_warner(packWARN(WARN_SUBSTR), + "Attempt to use reference as lvalue in substr"); tmps = SvPV_force_nomg(sv, curlen); if (DO_UTF8(repl_sv) && repl_len) { if (!DO_UTF8(sv)) { @@ -3717,7 +3716,7 @@ PP_wrapped(pp_substr, bound_fail: if (repl) croak("substr outside of string"); - Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR), "substr outside of string"); + ck_warner(packWARN(WARN_SUBSTR), "substr outside of string"); RETPUSHUNDEF; } @@ -3743,9 +3742,8 @@ PP(pp_substr_left) if (do_chop) { SvGETMAGIC(sv); if (SvROK(sv)) - Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR), - "Attempt to use reference as lvalue in substr" - ); + ck_warner(packWARN(WARN_SUBSTR), + "Attempt to use reference as lvalue in substr"); tmps = SvPV_force_nomg(sv, curlen); } else tmps = SvPV_const(sv, curlen); @@ -4078,8 +4076,8 @@ PP(pp_chr) SV *top2 = sv_mortalcopy_flags(top, SV_DO_COW_SVSETSV); top = top2; } - Perl_warner(aTHX_ packWARN(WARN_UTF8), - "Invalid negative number (%" SVf ") in chr", SVfARG(top)); + warner(packWARN(WARN_UTF8), + "Invalid negative number (%" SVf ") in chr", SVfARG(top)); } value = UNICODE_REPLACEMENT; } else { @@ -6160,7 +6158,7 @@ PP(pp_anonhash) } else { - Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Odd number of elements in anonymous hash"); + ck_warner(packWARN(WARN_MISC), "Odd number of elements in anonymous hash"); val = newSV_type(SVt_NULL); } (void)hv_store_ent(hv,key,val,0); @@ -6225,7 +6223,7 @@ PP_wrapped(pp_splice, 0, 1) } if (offset > AvFILLp(ary) + 1) { if (num_args > 2) - Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "splice() offset past end of array" ); + ck_warner(packWARN(WARN_MISC), "splice() offset past end of array" ); offset = AvFILLp(ary) + 1; } after = AvFILLp(ary) + 1 - (offset + length); diff --git a/pp_ctl.c b/pp_ctl.c index 75e747f2c33b..c9419ae79fec 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -634,7 +634,7 @@ PP_wrapped(pp_formline, 0, 1) sv = *++MARK; else { sv = &PL_sv_no; - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "Not enough format arguments"); + ck_warner(packWARN(WARN_SYNTAX), "Not enough format arguments"); } if (SvTAINTED(sv)) SvTAINTED_on(PL_formtarget); @@ -1590,8 +1590,8 @@ S_dopoptolabel(pTHX_ const char *label, STRLEN len, U32 flags) case CXt_FORMAT: case CXt_NULL: /* diag_listed_as: Exiting subroutine via %s */ - Perl_ck_warner(aTHX_ packWARN(WARN_EXITING), "Exiting %s via %s", - context_name[CxTYPE(cx)], OP_NAME(PL_op)); + ck_warner(packWARN(WARN_EXITING), "Exiting %s via %s", + context_name[CxTYPE(cx)], OP_NAME(PL_op)); if (CxTYPE(cx) == CXt_NULL) /* sort BLOCK */ return -1; break; @@ -1765,8 +1765,8 @@ S_dopoptoloop(pTHX_ I32 startingblock) case CXt_FORMAT: case CXt_NULL: /* diag_listed_as: Exiting subroutine via %s */ - Perl_ck_warner(aTHX_ packWARN(WARN_EXITING), "Exiting %s via %s", - context_name[CxTYPE(cx)], OP_NAME(PL_op)); + ck_warner(packWARN(WARN_EXITING), "Exiting %s via %s", + context_name[CxTYPE(cx)], OP_NAME(PL_op)); if ((CxTYPE(cx)) == CXt_NULL) /* sort BLOCK */ return -1; break; @@ -1936,8 +1936,8 @@ Perl_qerror(pTHX_ SV *err) if (err!=NULL) { if (PL_in_eval) { if (PL_in_eval & EVAL_KEEPERR) { - Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "\t(in cleanup) %" SVf, - SVfARG(err)); + ck_warner(packWARN(WARN_MISC), "\t(in cleanup) %" SVf, + SVfARG(err)); } else { sv_catsv(ERRSV, err); @@ -2094,8 +2094,8 @@ Perl_die_unwind(pTHX_ SV *msv) } if (in_eval & EVAL_KEEPERR) { - Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "\t(in cleanup) %" SVf, - SVfARG(exceptsv)); + ck_warner(packWARN(WARN_MISC), "\t(in cleanup) %" SVf, + SVfARG(exceptsv)); } while ((cxix = dopoptoeval(cxstack_ix)) < 0 @@ -5244,10 +5244,10 @@ S_require_file(pTHX_ SV *sv) RESTORE_ERRNO; if (do_warn) { - Perl_warner(aTHX_ packWARN(WARN_DEPRECATED__DOT_IN_INC), - "do \"%s\" failed, '.' is no longer in @INC; " - "did you mean do \"./%s\"?", - name, name); + warner(packWARN(WARN_DEPRECATED__DOT_IN_INC), + "do \"%s\" failed, '.' is no longer in @INC; " + "did you mean do \"./%s\"?", + name, name); } #endif CLEAR_ERRSV(); diff --git a/pp_hot.c b/pp_hot.c index 3869373a4679..5d7f9426ccfb 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -330,9 +330,7 @@ PP(pp_padsv_store) UNLIKELY(SvTEMP(targ)) && !SvSMAGICAL(targ) && SvREFCNT(targ) == 1 && (!isGV_with_GP(targ) || SvFAKE(targ)) && ckWARN(WARN_MISC) ) - Perl_warner(aTHX_ - packWARN(WARN_MISC), "Useless assignment to a temporary" - ); + warner(packWARN(WARN_MISC), "Useless assignment to a temporary"); SvSetMagicSV(targ, val); assert(GIMME_V == G_VOID); @@ -494,9 +492,7 @@ PP(pp_sassign) rpp_is_lone(left) && !SvSMAGICAL(left) && (!isGV_with_GP(left) || SvFAKE(left)) && ckWARN(WARN_MISC) ) - Perl_warner(aTHX_ - packWARN(WARN_MISC), "Useless assignment to a temporary" - ); + warner(packWARN(WARN_MISC), "Useless assignment to a temporary"); SvSetMagicSV(left, right); if (LIKELY(GIMME_V == G_VOID)) rpp_popfree_2_NN(); /* pop left and right */ @@ -2519,7 +2515,7 @@ S_do_oddball(pTHX_ SV **oddkey, SV **firstkey) } else err = "Odd number of elements in hash assignment"; - Perl_warner(aTHX_ packWARN(WARN_MISC), "%s", err); + warner(packWARN(WARN_MISC), "%s", err); } } @@ -3456,10 +3452,8 @@ PP(pp_aassign) rpp_is_lone(lsv) && !SvSMAGICAL(lsv) && (!isGV_with_GP(lsv) || SvFAKE(lsv)) && ckWARN(WARN_MISC) )) - Perl_warner(aTHX_ - packWARN(WARN_MISC), - "Useless assignment to a temporary" - ); + warner(packWARN(WARN_MISC), + "Useless assignment to a temporary"); #ifndef PERL_RC_STACK /* avoid freeing $$lsv if it might be needed for further @@ -4227,10 +4221,10 @@ Perl_do_readline(pTHX) */ PerlIO_clearerr(fp); if (!do_close(PL_last_in_gv, FALSE)) { - Perl_ck_warner(aTHX_ packWARN(WARN_GLOB), - "glob failed (child exited with status %d%s)", - (int)(STATUS_CURRENT >> 8), - (STATUS_CURRENT & 0x80) ? ", core dumped" : ""); + ck_warner(packWARN(WARN_GLOB), + "glob failed (child exited with status %d%s)", + (int)(STATUS_CURRENT >> 8), + (STATUS_CURRENT & 0x80) ? ", core dumped" : ""); } } @@ -4305,9 +4299,9 @@ Perl_do_readline(pTHX) if (!is_utf8_string_loc(s, len, &f)) /* Emulate :encoding(utf8) warning in the same case. */ - Perl_warner(aTHX_ packWARN(WARN_UTF8), - "utf8 \"\\x%02X\" does not map to Unicode", - f < (U8*)SvEND(sv) ? *f : 0); + warner(packWARN(WARN_UTF8), + "utf8 \"\\x%02X\" does not map to Unicode", + f < (U8*)SvEND(sv) ? *f : 0); } } @@ -4552,9 +4546,9 @@ PP(pp_multideref) check_elem: if (UNLIKELY(SvROK(elemsv) && !SvGAMAGIC(elemsv) && ckWARN(WARN_MISC))) - Perl_warner(aTHX_ packWARN(WARN_MISC), - "Use of reference \"%" SVf "\" as array index", - SVfARG(elemsv)); + warner(packWARN(WARN_MISC), + "Use of reference \"%" SVf "\" as array index", + SVfARG(elemsv)); /* the only time that S_find_uninit_var() needs this * is to determine which index value triggered the * undef warning. So just update it here. Note that @@ -6590,9 +6584,9 @@ Perl_sub_crush_depth(pTHX_ CV *cv) PERL_ARGS_ASSERT_SUB_CRUSH_DEPTH; if (CvANON(cv)) - Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on anonymous subroutine"); + warner(packWARN(WARN_RECURSION), "Deep recursion on anonymous subroutine"); else { - Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on subroutine \"%" SVf "\"", + warner(packWARN(WARN_RECURSION), "Deep recursion on subroutine \"%" SVf "\"", SVfARG(cv_name(cv,NULL,0))); } } @@ -6633,9 +6627,9 @@ PP(pp_aelem) SV *retsv; if (UNLIKELY(SvROK(elemsv) && !SvGAMAGIC(elemsv) && ckWARN(WARN_MISC))) - Perl_warner(aTHX_ packWARN(WARN_MISC), - "Use of reference \"%" SVf "\" as array index", - SVfARG(elemsv)); + warner(packWARN(WARN_MISC), + "Use of reference \"%" SVf "\" as array index", + SVfARG(elemsv)); if (UNLIKELY(SvTYPE(av) != SVt_PVAV)) { retsv = &PL_sv_undef; goto ret; diff --git a/pp_pack.c b/pp_pack.c index cb90b584ee9b..0b53611c7bb1 100644 --- a/pp_pack.c +++ b/pp_pack.c @@ -260,9 +260,9 @@ utf8_to_byte(pTHX_ const char **s, const char *end, I32 datumtype) croak("Malformed UTF-8 string in '%c' format in unpack", (int) TYPE_NO_MODIFIERS(datumtype)); if (val >= 0x100) { - Perl_ck_warner(aTHX_ packWARN(WARN_UNPACK), - "Character in '%c' format wrapped in unpack", - (int) TYPE_NO_MODIFIERS(datumtype)); + ck_warner(packWARN(WARN_UNPACK), + "Character in '%c' format wrapped in unpack", + (int) TYPE_NO_MODIFIERS(datumtype)); val = (U8) val; } *s += retlen; @@ -316,11 +316,11 @@ S_utf8_to_bytes(pTHX_ const char **s, const char *end, const char *buf, SSize_t if (from > end) from = end; } if ((bad & 2)) - Perl_ck_warner(aTHX_ packWARN(datumtype & TYPE_IS_PACK ? - WARN_PACK : WARN_UNPACK), - "Character(s) in '%c' format wrapped in %s", - (int) TYPE_NO_MODIFIERS(datumtype), - datumtype & TYPE_IS_PACK ? "pack" : "unpack"); + ck_warner(packWARN(datumtype & TYPE_IS_PACK ? + WARN_PACK : WARN_UNPACK), + "Character(s) in '%c' format wrapped in %s", + (int) TYPE_NO_MODIFIERS(datumtype), + datumtype & TYPE_IS_PACK ? "pack" : "unpack"); } *s = from; return TRUE; @@ -620,8 +620,8 @@ S_next_symbol(pTHX_ tempsym_t* symptr ) if (((symptr->flags & FLAG_COMMA) == 0) && ckWARN(WARN_UNPACK)){ symptr->flags |= FLAG_COMMA; /* diag_listed_as: Invalid type '%s' in %s */ - Perl_warner(aTHX_ packWARN(WARN_UNPACK), - "Invalid type ',' in %s", _action( symptr ) ); + warner(packWARN(WARN_UNPACK), + "Invalid type ',' in %s", _action( symptr ) ); } continue; } @@ -683,10 +683,10 @@ S_next_symbol(pTHX_ tempsym_t* symptr ) *patptr, _action( symptr ) ); if ((code & modifier)) { - Perl_ck_warner(aTHX_ packWARN(WARN_UNPACK), - "Duplicate modifier '%c' after '%c' in %s", - *patptr, (int) TYPE_NO_MODIFIERS(code), - _action( symptr ) ); + ck_warner(packWARN(WARN_UNPACK), + "Duplicate modifier '%c' after '%c' in %s", + *patptr, (int) TYPE_NO_MODIFIERS(code), + _action( symptr ) ); } code |= modifier; @@ -2565,8 +2565,8 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) fromstr = NEXTFROM; aiv = SvIV_no_inf(fromstr, datumtype); if ((-128 > aiv || aiv > 127)) - Perl_ck_warner(aTHX_ packWARN(WARN_PACK), - "Character in 'c' format wrapped in pack"); + ck_warner(packWARN(WARN_PACK), + "Character in 'c' format wrapped in pack"); PUSH_BYTE(utf8, cur, (U8)aiv); } break; @@ -2580,8 +2580,8 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) fromstr = NEXTFROM; aiv = SvIV_no_inf(fromstr, datumtype); if ((0 > aiv || aiv > 0xff)) - Perl_ck_warner(aTHX_ packWARN(WARN_PACK), - "Character in 'C' format wrapped in pack"); + ck_warner(packWARN(WARN_PACK), + "Character in 'C' format wrapped in pack"); PUSH_BYTE(utf8, cur, (U8)aiv); } break; @@ -2620,8 +2620,8 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) end = start+SvLEN(cat)-UTF8_MAXLEN; goto W_utf8; } - Perl_ck_warner(aTHX_ packWARN(WARN_PACK), - "Character in 'W' format wrapped in pack"); + ck_warner(packWARN(WARN_PACK), + "Character in 'W' format wrapped in pack"); auv = (U8) auv; } if (cur >= end) { @@ -3061,8 +3061,8 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) ) || (SvPADTMP(fromstr) && !SvREADONLY(fromstr)))) { - Perl_ck_warner(aTHX_ packWARN(WARN_PACK), - "Attempt to pack pointer to temporary value"); + ck_warner(packWARN(WARN_PACK), + "Attempt to pack pointer to temporary value"); } if (SvREADONLY(fromstr)) aptr = SvPV_nomg_const_nolen(fromstr); @@ -3080,8 +3080,8 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) if (len <= 2) len = 45; else len = len / 3 * 3; if (len >= 64) { - Perl_ck_warner(aTHX_ packWARN(WARN_PACK), - "Field too wide in 'u' format in pack"); + ck_warner(packWARN(WARN_PACK), + "Field too wide in 'u' format in pack"); len = 63; } aptr = SvPV_const(fromstr, fromlen); diff --git a/pp_sys.c b/pp_sys.c index aeab479f239d..b1c4ed338077 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -1242,9 +1242,9 @@ PP_wrapped(pp_untie, 1, 0) SPAGAIN; } else if (mg && SvREFCNT(obj) > 1) { - Perl_ck_warner(aTHX_ packWARN(WARN_UNTIE), - "untie attempted while %" UVuf " inner references still exist", - (UV)SvREFCNT(obj) - 1 ) ; + ck_warner(packWARN(WARN_UNTIE), + "untie attempted while %" UVuf " inner references still exist", + (UV)SvREFCNT(obj) - 1 ) ; } } } @@ -1390,8 +1390,8 @@ PP_wrapped(pp_sselect, 4, 0) } else { if (!SvPOKp(sv)) - Perl_ck_warner(aTHX_ packWARN(WARN_MISC), - "Non-string passed as bitmask"); + ck_warner(packWARN(WARN_MISC), + "Non-string passed as bitmask"); if (SvGAMAGIC(sv)) { svs[i] = sv_newmortal(); sv_copypv_nomg(svs[i], sv); @@ -1810,7 +1810,7 @@ PP(pp_leavewrite) } else { if ((IoLINES_LEFT(io) -= FmLINES(PL_formtarget)) < 0) { - Perl_ck_warner(aTHX_ packWARN(WARN_IO), "page overflow"); + ck_warner(packWARN(WARN_IO), "page overflow"); } if (!do_print(PL_formtarget, fp)) rpp_push_IMM(&PL_sv_no); @@ -3065,12 +3065,12 @@ PP_wrapped(pp_stat, !(PL_op->op_flags & OPf_REF), 0) if (PL_op->op_type == OP_LSTAT) { if (gv != PL_defgv) { do_fstat_warning_check: - Perl_ck_warner(aTHX_ packWARN(WARN_IO), - "lstat() on filehandle%s%" SVf, - gv ? " " : "", - SVfARG(gv - ? newSVhek_mortal(GvENAME_HEK(gv)) - : &PL_sv_no)); + ck_warner(packWARN(WARN_IO), + "lstat() on filehandle%s%" SVf, + gv ? " " : "", + SVfARG(gv + ? newSVhek_mortal(GvENAME_HEK(gv)) + : &PL_sv_no)); } else if (PL_laststype != OP_LSTAT) /* diag_listed_as: The stat preceding %s wasn't an lstat */ croak("The stat preceding lstat() wasn't an lstat"); @@ -3143,7 +3143,7 @@ PP_wrapped(pp_stat, !(PL_op->op_flags & OPf_REF), 0) if (ckWARN(WARN_NEWLINE) && should_warn_nl(file)) { /* PL_warn_nl is constant */ GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral); - Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat"); + warner(packWARN(WARN_NEWLINE), PL_warn_nl, "stat"); GCC_DIAG_RESTORE_STMT; } max = 0; @@ -3793,7 +3793,7 @@ PP(pp_fttext) if (ckWARN(WARN_NEWLINE) && should_warn_nl(file)) { /* PL_warn_nl is constant */ GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral); - Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open"); + warner(packWARN(WARN_NEWLINE), PL_warn_nl, "open"); GCC_DIAG_RESTORE_STMT; } FT_RETURNUNDEF; @@ -3901,8 +3901,8 @@ PP_wrapped(pp_chdir, MAXARG, 0) gv = gv_fetchsv(sv, 0, SVt_PVIO); if (!gv) { if (ckWARN(WARN_UNOPENED)) { - Perl_warner(aTHX_ packWARN(WARN_UNOPENED), - "chdir() on unopened filehandle %" SVf, sv); + warner(packWARN(WARN_UNOPENED), + "chdir() on unopened filehandle %" SVf, sv); } SETERRNO(EBADF,RMS_IFI); TAINT_PROPER("chdir"); @@ -4277,15 +4277,15 @@ S_warn_not_dirhandle(pTHX_ GV *gv) { IO *io = GvIOn(gv); if (IoIFP(io)) { - Perl_ck_warner(aTHX_ packWARN(WARN_IO), - "%s() attempted on handle %" HEKf - " opened with open()", - OP_DESC(PL_op), HEKfARG(GvENAME_HEK(gv))); + ck_warner(packWARN(WARN_IO), + "%s() attempted on handle %" HEKf + " opened with open()", + OP_DESC(PL_op), HEKfARG(GvENAME_HEK(gv))); } else { - Perl_ck_warner(aTHX_ packWARN(WARN_IO), - "%s() attempted on invalid dirhandle %" HEKf, - OP_DESC(PL_op), HEKfARG(GvENAME_HEK(gv))); + ck_warner(packWARN(WARN_IO), + "%s() attempted on invalid dirhandle %" HEKf, + OP_DESC(PL_op), HEKfARG(GvENAME_HEK(gv))); } } @@ -5011,8 +5011,8 @@ PP_wrapped(pp_gmtime, MAXARG, 0) when = (Time64_T)input; if (UNLIKELY(pl_isnan || when != input)) { /* diag_listed_as: gmtime(%f) too large */ - Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), - "%s(%.0" NVff ") too large", opname, input); + ck_warner(packWARN(WARN_OVERFLOW), + "%s(%.0" NVff ") too large", opname, input); if (pl_isnan) { err = NULL; goto failed; @@ -5022,14 +5022,14 @@ PP_wrapped(pp_gmtime, MAXARG, 0) if ( TIME_LOWER_BOUND > when ) { /* diag_listed_as: gmtime(%f) too small */ - Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), - "%s(%.0" NVff ") too small", opname, when); + ck_warner(packWARN(WARN_OVERFLOW), + "%s(%.0" NVff ") too small", opname, when); err = NULL; } else if( when > TIME_UPPER_BOUND ) { /* diag_listed_as: gmtime(%f) too small */ - Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), - "%s(%.0" NVff ") too large", opname, when); + ck_warner(packWARN(WARN_OVERFLOW), + "%s(%.0" NVff ") too large", opname, when); err = NULL; } else { @@ -5043,8 +5043,8 @@ PP_wrapped(pp_gmtime, MAXARG, 0) /* diag_listed_as: gmtime(%f) failed */ /* XXX %lld broken for quads */ failed: - Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), - "%s(%.0" NVff ") failed", opname, when); + ck_warner(packWARN(WARN_OVERFLOW), + "%s(%.0" NVff ") failed", opname, when); } if (GIMME_V != G_LIST) { /* scalar context */ @@ -5099,8 +5099,8 @@ PP_wrapped(pp_alarm, 1, 0) * setitimer() and often being implemented in terms of * setitimer(), can fail. */ /* diag_listed_as: %s() with negative argument */ - Perl_ck_warner_d(aTHX_ packWARN(WARN_MISC), - "alarm() with negative argument"); + ck_warner_d(packWARN(WARN_MISC), + "alarm() with negative argument"); SETERRNO(EINVAL, LIB_INVARG); RETPUSHUNDEF; } @@ -5129,8 +5129,8 @@ PP_wrapped(pp_sleep, MAXARG, 0) const I32 duration = POPi; if (duration < 0) { /* diag_listed_as: %s() with negative argument */ - Perl_ck_warner_d(aTHX_ packWARN(WARN_MISC), - "sleep() with negative argument"); + ck_warner_d(packWARN(WARN_MISC), + "sleep() with negative argument"); SETERRNO(EINVAL, LIB_INVARG); XPUSHs(&PL_sv_zero); RETURN; diff --git a/regen/keywords.pl b/regen/keywords.pl index c01d4ba5e1bd..26ccf515ef2e 100755 --- a/regen/keywords.pl +++ b/regen/keywords.pl @@ -98,7 +98,7 @@ sub perl_keyword if ($k eq 'elseif') { return <p might conflict with future printf extensions"); + ck_warner_d(packWARN(WARN_INTERNAL), + "internal %%p might conflict with future printf extensions"); } } @@ -13074,8 +13074,8 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p */ if (sv_isobject(vecsv) && sv_derived_from(vecsv, "version")) { if ( hv_existss(HV_FROM_REF(vecsv), "alpha") ) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_PRINTF), - "vector argument not supported with alpha versions"); + ck_warner_d(packWARN(WARN_PRINTF), + "vector argument not supported with alpha versions"); vecsv = &PL_sv_no; } else { @@ -13787,7 +13787,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p } else { sv_catpvs(msg, "end of string"); } - Perl_warner(aTHX_ packWARN(WARN_PRINTF), "%" SVf, SVfARG(msg)); /* yes, this is reentrant */ + warner(packWARN(WARN_PRINTF), "%" SVf, SVfARG(msg)); /* yes, this is reentrant */ } /* mangled format: output the '%', then continue from the @@ -13910,8 +13910,8 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p * do we have things left on the stack that we didn't use? */ if (!no_redundant_warning && sv_count >= svix + 1 && ckWARN(WARN_REDUNDANT)) { - Perl_warner(aTHX_ packWARN(WARN_REDUNDANT), "Redundant argument in %s", - PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()"); + warner(packWARN(WARN_REDUNDANT), "Redundant argument in %s", + PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()"); } if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) { @@ -17738,12 +17738,12 @@ Perl_report_uninit(pTHX_ const SV *uninit_sv) GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral); if (desc) /* diag_listed_as: Use of uninitialized value%s */ - Perl_warner(aTHX_ packWARN(WARN_UNINITIALIZED), PL_warn_uninit_sv, - SVfARG(varname ? varname : &PL_sv_no), - " in ", desc); + warner(packWARN(WARN_UNINITIALIZED), PL_warn_uninit_sv, + SVfARG(varname ? varname : &PL_sv_no), + " in ", desc); else - Perl_warner(aTHX_ packWARN(WARN_UNINITIALIZED), PL_warn_uninit, - "", "", ""); + warner(packWARN(WARN_UNINITIALIZED), PL_warn_uninit, + "", "", ""); GCC_DIAG_RESTORE_STMT; } diff --git a/taint.c b/taint.c index 1dfd583a47ce..9ff030184706 100644 --- a/taint.c +++ b/taint.c @@ -77,7 +77,7 @@ Perl_taint_proper(pTHX_ const char *f, const char *const s) * and hope the callers aren't naughty */ GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral); if (PL_unsafe || TAINT_WARN_get) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_TAINT), f, s, ug); + ck_warner_d(packWARN(WARN_TAINT), f, s, ug); } else { croak(f, s, ug); diff --git a/toke.c b/toke.c index 645df00fc4a5..6c86108ed1a9 100644 --- a/toke.c +++ b/toke.c @@ -1852,21 +1852,21 @@ Perl_validate_proto(pTHX_ SV *name, SV *proto, bool warn, bool curstash) } if (proto_after_greedy_proto) - Perl_warner(aTHX_ packWARN(WARN_ILLEGALPROTO), - "Prototype after '%c' for %" SVf " : %s", - greedy_proto, SVfARG(name), p); + warner(packWARN(WARN_ILLEGALPROTO), + "Prototype after '%c' for %" SVf " : %s", + greedy_proto, SVfARG(name), p); if (in_brackets) - Perl_warner(aTHX_ packWARN(WARN_ILLEGALPROTO), - "Missing ']' in prototype for %" SVf " : %s", - SVfARG(name), p); + warner(packWARN(WARN_ILLEGALPROTO), + "Missing ']' in prototype for %" SVf " : %s", + SVfARG(name), p); if (bad_proto) - Perl_warner(aTHX_ packWARN(WARN_ILLEGALPROTO), - "Illegal character in prototype for %" SVf " : %s", - SVfARG(name), p); + warner(packWARN(WARN_ILLEGALPROTO), + "Illegal character in prototype for %" SVf " : %s", + SVfARG(name), p); if (bad_proto_after_underscore) - Perl_warner(aTHX_ packWARN(WARN_ILLEGALPROTO), - "Illegal character after '_' in prototype for %" SVf " : %s", - SVfARG(name), p); + warner(packWARN(WARN_ILLEGALPROTO), + "Illegal character after '_' in prototype for %" SVf " : %s", + SVfARG(name), p); } return (! (proto_after_greedy_proto || bad_proto) ); @@ -2091,9 +2091,9 @@ S_check_uni(pTHX) if (s < PL_bufptr && memchr(s, '(', PL_bufptr - s)) return; - Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS), - "Warning: Use of \"%" UTF8f "\" without parentheses is ambiguous", - UTF8fARG(UTF, (int)(s - PL_last_uni), PL_last_uni)); + ck_warner_d(packWARN(WARN_AMBIGUOUS), + "Warning: Use of \"%" UTF8f "\" without parentheses is ambiguous", + UTF8fARG(UTF, (int)(s - PL_last_uni), PL_last_uni)); } /* @@ -3713,8 +3713,8 @@ S_scan_const(pTHX_ char *start) break; if (s + 1 < send && !memCHRs("()| \r\n\t", s[1])) { if (s[1] == '\\') { - Perl_ck_warner(aTHX_ packWARN(WARN_AMBIGUOUS), - "Possible unintended interpolation of $\\ in regex"); + ck_warner(packWARN(WARN_AMBIGUOUS), + "Possible unintended interpolation of $\\ in regex"); } break; /* in regexp, $ might be tail anchor */ } @@ -3744,7 +3744,7 @@ S_scan_const(pTHX_ char *start) && !isDIGIT(s[1])) { /* diag_listed_as: \%d better written as $%d */ - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "\\%c better written as $%c", *s, *s); + ck_warner(packWARN(WARN_SYNTAX), "\\%c better written as $%c", *s, *s); s = bslash; *s = '$'; break; @@ -3782,9 +3782,9 @@ S_scan_const(pTHX_ char *start) default: { if ((isALPHANUMERIC(*s))) - Perl_ck_warner(aTHX_ packWARN(WARN_MISC), - "Unrecognized escape \\%c passed through", - *s); + ck_warner(packWARN(WARN_MISC), + "Unrecognized escape \\%c passed through", + *s); /* default action is to copy the quoted character */ goto default_action; } @@ -3803,8 +3803,8 @@ S_scan_const(pTHX_ char *start) && isDIGIT(*s) /* like \08, \178 */ && ckWARN(WARN_MISC)) { - Perl_warner(aTHX_ packWARN(WARN_MISC), "%s", - form_alien_digit_msg(8, len, s, send, UTF, FALSE)); + warner(packWARN(WARN_MISC), "%s", + form_alien_digit_msg(8, len, s, send, UTF, FALSE)); } } goto NUM_ESCAPE_INSERT; @@ -5426,9 +5426,9 @@ yyl_dollar(pTHX_ char *s) PL_bufptr = skipspace(PL_bufptr); /* XXX can realloc */ while (t < PL_bufend && *t != ']') t++; - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), - "Multidimensional syntax %" UTF8f " not supported", - UTF8fARG(UTF,(int)((t - PL_bufptr) + 1), PL_bufptr)); + warner(packWARN(WARN_SYNTAX), + "Multidimensional syntax %" UTF8f " not supported", + UTF8fARG(UTF,(int)((t - PL_bufptr) + 1), PL_bufptr)); } } } @@ -5454,9 +5454,9 @@ yyl_dollar(pTHX_ char *s) ? SVf_UTF8 : 0)) { - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), - "You need to quote \"%" UTF8f "\"", - UTF8fARG(UTF, len, tmpbuf)); + warner(packWARN(WARN_SYNTAX), + "You need to quote \"%" UTF8f "\"", + UTF8fARG(UTF, len, tmpbuf)); } } } @@ -5677,8 +5677,8 @@ yyl_interpcasemod(pTHX_ char *s) } else if ( PL_bufptr != PL_bufend && PL_bufptr[1] == 'E' ) { /* Got an unpaired \E */ - Perl_ck_warner(aTHX_ packWARN(WARN_MISC), - "Useless use of \\E"); + ck_warner(packWARN(WARN_MISC), + "Useless use of \\E"); } if (PL_bufptr != PL_bufend) PL_bufptr += 2; @@ -5800,10 +5800,10 @@ yyl_secondclass_keyword(pTHX_ char *s, STRLEN len, int key, I32 *orig_keyword, *pgv = NULL; *pgvp = 0; if (hgv && key != KEY_x) /* never ambiguous */ - Perl_ck_warner(aTHX_ packWARN(WARN_AMBIGUOUS), - "Ambiguous call resolved as CORE::%s(), " - "qualify as such or use &", - GvENAME(hgv)); + ck_warner(packWARN(WARN_AMBIGUOUS), + "Ambiguous call resolved as CORE::%s(), " + "qualify as such or use &", + GvENAME(hgv)); return key; } } @@ -5830,13 +5830,13 @@ yyl_qw(pTHX_ char *s, STRLEN len) if (!warned_comma || !warned_comment) { for (; !isSPACE(*d) && len; --len, ++d) { if (!warned_comma && *d == ',') { - Perl_warner(aTHX_ packWARN(WARN_QW), - "Possible attempt to separate words with commas"); + warner(packWARN(WARN_QW), + "Possible attempt to separate words with commas"); ++warned_comma; } else if (!warned_comment && *d == '#') { - Perl_warner(aTHX_ packWARN(WARN_QW), - "Possible attempt to put comments in qw() list"); + warner(packWARN(WARN_QW), + "Possible attempt to put comments in qw() list"); ++warned_comment; } } @@ -6574,7 +6574,7 @@ yyl_ampersand(pTHX_ char *s) && isIDFIRST_lazy_if_safe(s, PL_bufend, UTF)) { CopLINE_dec(PL_curcop); - Perl_warner(aTHX_ packWARN(WARN_SEMICOLON), "%s", PL_warn_nosemi); + warner(packWARN(WARN_SEMICOLON), "%s", PL_warn_nosemi); CopLINE_inc(PL_curcop); } d = s; @@ -6653,8 +6653,8 @@ yyl_bang(pTHX_ char *s) || ((*t == 'm' || *t == 's' || *t == 'y') && !isWORDCHAR(t[1])) || (*t == 't' && t[1] == 'r' && !isWORDCHAR(t[2]))) - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), - "!=~ should be !~"); + warner(packWARN(WARN_SYNTAX), + "!=~ should be !~"); } if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE) { @@ -6941,8 +6941,8 @@ static int yyl_backslash(pTHX_ char *s) { if (PL_lex_inwhat == OP_SUBST && PL_lex_repl == PL_linestr && isDIGIT(*s)) - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),"Can't use \\%c to mean $%c in expression", - *s, *s); + ck_warner(packWARN(WARN_SYNTAX),"Can't use \\%c to mean $%c in expression", + *s, *s); S_warn_expect_operator(aTHX_ "Backslash", s, FALSE); OPERATOR(REFGEN); } @@ -7222,9 +7222,8 @@ yyl_my(pTHX_ char *s, I32 my) if (!FEATURE_MYREF_IS_ENABLED) croak("The experimental declared_refs " "feature is not enabled"); - Perl_ck_warner_d(aTHX_ - packWARN(WARN_EXPERIMENTAL__DECLARED_REFS), - "Declaring references is experimental"); + ck_warner_d(packWARN(WARN_EXPERIMENTAL__DECLARED_REFS), + "Declaring references is experimental"); } OPERATOR(KW_MY); } @@ -7560,14 +7559,13 @@ yyl_safe_bareword(pTHX_ char *s, const char lastchar) if ((lastchar == '*' || lastchar == '%' || lastchar == '&') && PL_parser->saw_infix_sigil) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS), - "Operator or semicolon missing before %c%" UTF8f, - lastchar, - UTF8fARG(UTF, strlen(PL_tokenbuf), - PL_tokenbuf)); - Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS), - "Ambiguous use of %c resolved as operator %c", - lastchar, lastchar); + ck_warner_d(packWARN(WARN_AMBIGUOUS), + "Operator or semicolon missing before %c%" UTF8f, + lastchar, + UTF8fARG(UTF, strlen(PL_tokenbuf), PL_tokenbuf)); + ck_warner_d(packWARN(WARN_AMBIGUOUS), + "Ambiguous use of %c resolved as operator %c", + lastchar, lastchar); } TOKEN(BAREWORD); } @@ -7642,8 +7640,7 @@ yyl_strictwarn_bareword(pTHX_ const char lastchar) if (!*d && !gv_stashpv(PL_tokenbuf, UTF ? SVf_UTF8 : 0)) { /* PL_warn_reserved is constant */ GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral); - Perl_warner(aTHX_ packWARN(WARN_RESERVED), PL_warn_reserved, - PL_tokenbuf); + warner(packWARN(WARN_RESERVED), PL_warn_reserved, PL_tokenbuf); GCC_DIAG_RESTORE_STMT; } } @@ -7663,7 +7660,7 @@ yyl_just_a_word(pTHX_ char *s, STRLEN len, I32 orig_keyword, struct code c) if (PL_expect == XOPERATOR) { if (PL_bufptr == PL_linestart) { CopLINE_dec(PL_curcop); - Perl_warner(aTHX_ packWARN(WARN_SEMICOLON), "%s", PL_warn_nosemi); + warner(packWARN(WARN_SEMICOLON), "%s", PL_warn_nosemi); CopLINE_inc(PL_curcop); } else @@ -7702,10 +7699,10 @@ yyl_just_a_word(pTHX_ char *s, STRLEN len, I32 orig_keyword, struct code c) if (len > 2 && PL_tokenbuf[len - 2] == ':' && PL_tokenbuf[len - 1] == ':') { if (ckWARN(WARN_BAREWORD) && ! gv_fetchpvn_flags(PL_tokenbuf, len, UTF ? SVf_UTF8 : 0, SVt_PVHV)) - Perl_warner(aTHX_ packWARN(WARN_BAREWORD), - "Bareword \"%" UTF8f - "\" refers to nonexistent package", - UTF8fARG(UTF, len, PL_tokenbuf)); + warner(packWARN(WARN_BAREWORD), + "Bareword \"%" UTF8f + "\" refers to nonexistent package", + UTF8fARG(UTF, len, PL_tokenbuf)); len -= 2; PL_tokenbuf[len] = '\0'; c.gv = NULL; @@ -7937,8 +7934,7 @@ yyl_word_or_keyword(pTHX_ char *s, STRLEN len, I32 key, I32 orig_keyword, struct : newSVOP(OP_RUNCV, 0, &PL_sv_undef)); case KEY___CLASS__: - Perl_ck_warner_d(aTHX_ - packWARN(WARN_EXPERIMENTAL__CLASS), "__CLASS__ is experimental"); + ck_warner_d(packWARN(WARN_EXPERIMENTAL__CLASS), "__CLASS__ is experimental"); FUN0(OP_CLASSNAME); case KEY_AUTOLOAD: @@ -7953,8 +7949,7 @@ yyl_word_or_keyword(pTHX_ char *s, STRLEN len, I32 key, I32 orig_keyword, struct return yyl_just_a_word(aTHX_ s, len, orig_keyword, c); case KEY_ADJUST: - Perl_ck_warner_d(aTHX_ - packWARN(WARN_EXPERIMENTAL__CLASS), "ADJUST is experimental"); + ck_warner_d(packWARN(WARN_EXPERIMENTAL__CLASS), "ADJUST is experimental"); /* The way that KEY_CHECK et.al. are handled currently are nothing * short of crazy. We won't copy that model for new phasers, but use @@ -7972,8 +7967,7 @@ yyl_word_or_keyword(pTHX_ char *s, STRLEN len, I32 key, I32 orig_keyword, struct LOP(OP_ACCEPT,XTERM); case KEY_all: - Perl_ck_warner_d(aTHX_ - packWARN(WARN_EXPERIMENTAL__KEYWORD_ALL), "all is experimental"); + ck_warner_d(packWARN(WARN_EXPERIMENTAL__KEYWORD_ALL), "all is experimental"); BLKLOP(OP_ALLSTART); case KEY_and: @@ -7982,8 +7976,7 @@ yyl_word_or_keyword(pTHX_ char *s, STRLEN len, I32 key, I32 orig_keyword, struct OPERATOR(ANDOP); case KEY_any: - Perl_ck_warner_d(aTHX_ - packWARN(WARN_EXPERIMENTAL__KEYWORD_ANY), "any is experimental"); + ck_warner_d(packWARN(WARN_EXPERIMENTAL__KEYWORD_ANY), "any is experimental"); BLKLOP(OP_ANYSTART); case KEY_atan2: @@ -8008,8 +8001,7 @@ yyl_word_or_keyword(pTHX_ char *s, STRLEN len, I32 key, I32 orig_keyword, struct UNI(OP_CHOP); case KEY_class: - Perl_ck_warner_d(aTHX_ - packWARN(WARN_EXPERIMENTAL__CLASS), "class is experimental"); + ck_warner_d(packWARN(WARN_EXPERIMENTAL__CLASS), "class is experimental"); s = force_word(s,BAREWORD,FALSE,TRUE); s = skipspace(s); @@ -8074,8 +8066,7 @@ yyl_word_or_keyword(pTHX_ char *s, STRLEN len, I32 key, I32 orig_keyword, struct PREBLOCK(KW_DEFAULT); case KEY_defer: - Perl_ck_warner_d(aTHX_ - packWARN(WARN_EXPERIMENTAL__DEFER), "defer is experimental"); + ck_warner_d(packWARN(WARN_EXPERIMENTAL__DEFER), "defer is experimental"); PREBLOCK(KW_DEFER); case KEY_do: @@ -8174,8 +8165,7 @@ yyl_word_or_keyword(pTHX_ char *s, STRLEN len, I32 key, I32 orig_keyword, struct /* TODO: maybe this should use the same parser/grammar structures as * `my`, but it's also rather messy because of the `our` conflation */ - Perl_ck_warner_d(aTHX_ - packWARN(WARN_EXPERIMENTAL__CLASS), "field is experimental"); + ck_warner_d(packWARN(WARN_EXPERIMENTAL__CLASS), "field is experimental"); croak_kw_unless_class("field"); @@ -8183,8 +8173,7 @@ yyl_word_or_keyword(pTHX_ char *s, STRLEN len, I32 key, I32 orig_keyword, struct OPERATOR(KW_FIELD); case KEY_finally: - Perl_ck_warner_d(aTHX_ - packWARN(WARN_EXPERIMENTAL__TRY), "try/catch/finally is experimental"); + ck_warner_d(packWARN(WARN_EXPERIMENTAL__TRY), "try/catch/finally is experimental"); PREBLOCK(KW_FINALLY); case KEY_for: @@ -8447,9 +8436,9 @@ yyl_word_or_keyword(pTHX_ char *s, STRLEN len, I32 key, I32 orig_keyword, struct && !(t[0] == ':' && t[1] == ':') && !keyword(s, d-s, 0) ) { - Perl_warner(aTHX_ packWARN(WARN_PRECEDENCE), - "Precedence problem: open %" UTF8f " should be open(%" UTF8f ")", - UTF8fARG(UTF, d-s, s), UTF8fARG(UTF, d-s, s)); + warner(packWARN(WARN_PRECEDENCE), + "Precedence problem: open %" UTF8f " should be open(%" UTF8f ")", + UTF8fARG(UTF, d-s, s), UTF8fARG(UTF, d-s, s)); } } LOP(OP_OPEN,XTERM); @@ -8705,8 +8694,7 @@ yyl_word_or_keyword(pTHX_ char *s, STRLEN len, I32 key, I32 orig_keyword, struct case KEY_method: /* For now we just treat 'method' identical to 'sub' plus a warning */ - Perl_ck_warner_d(aTHX_ - packWARN(WARN_EXPERIMENTAL__CLASS), "method is experimental"); + ck_warner_d(packWARN(WARN_EXPERIMENTAL__CLASS), "method is experimental"); return yyl_sub(aTHX_ s, KEY_method); case KEY_format: @@ -9360,8 +9348,8 @@ yyl_try(pTHX_ char *s) PMop(OP_MATCH); if (tmp && isSPACE(*s) && ckWARN(WARN_SYNTAX) && memCHRs("+-*/%.^&|<",tmp)) - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), - "Reversed %c= operator",(int)tmp); + warner(packWARN(WARN_SYNTAX), + "Reversed %c= operator",(int)tmp); s--; if (PL_expect == XSTATE && isALPHA(tmp) @@ -10067,10 +10055,9 @@ S_pending_ident(pTHX) ) { /* Downgraded from fatal to warning 20000522 mjd */ - Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS), - "Possible unintended interpolation of %" UTF8f - " in string", - UTF8fARG(UTF, tokenbuf_len, PL_tokenbuf)); + warner(packWARN(WARN_AMBIGUOUS), + "Possible unintended interpolation of %" UTF8f " in string", + UTF8fARG(UTF, tokenbuf_len, PL_tokenbuf)); } } @@ -10112,8 +10099,8 @@ S_checkcomma(pTHX_ const char *s, const char *name, const char *what) * constructs (or, and, if, until, unless, while, for). * Not a very solid hack... */ if (!*w || !memCHRs(";&/|})]oaiuwf!=", *w)) - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), - "%s (...) interpreted as function",name); + warner(packWARN(WARN_SYNTAX), + "%s (...) interpreted as function",name); } } while (s < PL_bufend && isSPACE(*s)) @@ -10523,9 +10510,9 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni) orig_copline = CopLINE(PL_curcop); CopLINE_set(PL_curcop, tmp_copline); /* diag_listed_as: Ambiguous use of %c{%s[...]} resolved to %c%s[...] */ - Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS), - "Ambiguous use of %c{%s%s} resolved to %c%s%s", - funny, dest, brack, funny, dest, brack); + warner(packWARN(WARN_AMBIGUOUS), + "Ambiguous use of %c{%s%s} resolved to %c%s%s", + funny, dest, brack, funny, dest, brack); CopLINE_set(PL_curcop, orig_copline); } bracket++; @@ -10571,9 +10558,9 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni) funny = '@'; orig_copline = CopLINE(PL_curcop); CopLINE_set(PL_curcop, tmp_copline); - Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS), - "Ambiguous use of %c{%" SVf "} resolved to %c%" SVf, - funny, SVfARG(tmp), funny, SVfARG(tmp)); + warner(packWARN(WARN_AMBIGUOUS), + "Ambiguous use of %c{%" SVf "} resolved to %c%" SVf, + funny, SVfARG(tmp), funny, SVfARG(tmp)); CopLINE_set(PL_curcop, orig_copline); } } @@ -10759,8 +10746,8 @@ S_scan_pat(pTHX_ char *start, I32 type) /* issue a warning if /c is specified,but /g is not */ if ((pm->op_pmflags & PMf_CONTINUE) && !(pm->op_pmflags & PMf_GLOBAL)) { - Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), - "Use of /c modifier is meaningless without /g" ); + ck_warner(packWARN(WARN_REGEXP), + "Use of /c modifier is meaningless without /g" ); } PL_lex_op = (OP*)pm; @@ -10818,7 +10805,7 @@ S_scan_subst(pTHX_ char *start) } if ((pm->op_pmflags & PMf_CONTINUE)) { - Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), "Use of /c modifier is meaningless in s///" ); + ck_warner(packWARN(WARN_REGEXP), "Use of /c modifier is meaningless in s///" ); } if (es) { @@ -11707,10 +11694,9 @@ Perl_scan_str(pTHX_ char *start, int keep_bracketed_quoted, int keep_delims, int * always been legal, and no other ASCIIs. Don't raise a message if * using one of these */ if (! isASCII(open_delim_code)) { - Perl_ck_warner_d(aTHX_ - packWARN(WARN_EXPERIMENTAL__EXTRA_PAIRED_DELIMITERS), - "Use of '%" UTF8f "' is experimental as a string delimiter", - UTF8fARG(UTF, delim_byte_len, open_delim_str)); + ck_warner_d(packWARN(WARN_EXPERIMENTAL__EXTRA_PAIRED_DELIMITERS), + "Use of '%" UTF8f "' is experimental as a string delimiter", + UTF8fARG(UTF, delim_byte_len, open_delim_str)); } close_delim_code = (UTF) @@ -11724,9 +11710,9 @@ Perl_scan_str(pTHX_ char *start, int keep_bracketed_quoted, int keep_delims, int if (ninstr(deprecated_opening_delims, deprecated_delims_end, open_delim_str, open_delim_str + delim_byte_len)) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED__DELIMITER_WILL_BE_PAIRED), - "Use of '%" UTF8f "' is deprecated as a string delimiter", - UTF8fARG(UTF, delim_byte_len, open_delim_str)); + ck_warner_d(packWARN(WARN_DEPRECATED__DELIMITER_WILL_BE_PAIRED), + "Use of '%" UTF8f "' is deprecated as a string delimiter", + UTF8fARG(UTF, delim_byte_len, open_delim_str)); } /* Note that a NUL may be used as a delimiter, and this happens when @@ -11943,8 +11929,8 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) do { \ if (!warned_about_underscore) { \ warned_about_underscore = 1; \ - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), \ - "Misplaced _ in number"); \ + ck_warner(packWARN(WARN_SYNTAX), \ + "Misplaced _ in number"); \ } \ } while(0) /* Hexadecimal floating point. @@ -12104,9 +12090,9 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) && !(PL_hints & HINT_NEW_BINARY)) { overflowed = TRUE; n = (NV) u; - Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW), - "Integer overflow in %s number", - bases[shift]); + ck_warner_d(packWARN(WARN_OVERFLOW), + "Integer overflow in %s number", + bases[shift]); } else u = x | b; /* add the digit to the end */ } @@ -12280,16 +12266,16 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) * exponent for normals, not subnormals. * * This may or may not be a good thing. */ - Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), - "Hexadecimal float: exponent underflow"); + ck_warner(packWARN(WARN_OVERFLOW), + "Hexadecimal float: exponent underflow"); break; } #endif #ifdef NV_MAX_EXP if (!negexp && hexfp_exp > NV_MAX_EXP - 1) { - Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), - "Hexadecimal float: exponent overflow"); + ck_warner(packWARN(WARN_OVERFLOW), + "Hexadecimal float: exponent overflow"); break; } #endif @@ -12324,19 +12310,19 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) if (overflowed) { if (n > 4294967295.0) - Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), - "%s number > %s non-portable", - Bases[shift], - new_octal ? "0o37777777777" : maxima[shift]); + ck_warner(packWARN(WARN_PORTABLE), + "%s number > %s non-portable", + Bases[shift], + new_octal ? "0o37777777777" : maxima[shift]); sv = newSVnv(n); } else { #if UVSIZE > 4 if (u > 0xffffffff) - Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), - "%s number > %s non-portable", - Bases[shift], - new_octal ? "0o37777777777" : maxima[shift]); + ck_warner(packWARN(WARN_PORTABLE), + "%s number > %s non-portable", + Bases[shift], + new_octal ? "0o37777777777" : maxima[shift]); #endif sv = newSVuv(u); } @@ -12546,8 +12532,8 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) if (UNLIKELY(hexfp)) { # ifdef NV_MANT_DIG if (significant_bits > NV_MANT_DIG) - Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), - "Hexadecimal float: mantissa overflow"); + ck_warner(packWARN(WARN_OVERFLOW), + "Hexadecimal float: mantissa overflow"); # endif #ifdef HEXFP_UQUAD nv = (NV)hexfp_uquad; @@ -12993,7 +12979,7 @@ Perl_yyerror_pvn(pTHX_ const char *const s, STRLEN len, U32 flags) } if (PL_in_eval & EVAL_WARNONLY) { PL_in_eval &= ~EVAL_WARNONLY; - Perl_ck_warner_d(aTHX_ packWARN(WARN_SYNTAX), "%" SVf, SVfARG(msg)); + ck_warner_d(packWARN(WARN_SYNTAX), "%" SVf, SVfARG(msg)); } else { qerror(msg); @@ -13333,8 +13319,8 @@ Perl_scan_vstring(pTHX_ const char *s, const char *const e, SV *sv) mult *= 10; if (orev > rev) /* diag_listed_as: Integer overflow in %s number */ - Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW), - "Integer overflow in decimal number"); + ck_warner_d(packWARN(WARN_OVERFLOW), + "Integer overflow in decimal number"); } } diff --git a/universal.c b/universal.c index 5bddf7b0d468..bd9d6397352b 100644 --- a/universal.c +++ b/universal.c @@ -456,15 +456,14 @@ XS(XS_UNIVERSAL_import_unimport) * depends on it has its own "no import" logic that produces better * warnings than this does. */ if (strNE(class_pv,"_charnames")) - Perl_ck_warner_d(aTHX_ - packWARN(WARN_DEPRECATED__MISSING_IMPORT_CALLED_WITH_ARGS), - "Attempt to call undefined %s method with arguments " - "(%" SVf_QUOTEDPREFIX "%s) via package " - "%" SVf_QUOTEDPREFIX " (Perhaps you forgot to load the package?)", - ix ? "unimport" : "import", - SVfARG(ST(1)), - (items > 2 ? " ..." : ""), - SVfARG(ST(0))); + ck_warner_d(packWARN(WARN_DEPRECATED__MISSING_IMPORT_CALLED_WITH_ARGS), + "Attempt to call undefined %s method with arguments " + "(%" SVf_QUOTEDPREFIX "%s) via package " + "%" SVf_QUOTEDPREFIX " (Perhaps you forgot to load the package?)", + ix ? "unimport" : "import", + SVfARG(ST(1)), + (items > 2 ? " ..." : ""), + SVfARG(ST(0))); } XSRETURN_EMPTY; } diff --git a/utf8.c b/utf8.c index e2714b57d0a9..9950ac7631d6 100644 --- a/utf8.c +++ b/utf8.c @@ -247,7 +247,7 @@ Perl_uvoffuni_to_utf8_flags_msgs(pTHX_ U8 *d, UV input_uv, UV flags, HV** msgs) : UNICODE_GOT_SUPER); } else { - Perl_ck_warner_d(aTHX_ category, format, input_uv); + ck_warner_d(category, format, input_uv); } /* Don't output a 2nd msg */ @@ -290,7 +290,7 @@ Perl_uvoffuni_to_utf8_flags_msgs(pTHX_ U8 *d, UV input_uv, UV flags, HV** msgs) UNICODE_GOT_SUPER); } else { - Perl_ck_warner_d(aTHX_ category, format, input_uv); + ck_warner_d(category, format, input_uv); } if (flags & UNICODE_DISALLOW_SUPER) { @@ -322,7 +322,7 @@ Perl_uvoffuni_to_utf8_flags_msgs(pTHX_ U8 *d, UV input_uv, UV flags, HV** msgs) UNICODE_GOT_NONCHAR); } else { - Perl_ck_warner_d(aTHX_ category, format, input_uv); + ck_warner_d(category, format, input_uv); } } if (flags & UNICODE_DISALLOW_NONCHAR) { @@ -339,7 +339,7 @@ Perl_uvoffuni_to_utf8_flags_msgs(pTHX_ U8 *d, UV input_uv, UV flags, HV** msgs) UNICODE_GOT_SURROGATE); } else { - Perl_ck_warner_d(aTHX_ category, format, input_uv); + ck_warner_d(category, format, input_uv); } } if (flags & UNICODE_DISALLOW_SURROGATE) { @@ -2559,11 +2559,10 @@ Perl_utf8_to_uv_msgs_helper_(const U8 * const s0, } if (PL_op) { - Perl_warner(aTHX_ pack_warn, "%s in %s", message, - OP_DESC(PL_op)); + warner(pack_warn, "%s in %s", message, OP_DESC(PL_op)); } else { - Perl_warner(aTHX_ pack_warn, "%s", message); + warner(pack_warn, "%s", message); } if (UNLIKELY(flags & ( UTF8_DIE_IF_MALFORMED @@ -2667,10 +2666,10 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) warn_and_return: if (ckWARN_d(WARN_UTF8)) { if (PL_op) - Perl_warner(aTHX_ packWARN(WARN_UTF8), - "%s in %s", unees, OP_DESC(PL_op)); + warner(packWARN(WARN_UTF8), + "%s in %s", unees, OP_DESC(PL_op)); else - Perl_warner(aTHX_ packWARN(WARN_UTF8), "%s", unees); + warner(packWARN(WARN_UTF8), "%s", unees); } return s - s0; @@ -2795,19 +2794,19 @@ Perl_bytes_cmp_utf8(pTHX_ const U8 *b, STRLEN blen, const U8 *u, STRLEN ulen) c = EIGHT_BIT_UTF8_TO_NATIVE(c, c1); } else { /* diag_listed_as: Malformed UTF-8 character%s */ - Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), - "%s %s%s", - unexpected_non_continuation_text(u - 2, 2, 1, 2), - PL_op ? " in " : "", - PL_op ? OP_DESC(PL_op) : ""); + ck_warner_d(packWARN(WARN_UTF8), + "%s %s%s", + unexpected_non_continuation_text(u - 2, 2, 1, 2), + PL_op ? " in " : "", + PL_op ? OP_DESC(PL_op) : ""); return -2; } } else { if (PL_op) - Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), - "%s in %s", unees, OP_DESC(PL_op)); + ck_warner_d(packWARN(WARN_UTF8), + "%s in %s", unees, OP_DESC(PL_op)); else - Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), "%s", unees); + ck_warner_d(packWARN(WARN_UTF8), "%s", unees); return -2; /* Really want to return undef :-) */ } } else { @@ -3908,18 +3907,18 @@ S_warn_on_first_deprecated_use(pTHX_ U32 category, } if (instr(file, "mathoms.c")) { - Perl_warner(aTHX_ category, - "In %s, line %d, starting in Perl v5.32, %s()" - " will be removed. Avoid this message by" - " converting to use %s().\n", - file, line, name, alternative); + warner(category, + "In %s, line %d, starting in Perl v5.32, %s()" + " will be removed. Avoid this message by" + " converting to use %s().\n", + file, line, name, alternative); } else { - Perl_warner(aTHX_ category, - "In %s, line %d, starting in Perl v5.32, %s() will" - " require an additional parameter. Avoid this" - " message by converting to use %s().\n", - file, line, name, alternative); + warner(category, + "In %s, line %d, starting in Perl v5.32, %s() will" + " require an additional parameter. Avoid this" + " message by converting to use %s().\n", + file, line, name, alternative); } } } @@ -4008,9 +4007,9 @@ S_to_case_cp_list(pTHX_ if (UNLIKELY(UNICODE_IS_SURROGATE(original))) { if (ckWARN_d(WARN_SURROGATE)) { const char* desc = (PL_op) ? OP_DESC(PL_op) : normal; - Perl_warner(aTHX_ packWARN(WARN_SURROGATE), - "Operation \"%s\" returns its argument for" - " UTF-16 surrogate U+%04" UVXf, desc, original); + warner(packWARN(WARN_SURROGATE), + "Operation \"%s\" returns its argument for" + " UTF-16 surrogate U+%04" UVXf, desc, original); } } else if (UNLIKELY(UNICODE_IS_SUPER(original))) { @@ -4019,9 +4018,9 @@ S_to_case_cp_list(pTHX_ } if (ckWARN_d(WARN_NON_UNICODE)) { const char* desc = (PL_op) ? OP_DESC(PL_op) : normal; - Perl_warner(aTHX_ packWARN(WARN_NON_UNICODE), - "Operation \"%s\" returns its argument for" - " non-Unicode code point 0x%04" UVXf, desc, original); + warner(packWARN(WARN_NON_UNICODE), + "Operation \"%s\" returns its argument for" + " non-Unicode code point 0x%04" UVXf, desc, original); } } @@ -4230,12 +4229,10 @@ S_check_locale_boundary_crossing(pTHX_ const U8* const p, const UV result, original = valid_utf8_to_uvchr(p, lenp); /* diag_listed_as: Can't do %s("%s") on non-UTF-8 locale; resolved to "%s". */ - Perl_ck_warner(aTHX_ packWARN(WARN_LOCALE), - "Can't do %s(\"\\x{%" UVXf "}\") on non-UTF-8" - " locale; resolved to \"\\x{%" UVXf "}\".", - OP_DESC(PL_op), - original, - original); + ck_warner(packWARN(WARN_LOCALE), + "Can't do %s(\"\\x{%" UVXf "}\") on non-UTF-8" + " locale; resolved to \"\\x{%" UVXf "}\".", + OP_DESC(PL_op), original, original); Copy(p, ustrp, *lenp, char); return original; } @@ -4552,9 +4549,9 @@ Perl__to_utf8_fold_flags(pTHX_ const U8 *p, if (memBEGINs((char *) p, e - p, CAP_SHARP_S)) { /* diag_listed_as: Can't do %s("%s") on non-UTF-8 locale; resolved to "%s". */ - Perl_ck_warner(aTHX_ packWARN(WARN_LOCALE), - "Can't do fc(\"\\x{1E9E}\") on non-UTF-8 locale; " - "resolved to \"\\x{17F}\\x{17F}\"."); + ck_warner(packWARN(WARN_LOCALE), + "Can't do fc(\"\\x{1E9E}\") on non-UTF-8 locale; " + "resolved to \"\\x{17F}\\x{17F}\"."); goto return_long_s; } else @@ -4562,9 +4559,9 @@ Perl__to_utf8_fold_flags(pTHX_ const U8 *p, if (memBEGINs((char *) p, e - p, LONG_S_T)) { /* diag_listed_as: Can't do %s("%s") on non-UTF-8 locale; resolved to "%s". */ - Perl_ck_warner(aTHX_ packWARN(WARN_LOCALE), - "Can't do fc(\"\\x{FB05}\") on non-UTF-8 locale; " - "resolved to \"\\x{FB06}\"."); + ck_warner(packWARN(WARN_LOCALE), + "Can't do fc(\"\\x{FB05}\") on non-UTF-8 locale; " + "resolved to \"\\x{FB06}\"."); goto return_ligature_st; } @@ -4580,9 +4577,9 @@ Perl__to_utf8_fold_flags(pTHX_ const U8 *p, * this release) */ else if (memBEGINs((char *) p, e - p, DOTTED_I)) { /* diag_listed_as: Can't do %s("%s") on non-UTF-8 locale; resolved to "%s". */ - Perl_ck_warner(aTHX_ packWARN(WARN_LOCALE), - "Can't do fc(\"\\x{0130}\") on non-UTF-8 locale; " - "resolved to \"\\x{0131}\"."); + ck_warner(packWARN(WARN_LOCALE), + "Can't do fc(\"\\x{0130}\") on non-UTF-8 locale; " + "resolved to \"\\x{0131}\"."); goto return_dotless_i; } #endif @@ -4701,8 +4698,8 @@ Perl_check_utf8_print(pTHX_ const U8* s, const STRLEN len) while (s < e) { if (UTF8SKIP(s) > len) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), - "%s in %s", unees, PL_op ? OP_DESC(PL_op) : "print"); + ck_warner_d(packWARN(WARN_UTF8), + "%s in %s", unees, PL_op ? OP_DESC(PL_op) : "print"); return FALSE; } if (UNLIKELY(isUTF8_POSSIBLY_PROBLEMATIC(*s))) { @@ -4723,9 +4720,9 @@ Perl_check_utf8_print(pTHX_ const U8* s, const STRLEN len) * function would output, so can't just call it, unlike we * do for the non-chars and above-unicodes */ UV uv = utf8_to_uv_or_die(s, e, NULL); - Perl_warner(aTHX_ packWARN(WARN_SURROGATE), - "Unicode surrogate U+%04" UVXf " is illegal in UTF-8", - uv); + warner(packWARN(WARN_SURROGATE), + "Unicode surrogate U+%04" UVXf " is illegal in UTF-8", + uv); ok = FALSE; } } diff --git a/util.c b/util.c index 732884194d0b..6e78718c2978 100644 --- a/util.c +++ b/util.c @@ -2230,7 +2230,7 @@ Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args) vfatal_warner(err, pat, args); } else { - Perl_vwarn(aTHX_ pat, args); + vwarn(pat, args); } } @@ -2523,7 +2523,7 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) } return NULL; } - Perl_ck_warner(aTHX_ packWARN(WARN_PIPE), "Can't fork, trying again in 5 seconds"); + ck_warner(packWARN(WARN_PIPE), "Can't fork, trying again in 5 seconds"); sleep(5); } if (pid == 0) { @@ -2696,7 +2696,7 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode) croak("Can't fork: %s", Strerror(errno)); return NULL; } - Perl_ck_warner(aTHX_ packWARN(WARN_PIPE), "Can't fork, trying again in 5 seconds"); + ck_warner(packWARN(WARN_PIPE), "Can't fork, trying again in 5 seconds"); sleep(5); } if (pid == 0) { @@ -3789,11 +3789,11 @@ Perl_report_wrongway_fh(pTHX_ const GV *gv, const char have) const char * const direction = have == '>' ? "out" : "in"; if (name && HEK_LEN(name)) - Perl_warner(aTHX_ packWARN(WARN_IO), + warner(packWARN(WARN_IO), "Filehandle %" HEKf " opened only for %sput", HEKfARG(name), direction); else - Perl_warner(aTHX_ packWARN(WARN_IO), + warner(packWARN(WARN_IO), "Filehandle opened only for %sput", direction); } } @@ -3832,7 +3832,7 @@ Perl_report_evil_fh(pTHX_ const GV *gv) (OP_IS_SOCKET(op) || (io && IoTYPE(io) == IoTYPE_SOCKET) ? "socket" : "filehandle"); const bool have_name = name && SvCUR(name); - Perl_warner(aTHX_ packWARN(warn_type), + warner(packWARN(warn_type), "%s%s on %s %s%s%" SVf, func, pars, vile, type, have_name ? " " : "", SVfARG(have_name ? name : &PL_sv_no)); diff --git a/vms/vms.c b/vms/vms.c index 8303ca9117cf..75fe696aeb58 100644 --- a/vms/vms.c +++ b/vms/vms.c @@ -975,7 +975,7 @@ Perl_vmstrnenv(const char *lnm, char *eqv, unsigned long int idx, } else #endif if (ckWARN(WARN_MISC)) { - Perl_warner(aTHX_ packWARN(WARN_MISC),"Value of CLI symbol \"%s\" too long",lnm); + warner(packWARN(WARN_MISC),"Value of CLI symbol \"%s\" too long",lnm); } } strncpy(eqv,eqvdsc.dsc$a_pointer,eqvlen); @@ -1342,7 +1342,7 @@ prime_env_iter(void) for (j--; j >= 0; j--) { if (!(start = strchr(environ[j],'='))) { if (ckWARN(WARN_INTERNAL)) - Perl_warner(aTHX_ packWARN(WARN_INTERNAL),"Ill-formed CRTL environ value \"%s\"\n",environ[j]); + warner(packWARN(WARN_INTERNAL),"Ill-formed CRTL environ value \"%s\"\n",environ[j]); } else { start++; @@ -1411,7 +1411,7 @@ prime_env_iter(void) continue; } if (sts == SS$_BUFFEROVF && ckWARN(WARN_INTERNAL)) - Perl_warner(aTHX_ packWARN(WARN_INTERNAL),"Buffer overflow in prime_env_iter: %s",buf); + warner(packWARN(WARN_INTERNAL),"Buffer overflow in prime_env_iter: %s",buf); for (cp1 = buf; *cp1 && isSPACE_L1(*cp1); cp1++) ; if (*cp1 == '(' || /* Logical name table name */ @@ -1432,7 +1432,7 @@ prime_env_iter(void) cp1--; /* stop on last non-space char */ } if ((!keylen || (cp1 - cp2 < -1)) && ckWARN(WARN_INTERNAL)) { - Perl_warner(aTHX_ packWARN(WARN_INTERNAL),"Ill-formed message in prime_env_iter: |%s|",buf); + warner(packWARN(WARN_INTERNAL),"Ill-formed message in prime_env_iter: |%s|",buf); continue; } PERL_HASH(hash,key,keylen); @@ -1576,8 +1576,8 @@ Perl_vmssetenv(pTHX_ const char *lnm, const char *eqv, struct dsc$descriptor_s * nseg = (eqvdsc.dsc$w_length + LNM$C_NAMLENGTH - 1) / LNM$C_NAMLENGTH; if (nseg > PERL_LNM_MAX_ALLOWED_INDEX + 1) { - Perl_warner(aTHX_ packWARN(WARN_MISC),"Value of logical \"%s\" too long. Truncating to %i bytes", - lnm, LNM$C_NAMLENGTH * (PERL_LNM_MAX_ALLOWED_INDEX+1)); + warner(packWARN(WARN_MISC),"Value of logical \"%s\" too long. Truncating to %i bytes", + lnm, LNM$C_NAMLENGTH * (PERL_LNM_MAX_ALLOWED_INDEX+1)); eqvdsc.dsc$w_length = LNM$C_NAMLENGTH * (PERL_LNM_MAX_ALLOWED_INDEX+1); nseg = PERL_LNM_MAX_ALLOWED_INDEX + 1; } diff --git a/win32/win32.c b/win32/win32.c index 0168ad929db8..64b85c62bee7 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -726,7 +726,7 @@ Perl_do_aspawn(pTHX_ SV *really, SV **mark, SV **sp) else { if (status < 0) { if (ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't spawn \"%s\": %s", argv[0], strerror(errno)); + warner(packWARN(WARN_EXEC), "Can't spawn \"%s\": %s", argv[0], strerror(errno)); status = 255 * 256; } else @@ -845,7 +845,7 @@ do_spawn2_handles(pTHX_ const char *cmd, int exectype, const int *handles) else { if (status < 0) { if (ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s \"%s\": %s", + warner(packWARN(WARN_EXEC), "Can't %s \"%s\": %s", (exectype == EXECF_EXEC ? "exec" : "spawn"), cmd, strerror(errno)); status = 255 * 256; @@ -3024,7 +3024,7 @@ win32_sleep(unsigned int t) dTHX; /* Win32 times are in ms so *1000 in and /1000 out */ if (t > UINT_MAX / 1000) { - Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), + ck_warner(packWARN(WARN_OVERFLOW), "sleep(%lu) too large", t); } return win32_msgwait(aTHX_ 0, NULL, t * 1000, NULL) / 1000;