Use ck_warner() more

Replace trivial uses of

    if(ckWARN(WARN_FOO))
        warner(packWARN(WARN_FOO), ...);

with

    ck_warner(packWARN(WARN_FOO), ...);

This does mean that the format string arguments get evaluated even if
the warning category isn't enabled, but the most expensive thing I
could see was Strerror(), which I woudn't worry about.
This commit is contained in:
Dagfinn Ilmari Mannsåker 2025-03-18 19:32:46 +00:00
parent 1b66608de9
commit 9365cdf765
12 changed files with 96 additions and 130 deletions

View File

@ -631,9 +631,8 @@ static void S_exec_failed(pTHX_ const char *cmd, int fd, int do_report)
// PERL_ARGS_ASSERT_EXEC_FAILED;
if (e)
{
if (ckWARN(WARN_EXEC))
warner(packWARN(WARN_EXEC),
"Can't exec \"%s\": %s", cmd, Strerror(e));
ck_warner(packWARN(WARN_EXEC),
"Can't exec \"%s\": %s", cmd, Strerror(e));
}
if (do_report)
{

View File

@ -41,9 +41,8 @@ do_spawnvp (const char *path, const char * const *argv)
childpid = spawnvp(_P_NOWAIT,path,argv);
if (childpid < 0) {
status = -1;
if(ckWARN(WARN_EXEC))
warner(packWARN(WARN_EXEC),"Can't spawn \"%s\": %s",
path, Strerror(errno));
ck_warner(packWARN(WARN_EXEC), "Can't spawn \"%s\": %s",
path, Strerror(errno));
} else {
do {
result = wait4pid(childpid, &status, 0);

33
doio.c
View File

@ -635,8 +635,7 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len,
/* New style explicit name, type is just mode and layer info */
#ifdef USE_STDIO
if (SvROK(*svp) && !memchr(oname, '&', len)) {
if (ckWARN(WARN_IO))
warner(packWARN(WARN_IO), "Can't open a reference");
ck_warner(packWARN(WARN_IO), "Can't open a reference");
SETERRNO(EINVAL, LIB_INVARG);
fp = NULL;
goto say_false;
@ -683,8 +682,7 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len,
}
if (*name == '\0') {
/* command is missing 19990114 */
if (ckWARN(WARN_PIPE))
warner(packWARN(WARN_PIPE), "Missing command in piped open");
ck_warner(packWARN(WARN_PIPE), "Missing command in piped open");
errno = EPIPE;
fp = NULL;
goto say_false;
@ -694,8 +692,7 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len,
TAINT_PROPER("piped open");
if (!num_svs && name[len-1] == '|') {
name[--len] = '\0' ;
if (ckWARN(WARN_PIPE))
warner(packWARN(WARN_PIPE), "Can't open bidirectional pipe");
ck_warner(packWARN(WARN_PIPE), "Can't open bidirectional pipe");
}
mode[0] = 'w';
writing = 1;
@ -917,8 +914,7 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len,
}
if (*name == '\0') {
/* command is missing 19990114 */
if (ckWARN(WARN_PIPE))
warner(packWARN(WARN_PIPE), "Missing command in piped open");
ck_warner(packWARN(WARN_PIPE), "Missing command in piped open");
errno = EPIPE;
fp = NULL;
goto say_false;
@ -2359,12 +2355,10 @@ Perl_my_lstat_flags(pTHX_ const U32 flags)
return PL_laststatval;
}
PL_laststatval = -1;
if (ckWARN(WARN_IO)) {
/* diag_listed_as: Use of -l on filehandle%s */
warner(packWARN(WARN_IO),
"Use of -l on filehandle %" HEKf,
HEKfARG(GvENAME_HEK(cGVOP_gv)));
}
/* diag_listed_as: Use of -l on filehandle%s */
ck_warner(packWARN(WARN_IO),
"Use of -l on filehandle %" HEKf,
HEKfARG(GvENAME_HEK(cGVOP_gv)));
SETERRNO(EBADF,RMS_IFI);
return -1;
}
@ -2416,9 +2410,8 @@ S_exec_failed(pTHX_ const char *cmd, int fd, int do_report)
const int e = errno;
PERL_ARGS_ASSERT_EXEC_FAILED;
if (ckWARN(WARN_EXEC))
warner(packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
cmd, Strerror(e));
ck_warner(packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
cmd, Strerror(e));
if (do_report) {
/* XXX silently ignore failures */
PERL_UNUSED_RESULT(PerlLIO_write(fd, (void*)&e, sizeof(int)));
@ -3519,9 +3512,9 @@ Perl_vms_start_glob
#endif /* !VMS */
LEAVE;
if (!fp && ckWARN(WARN_GLOB)) {
warner(packWARN(WARN_GLOB), "glob failed (can't start child: %s)",
Strerror(errno));
if (!fp) {
ck_warner(packWARN(WARN_GLOB), "glob failed (can't start child: %s)",
Strerror(errno));
}
return fp;

View File

@ -1165,9 +1165,8 @@ 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))
warner(packWARN(WARN_EXEC), "Error reading \"%s\": %s",
scr, Strerror(errno));
ck_warner(packWARN(WARN_EXEC), "Error reading \"%s\": %s",
scr, Strerror(errno));
buf = ""; /* Not #! */
goto doshell_args;
}
@ -1300,18 +1299,18 @@ do_spawn_ve(pTHX_ SV *really, const char **argv, U32 flag, U32 execf, char *inic
errno = err;
}
} else if (errno == ENOEXEC) { /* Cannot transfer `real_name' via shell. */
if (rc < 0 && ckWARN(WARN_EXEC))
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]);
if (rc < 0)
ck_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))
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]);
if (rc < 0))
ck_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]);
goto warned;
}
} else if (rc < 0 && pass == 2 && errno == ENOENT) { /* File not found */
@ -1325,11 +1324,11 @@ do_spawn_ve(pTHX_ SV *really, const char **argv, U32 flag, U32 execf, char *inic
goto retry;
}
}
if (rc < 0 && ckWARN(WARN_EXEC))
warner(packWARN(WARN_EXEC), "Can't %s \"%s\": %s\n",
((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC)
? "spawn" : "exec"),
real_name, Strerror(errno));
if (rc < 0))
ck_warner(packWARN(WARN_EXEC), "Can't %s \"%s\": %s\n",
((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC)
? "spawn" : "exec"),
real_name, Strerror(errno));
warned:
if (rc < 0 && (execf != EXECF_SPAWN_NOWAIT)
&& ((trueflag & 0xFF) == P_WAIT))
@ -1436,10 +1435,10 @@ do_spawn3(pTHX_ char *cmd, int execf, int flag)
else
rc = result(aTHX_ P_WAIT,
spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0));
if (rc < 0 && ckWARN(WARN_EXEC))
warner(packWARN(WARN_EXEC), "Can't %s \"%s\": %s",
(execf == EXECF_SPAWN ? "spawn" : "exec"),
shell, Strerror(errno));
if (rc < 0)
ck_warner(packWARN(WARN_EXEC), "Can't %s \"%s\": %s",
(execf == EXECF_SPAWN ? "spawn" : "exec"),
shell, Strerror(errno));
if (rc < 0)
rc = -1;
}

15
perl.c
View File

@ -1423,8 +1423,8 @@ perl_destruct(pTHXx)
}
}
if (PL_sv_count != 0 && ckWARN_d(WARN_INTERNAL))
warner(packWARN(WARN_INTERNAL),"Scalars leaked: %ld\n", (long)PL_sv_count);
if (PL_sv_count != 0)
ck_warner_d(packWARN(WARN_INTERNAL), "Scalars leaked: %ld\n", (long)PL_sv_count);
#ifdef DEBUG_LEAKING_SCALARS
if (PL_sv_count != 0) {
@ -3645,9 +3645,9 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
const char * const d = strchr(debopts,**s);
if (d)
uv |= 1 << (d - debopts);
else if (ckWARN_d(WARN_DEBUGGING))
warner(packWARN(WARN_DEBUGGING),
"invalid option -D%c, use -D'' to see choices\n", **s);
else
ck_warner_d(packWARN(WARN_DEBUGGING),
"invalid option -D%c, use -D'' to see choices\n", **s);
}
}
else if (isDIGIT(**s)) {
@ -3804,9 +3804,8 @@ Perl_moreswitches(pTHX_ const char *s)
s++;
PL_debug = get_debug_opts( (const char **)&s, 1) | DEBUG_TOP_FLAG;
#else /* !DEBUGGING */
if (ckWARN_d(WARN_DEBUGGING))
warner(packWARN(WARN_DEBUGGING),
"Recompile perl with -DDEBUGGING to use -D switch (did you mean -d ?)\n");
ck_warner_d(packWARN(WARN_DEBUGGING),
"Recompile perl with -DDEBUGGING to use -D switch (did you mean -d ?)\n");
for (s++; isWORDCHAR(*s); s++) ;
#endif
return s;

View File

@ -1086,8 +1086,7 @@ PerlIOScalar_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg,
if (SvROK(arg)) {
if (SvREADONLY(SvRV(arg)) && !SvIsCOW(SvRV(arg))
&& mode && *mode != 'r') {
if (ckWARN(WARN_LAYER))
warner(packWARN(WARN_LAYER), "%s", PL_no_modify);
ck_warner(packWARN(WARN_LAYER), "%s", PL_no_modify);
SETERRNO(EACCES, RMS_PRV);
return -1;
}
@ -1115,8 +1114,7 @@ PerlIOScalar_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg,
if (SvPOK(s->var)) *SvPVX(s->var) = 0;
}
if (SvUTF8(s->var) && !sv_utf8_downgrade(s->var, TRUE)) {
if (ckWARN(WARN_UTF8))
warner(packWARN(WARN_UTF8), code_point_warning);
ck_warner(packWARN(WARN_UTF8), code_point_warning);
SETERRNO(EINVAL, SS_IVCHAN);
SvREFCNT_dec(s->var);
s->var = NULL;
@ -1181,8 +1179,7 @@ PerlIOScalar_seek(pTHX_ PerlIO * f, Off_t offset, int whence)
return -1;
}
if (new_posn < 0) {
if (ckWARN(WARN_LAYER))
warner(packWARN(WARN_LAYER), "Offset outside string");
ck_warner(packWARN(WARN_LAYER), "Offset outside string");
SETERRNO(EINVAL, SS_IVCHAN);
return -1;
}
@ -1221,8 +1218,7 @@ PerlIOScalar_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
p = SvPV_nomg(sv, len);
}
else {
if (ckWARN(WARN_UTF8))
warner(packWARN(WARN_UTF8), code_point_warning);
ck_warner(packWARN(WARN_UTF8), code_point_warning);
SETERRNO(EINVAL, SS_IVCHAN);
return -1;
}
@ -1265,8 +1261,7 @@ PerlIOScalar_write(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
if (!SvROK(sv)) sv_force_normal(sv);
if (SvOK(sv)) SvPV_force_nomg_nolen(sv);
if (SvUTF8(sv) && !sv_utf8_downgrade(sv, TRUE)) {
if (ckWARN(WARN_UTF8))
warner(packWARN(WARN_UTF8), code_point_warning);
ck_warner(packWARN(WARN_UTF8), code_point_warning);
SETERRNO(EINVAL, SS_IVCHAN);
return 0;
}

View File

@ -6626,10 +6626,10 @@ PP(pp_aelem)
SV *sv;
SV *retsv;
if (UNLIKELY(SvROK(elemsv) && !SvGAMAGIC(elemsv) && ckWARN(WARN_MISC)))
warner(packWARN(WARN_MISC),
"Use of reference \"%" SVf "\" as array index",
SVfARG(elemsv));
if (UNLIKELY(SvROK(elemsv) && !SvGAMAGIC(elemsv)))
ck_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;

View File

@ -3900,10 +3900,8 @@ PP_wrapped(pp_chdir, MAXARG, 0)
if (PL_op->op_flags & OPf_SPECIAL) {
gv = gv_fetchsv(sv, 0, SVt_PVIO);
if (!gv) {
if (ckWARN(WARN_UNOPENED)) {
warner(packWARN(WARN_UNOPENED),
"chdir() on unopened filehandle %" SVf, sv);
}
ck_warner(packWARN(WARN_UNOPENED),
"chdir() on unopened filehandle %" SVf, sv);
SETERRNO(EBADF,RMS_IFI);
TAINT_PROPER("chdir");
RETPUSHNO;

12
sv.c
View File

@ -11444,10 +11444,8 @@ S_sv_catpvn_simple(pTHX_ SV *const sv, const char* const buf, const STRLEN len)
*/
STATIC void
S_warn_vcatpvfn_missing_argument(pTHX) {
if (ckWARN(WARN_MISSING)) {
warner(packWARN(WARN_MISSING), "Missing argument in %s",
PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");
}
ck_warner(packWARN(WARN_MISSING), "Missing argument in %s",
PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");
}
@ -13909,9 +13907,9 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
/* Now that we've consumed all our printf format arguments (svix)
* do we have things left on the stack that we didn't use?
*/
if (!no_redundant_warning && sv_count >= svix + 1 && ckWARN(WARN_REDUNDANT)) {
warner(packWARN(WARN_REDUNDANT), "Redundant argument in %s",
PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");
if (!no_redundant_warning && sv_count >= svix + 1) {
ck_warner(packWARN(WARN_REDUNDANT), "Redundant argument in %s",
PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");
}
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {

38
utf8.c
View File

@ -2664,13 +2664,11 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e)
}
warn_and_return:
if (ckWARN_d(WARN_UTF8)) {
if (PL_op)
warner(packWARN(WARN_UTF8),
"%s in %s", unees, OP_DESC(PL_op));
else
warner(packWARN(WARN_UTF8), "%s", unees);
}
if (PL_op)
ck_warner_d(packWARN(WARN_UTF8),
"%s in %s", unees, OP_DESC(PL_op));
else
ck_warner_d(packWARN(WARN_UTF8), "%s", unees);
return s - s0;
}
@ -4005,23 +4003,21 @@ S_to_case_cp_list(pTHX_
* points */
if (isUNICODE_POSSIBLY_PROBLEMATIC(original)) {
if (UNLIKELY(UNICODE_IS_SURROGATE(original))) {
if (ckWARN_d(WARN_SURROGATE)) {
const char* desc = (PL_op) ? OP_DESC(PL_op) : normal;
warner(packWARN(WARN_SURROGATE),
"Operation \"%s\" returns its argument for"
" UTF-16 surrogate U+%04" UVXf, desc, original);
}
ck_warner_d(packWARN(WARN_SURROGATE),
"Operation \"%s\" returns its argument for"
" UTF-16 surrogate U+%04" UVXf,
(PL_op) ? OP_DESC(PL_op) : normal,
original);
}
else if (UNLIKELY(UNICODE_IS_SUPER(original))) {
if (UNLIKELY(original > MAX_LEGAL_CP)) {
if (UNLIKELY(original > MAX_LEGAL_CP))
croak("%s", form_cp_too_large_msg(16, NULL, 0, original));
}
if (ckWARN_d(WARN_NON_UNICODE)) {
const char* desc = (PL_op) ? OP_DESC(PL_op) : normal;
warner(packWARN(WARN_NON_UNICODE),
"Operation \"%s\" returns its argument for"
" non-Unicode code point 0x%04" UVXf, desc, original);
}
ck_warner_d(packWARN(WARN_NON_UNICODE),
"Operation \"%s\" returns its argument for"
" non-Unicode code point 0x%04" UVXf,
(PL_op) ? OP_DESC(PL_op) : normal,
original);
}
/* Note that non-characters are perfectly legal, so no warning

View File

@ -974,9 +974,7 @@ Perl_vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
"Value of CLI symbol \"%s\" too long",lnm);
} else
#endif
if (ckWARN(WARN_MISC)) {
warner(packWARN(WARN_MISC),"Value of CLI symbol \"%s\" too long",lnm);
}
ck_warner(packWARN(WARN_MISC),"Value of CLI symbol \"%s\" too long",lnm);
}
strncpy(eqv,eqvdsc.dsc$a_pointer,eqvlen);
}
@ -1341,8 +1339,7 @@ prime_env_iter(void)
for (j = 0; environ[j]; j++);
for (j--; j >= 0; j--) {
if (!(start = strchr(environ[j],'='))) {
if (ckWARN(WARN_INTERNAL))
warner(packWARN(WARN_INTERNAL),"Ill-formed CRTL environ value \"%s\"\n",environ[j]);
ck_warner(packWARN(WARN_INTERNAL),"Ill-formed CRTL environ value \"%s\"\n",environ[j]);
}
else {
start++;
@ -1410,8 +1407,8 @@ prime_env_iter(void)
}
continue;
}
if (sts == SS$_BUFFEROVF && ckWARN(WARN_INTERNAL))
warner(packWARN(WARN_INTERNAL),"Buffer overflow in prime_env_iter: %s",buf);
if (sts == SS$_BUFFEROVF)
ck_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 */
@ -4260,10 +4257,8 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
} else { /* uh, oh...we're in tempfile hell */
tpipe = vmspipe_tempfile(aTHX);
if (!tpipe) { /* a fish popular in Boston */
if (ckWARN(WARN_PIPE)) {
Perl_warner(aTHX_ packWARN(WARN_PIPE),"unable to find VMSPIPE.COM for i/o piping");
}
return NULL;
ck_warner(packWARN(WARN_PIPE),"unable to find VMSPIPE.COM for i/o piping");
return NULL;
}
fgetname(tpipe,tfilebuf+1,1);
vmspipedsc.dsc$w_length = strlen(tfilebuf);
@ -4291,9 +4286,9 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
set_errno(EVMSERR);
}
set_vaxc_errno(sts);
if (*in_mode != 'n' && ckWARN(WARN_PIPE)) {
Perl_warner(aTHX_ packWARN(WARN_PIPE),"Can't pipe \"%*s\": %s", strlen(cmd), cmd, Strerror(errno));
}
if (*in_mode != 'n')
ck_warner(packWARN(WARN_PIPE), "Can't pipe \"%*s\": %s", strlen(cmd), cmd, Strerror(errno));
*psts = sts;
return NULL;
}
@ -10982,10 +10977,9 @@ Perl_vms_do_exec(pTHX_ const char *cmd)
set_errno(EVMSERR);
}
set_vaxc_errno(retsts);
if (ckWARN(WARN_EXEC)) {
Perl_warner(aTHX_ packWARN(WARN_EXEC),"Can't exec \"%*s\": %s",
vmscmd->dsc$w_length, vmscmd->dsc$a_pointer, Strerror(errno));
}
ck_warner(packWARN(WARN_EXEC),"Can't exec \"%*s\": %s",
vmscmd->dsc$w_length, vmscmd->dsc$a_pointer, Strerror(errno));
vms_execfree(vmscmd);
}
@ -11082,10 +11076,8 @@ do_spawn2(pTHX_ const char *cmd, int flags)
set_errno(EVMSERR);
}
set_vaxc_errno(sts);
if (ckWARN(WARN_EXEC)) {
Perl_warner(aTHX_ packWARN(WARN_EXEC),"Can't spawn: %s",
Strerror(errno));
}
ck_warner(packWARN(WARN_EXEC),"Can't spawn: %s",
Strerror(errno));
}
sts = substs;
}

View File

@ -725,8 +725,7 @@ Perl_do_aspawn(pTHX_ SV *really, SV **mark, SV **sp)
}
else {
if (status < 0) {
if (ckWARN(WARN_EXEC))
warner(packWARN(WARN_EXEC), "Can't spawn \"%s\": %s", argv[0], strerror(errno));
ck_warner(packWARN(WARN_EXEC), "Can't spawn \"%s\": %s", argv[0], strerror(errno));
status = 255 * 256;
}
else
@ -844,10 +843,9 @@ do_spawn2_handles(pTHX_ const char *cmd, int exectype, const int *handles)
}
else {
if (status < 0) {
if (ckWARN(WARN_EXEC))
warner(packWARN(WARN_EXEC), "Can't %s \"%s\": %s",
(exectype == EXECF_EXEC ? "exec" : "spawn"),
cmd, strerror(errno));
ck_warner(packWARN(WARN_EXEC), "Can't %s \"%s\": %s",
(exectype == EXECF_EXEC ? "exec" : "spawn"),
cmd, strerror(errno));
status = 255 * 256;
}
else