Skip to content

Commit 9365cdf

Browse files
committedMar 20, 2025·
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.
1 parent 1b66608 commit 9365cdf

File tree

12 files changed

+96
-130
lines changed

12 files changed

+96
-130
lines changed
 

‎amigaos4/amigaio.c

+2-3
Original file line numberDiff line numberDiff line change
@@ -631,9 +631,8 @@ static void S_exec_failed(pTHX_ const char *cmd, int fd, int do_report)
631631
// PERL_ARGS_ASSERT_EXEC_FAILED;
632632
if (e)
633633
{
634-
if (ckWARN(WARN_EXEC))
635-
warner(packWARN(WARN_EXEC),
636-
"Can't exec \"%s\": %s", cmd, Strerror(e));
634+
ck_warner(packWARN(WARN_EXEC),
635+
"Can't exec \"%s\": %s", cmd, Strerror(e));
637636
}
638637
if (do_report)
639638
{

‎cygwin/cygwin.c

+2-3
Original file line numberDiff line numberDiff line change
@@ -41,9 +41,8 @@ do_spawnvp (const char *path, const char * const *argv)
4141
childpid = spawnvp(_P_NOWAIT,path,argv);
4242
if (childpid < 0) {
4343
status = -1;
44-
if(ckWARN(WARN_EXEC))
45-
warner(packWARN(WARN_EXEC),"Can't spawn \"%s\": %s",
46-
path, Strerror(errno));
44+
ck_warner(packWARN(WARN_EXEC), "Can't spawn \"%s\": %s",
45+
path, Strerror(errno));
4746
} else {
4847
do {
4948
result = wait4pid(childpid, &status, 0);

‎doio.c

+13-20
Original file line numberDiff line numberDiff line change
@@ -635,8 +635,7 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len,
635635
/* New style explicit name, type is just mode and layer info */
636636
#ifdef USE_STDIO
637637
if (SvROK(*svp) && !memchr(oname, '&', len)) {
638-
if (ckWARN(WARN_IO))
639-
warner(packWARN(WARN_IO), "Can't open a reference");
638+
ck_warner(packWARN(WARN_IO), "Can't open a reference");
640639
SETERRNO(EINVAL, LIB_INVARG);
641640
fp = NULL;
642641
goto say_false;
@@ -683,8 +682,7 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len,
683682
}
684683
if (*name == '\0') {
685684
/* command is missing 19990114 */
686-
if (ckWARN(WARN_PIPE))
687-
warner(packWARN(WARN_PIPE), "Missing command in piped open");
685+
ck_warner(packWARN(WARN_PIPE), "Missing command in piped open");
688686
errno = EPIPE;
689687
fp = NULL;
690688
goto say_false;
@@ -694,8 +692,7 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len,
694692
TAINT_PROPER("piped open");
695693
if (!num_svs && name[len-1] == '|') {
696694
name[--len] = '\0' ;
697-
if (ckWARN(WARN_PIPE))
698-
warner(packWARN(WARN_PIPE), "Can't open bidirectional pipe");
695+
ck_warner(packWARN(WARN_PIPE), "Can't open bidirectional pipe");
699696
}
700697
mode[0] = 'w';
701698
writing = 1;
@@ -917,8 +914,7 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len,
917914
}
918915
if (*name == '\0') {
919916
/* command is missing 19990114 */
920-
if (ckWARN(WARN_PIPE))
921-
warner(packWARN(WARN_PIPE), "Missing command in piped open");
917+
ck_warner(packWARN(WARN_PIPE), "Missing command in piped open");
922918
errno = EPIPE;
923919
fp = NULL;
924920
goto say_false;
@@ -2359,12 +2355,10 @@ Perl_my_lstat_flags(pTHX_ const U32 flags)
23592355
return PL_laststatval;
23602356
}
23612357
PL_laststatval = -1;
2362-
if (ckWARN(WARN_IO)) {
2363-
/* diag_listed_as: Use of -l on filehandle%s */
2364-
warner(packWARN(WARN_IO),
2365-
"Use of -l on filehandle %" HEKf,
2366-
HEKfARG(GvENAME_HEK(cGVOP_gv)));
2367-
}
2358+
/* diag_listed_as: Use of -l on filehandle%s */
2359+
ck_warner(packWARN(WARN_IO),
2360+
"Use of -l on filehandle %" HEKf,
2361+
HEKfARG(GvENAME_HEK(cGVOP_gv)));
23682362
SETERRNO(EBADF,RMS_IFI);
23692363
return -1;
23702364
}
@@ -2416,9 +2410,8 @@ S_exec_failed(pTHX_ const char *cmd, int fd, int do_report)
24162410
const int e = errno;
24172411
PERL_ARGS_ASSERT_EXEC_FAILED;
24182412

2419-
if (ckWARN(WARN_EXEC))
2420-
warner(packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
2421-
cmd, Strerror(e));
2413+
ck_warner(packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
2414+
cmd, Strerror(e));
24222415
if (do_report) {
24232416
/* XXX silently ignore failures */
24242417
PERL_UNUSED_RESULT(PerlLIO_write(fd, (void*)&e, sizeof(int)));
@@ -3519,9 +3512,9 @@ Perl_vms_start_glob
35193512
#endif /* !VMS */
35203513
LEAVE;
35213514

3522-
if (!fp && ckWARN(WARN_GLOB)) {
3523-
warner(packWARN(WARN_GLOB), "glob failed (can't start child: %s)",
3524-
Strerror(errno));
3515+
if (!fp) {
3516+
ck_warner(packWARN(WARN_GLOB), "glob failed (can't start child: %s)",
3517+
Strerror(errno));
35253518
}
35263519

35273520
return fp;

‎os2/os2.c

+21-22
Original file line numberDiff line numberDiff line change
@@ -1165,9 +1165,8 @@ do_spawn_ve(pTHX_ SV *really, const char **argv, U32 flag, U32 execf, char *inic
11651165
}
11661166
if (PerlIO_close(file) != 0) { /* Failure */
11671167
panic_file:
1168-
if (ckWARN(WARN_EXEC))
1169-
warner(packWARN(WARN_EXEC), "Error reading \"%s\": %s",
1170-
scr, Strerror(errno));
1168+
ck_warner(packWARN(WARN_EXEC), "Error reading \"%s\": %s",
1169+
scr, Strerror(errno));
11711170
buf = ""; /* Not #! */
11721171
goto doshell_args;
11731172
}
@@ -1300,18 +1299,18 @@ do_spawn_ve(pTHX_ SV *really, const char **argv, U32 flag, U32 execf, char *inic
13001299
errno = err;
13011300
}
13021301
} else if (errno == ENOEXEC) { /* Cannot transfer `real_name' via shell. */
1303-
if (rc < 0 && ckWARN(WARN_EXEC))
1304-
warner(packWARN(WARN_EXEC), "Can't %s script `%s' with ARGV[0] being `%s'",
1305-
((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC)
1306-
? "spawn" : "exec"),
1307-
real_name, argv[0]);
1302+
if (rc < 0)
1303+
ck_warner(packWARN(WARN_EXEC), "Can't %s script `%s' with ARGV[0] being `%s'",
1304+
((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC)
1305+
? "spawn" : "exec"),
1306+
real_name, argv[0]);
13081307
goto warned;
13091308
} else if (errno == ENOENT) { /* Cannot transfer `real_name' via shell. */
1310-
if (rc < 0 && ckWARN(WARN_EXEC))
1311-
warner(packWARN(WARN_EXEC), "Can't %s `%s' with ARGV[0] being `%s' (looking for executables only, not found)",
1312-
((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC)
1313-
? "spawn" : "exec"),
1314-
real_name, argv[0]);
1309+
if (rc < 0))
1310+
ck_warner(packWARN(WARN_EXEC), "Can't %s `%s' with ARGV[0] being `%s' (looking for executables only, not found)",
1311+
((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC)
1312+
? "spawn" : "exec"),
1313+
real_name, argv[0]);
13151314
goto warned;
13161315
}
13171316
} 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
13251324
goto retry;
13261325
}
13271326
}
1328-
if (rc < 0 && ckWARN(WARN_EXEC))
1329-
warner(packWARN(WARN_EXEC), "Can't %s \"%s\": %s\n",
1330-
((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC)
1331-
? "spawn" : "exec"),
1332-
real_name, Strerror(errno));
1327+
if (rc < 0))
1328+
ck_warner(packWARN(WARN_EXEC), "Can't %s \"%s\": %s\n",
1329+
((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC)
1330+
? "spawn" : "exec"),
1331+
real_name, Strerror(errno));
13331332
warned:
13341333
if (rc < 0 && (execf != EXECF_SPAWN_NOWAIT)
13351334
&& ((trueflag & 0xFF) == P_WAIT))
@@ -1436,10 +1435,10 @@ do_spawn3(pTHX_ char *cmd, int execf, int flag)
14361435
else
14371436
rc = result(aTHX_ P_WAIT,
14381437
spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0));
1439-
if (rc < 0 && ckWARN(WARN_EXEC))
1440-
warner(packWARN(WARN_EXEC), "Can't %s \"%s\": %s",
1441-
(execf == EXECF_SPAWN ? "spawn" : "exec"),
1442-
shell, Strerror(errno));
1438+
if (rc < 0)
1439+
ck_warner(packWARN(WARN_EXEC), "Can't %s \"%s\": %s",
1440+
(execf == EXECF_SPAWN ? "spawn" : "exec"),
1441+
shell, Strerror(errno));
14431442
if (rc < 0)
14441443
rc = -1;
14451444
}

‎perl.c

+7-8
Original file line numberDiff line numberDiff line change
@@ -1423,8 +1423,8 @@ perl_destruct(pTHXx)
14231423
}
14241424
}
14251425

1426-
if (PL_sv_count != 0 && ckWARN_d(WARN_INTERNAL))
1427-
warner(packWARN(WARN_INTERNAL),"Scalars leaked: %ld\n", (long)PL_sv_count);
1426+
if (PL_sv_count != 0)
1427+
ck_warner_d(packWARN(WARN_INTERNAL), "Scalars leaked: %ld\n", (long)PL_sv_count);
14281428

14291429
#ifdef DEBUG_LEAKING_SCALARS
14301430
if (PL_sv_count != 0) {
@@ -3645,9 +3645,9 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
36453645
const char * const d = strchr(debopts,**s);
36463646
if (d)
36473647
uv |= 1 << (d - debopts);
3648-
else if (ckWARN_d(WARN_DEBUGGING))
3649-
warner(packWARN(WARN_DEBUGGING),
3650-
"invalid option -D%c, use -D'' to see choices\n", **s);
3648+
else
3649+
ck_warner_d(packWARN(WARN_DEBUGGING),
3650+
"invalid option -D%c, use -D'' to see choices\n", **s);
36513651
}
36523652
}
36533653
else if (isDIGIT(**s)) {
@@ -3804,9 +3804,8 @@ Perl_moreswitches(pTHX_ const char *s)
38043804
s++;
38053805
PL_debug = get_debug_opts( (const char **)&s, 1) | DEBUG_TOP_FLAG;
38063806
#else /* !DEBUGGING */
3807-
if (ckWARN_d(WARN_DEBUGGING))
3808-
warner(packWARN(WARN_DEBUGGING),
3809-
"Recompile perl with -DDEBUGGING to use -D switch (did you mean -d ?)\n");
3807+
ck_warner_d(packWARN(WARN_DEBUGGING),
3808+
"Recompile perl with -DDEBUGGING to use -D switch (did you mean -d ?)\n");
38103809
for (s++; isWORDCHAR(*s); s++) ;
38113810
#endif
38123811
return s;

‎perlio.c

+5-10
Original file line numberDiff line numberDiff line change
@@ -1086,8 +1086,7 @@ PerlIOScalar_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg,
10861086
if (SvROK(arg)) {
10871087
if (SvREADONLY(SvRV(arg)) && !SvIsCOW(SvRV(arg))
10881088
&& mode && *mode != 'r') {
1089-
if (ckWARN(WARN_LAYER))
1090-
warner(packWARN(WARN_LAYER), "%s", PL_no_modify);
1089+
ck_warner(packWARN(WARN_LAYER), "%s", PL_no_modify);
10911090
SETERRNO(EACCES, RMS_PRV);
10921091
return -1;
10931092
}
@@ -1115,8 +1114,7 @@ PerlIOScalar_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg,
11151114
if (SvPOK(s->var)) *SvPVX(s->var) = 0;
11161115
}
11171116
if (SvUTF8(s->var) && !sv_utf8_downgrade(s->var, TRUE)) {
1118-
if (ckWARN(WARN_UTF8))
1119-
warner(packWARN(WARN_UTF8), code_point_warning);
1117+
ck_warner(packWARN(WARN_UTF8), code_point_warning);
11201118
SETERRNO(EINVAL, SS_IVCHAN);
11211119
SvREFCNT_dec(s->var);
11221120
s->var = NULL;
@@ -1181,8 +1179,7 @@ PerlIOScalar_seek(pTHX_ PerlIO * f, Off_t offset, int whence)
11811179
return -1;
11821180
}
11831181
if (new_posn < 0) {
1184-
if (ckWARN(WARN_LAYER))
1185-
warner(packWARN(WARN_LAYER), "Offset outside string");
1182+
ck_warner(packWARN(WARN_LAYER), "Offset outside string");
11861183
SETERRNO(EINVAL, SS_IVCHAN);
11871184
return -1;
11881185
}
@@ -1221,8 +1218,7 @@ PerlIOScalar_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
12211218
p = SvPV_nomg(sv, len);
12221219
}
12231220
else {
1224-
if (ckWARN(WARN_UTF8))
1225-
warner(packWARN(WARN_UTF8), code_point_warning);
1221+
ck_warner(packWARN(WARN_UTF8), code_point_warning);
12261222
SETERRNO(EINVAL, SS_IVCHAN);
12271223
return -1;
12281224
}
@@ -1265,8 +1261,7 @@ PerlIOScalar_write(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
12651261
if (!SvROK(sv)) sv_force_normal(sv);
12661262
if (SvOK(sv)) SvPV_force_nomg_nolen(sv);
12671263
if (SvUTF8(sv) && !sv_utf8_downgrade(sv, TRUE)) {
1268-
if (ckWARN(WARN_UTF8))
1269-
warner(packWARN(WARN_UTF8), code_point_warning);
1264+
ck_warner(packWARN(WARN_UTF8), code_point_warning);
12701265
SETERRNO(EINVAL, SS_IVCHAN);
12711266
return 0;
12721267
}

‎pp_hot.c

+4-4
Original file line numberDiff line numberDiff line change
@@ -6626,10 +6626,10 @@ PP(pp_aelem)
66266626
SV *sv;
66276627
SV *retsv;
66286628

6629-
if (UNLIKELY(SvROK(elemsv) && !SvGAMAGIC(elemsv) && ckWARN(WARN_MISC)))
6630-
warner(packWARN(WARN_MISC),
6631-
"Use of reference \"%" SVf "\" as array index",
6632-
SVfARG(elemsv));
6629+
if (UNLIKELY(SvROK(elemsv) && !SvGAMAGIC(elemsv)))
6630+
ck_warner(packWARN(WARN_MISC),
6631+
"Use of reference \"%" SVf "\" as array index",
6632+
SVfARG(elemsv));
66336633
if (UNLIKELY(SvTYPE(av) != SVt_PVAV)) {
66346634
retsv = &PL_sv_undef;
66356635
goto ret;

‎pp_sys.c

+2-4
Original file line numberDiff line numberDiff line change
@@ -3900,10 +3900,8 @@ PP_wrapped(pp_chdir, MAXARG, 0)
39003900
if (PL_op->op_flags & OPf_SPECIAL) {
39013901
gv = gv_fetchsv(sv, 0, SVt_PVIO);
39023902
if (!gv) {
3903-
if (ckWARN(WARN_UNOPENED)) {
3904-
warner(packWARN(WARN_UNOPENED),
3905-
"chdir() on unopened filehandle %" SVf, sv);
3906-
}
3903+
ck_warner(packWARN(WARN_UNOPENED),
3904+
"chdir() on unopened filehandle %" SVf, sv);
39073905
SETERRNO(EBADF,RMS_IFI);
39083906
TAINT_PROPER("chdir");
39093907
RETPUSHNO;

‎sv.c

+5-7
Original file line numberDiff line numberDiff line change
@@ -11444,10 +11444,8 @@ S_sv_catpvn_simple(pTHX_ SV *const sv, const char* const buf, const STRLEN len)
1144411444
*/
1144511445
STATIC void
1144611446
S_warn_vcatpvfn_missing_argument(pTHX) {
11447-
if (ckWARN(WARN_MISSING)) {
11448-
warner(packWARN(WARN_MISSING), "Missing argument in %s",
11449-
PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");
11450-
}
11447+
ck_warner(packWARN(WARN_MISSING), "Missing argument in %s",
11448+
PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");
1145111449
}
1145211450

1145311451

@@ -13909,9 +13907,9 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
1390913907
/* Now that we've consumed all our printf format arguments (svix)
1391013908
* do we have things left on the stack that we didn't use?
1391113909
*/
13912-
if (!no_redundant_warning && sv_count >= svix + 1 && ckWARN(WARN_REDUNDANT)) {
13913-
warner(packWARN(WARN_REDUNDANT), "Redundant argument in %s",
13914-
PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");
13910+
if (!no_redundant_warning && sv_count >= svix + 1) {
13911+
ck_warner(packWARN(WARN_REDUNDANT), "Redundant argument in %s",
13912+
PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");
1391513913
}
1391613914

1391713915
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {

‎utf8.c

+17-21
Original file line numberDiff line numberDiff line change
@@ -2664,13 +2664,11 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e)
26642664
}
26652665

26662666
warn_and_return:
2667-
if (ckWARN_d(WARN_UTF8)) {
2668-
if (PL_op)
2669-
warner(packWARN(WARN_UTF8),
2670-
"%s in %s", unees, OP_DESC(PL_op));
2671-
else
2672-
warner(packWARN(WARN_UTF8), "%s", unees);
2673-
}
2667+
if (PL_op)
2668+
ck_warner_d(packWARN(WARN_UTF8),
2669+
"%s in %s", unees, OP_DESC(PL_op));
2670+
else
2671+
ck_warner_d(packWARN(WARN_UTF8), "%s", unees);
26742672

26752673
return s - s0;
26762674
}
@@ -4005,23 +4003,21 @@ S_to_case_cp_list(pTHX_
40054003
* points */
40064004
if (isUNICODE_POSSIBLY_PROBLEMATIC(original)) {
40074005
if (UNLIKELY(UNICODE_IS_SURROGATE(original))) {
4008-
if (ckWARN_d(WARN_SURROGATE)) {
4009-
const char* desc = (PL_op) ? OP_DESC(PL_op) : normal;
4010-
warner(packWARN(WARN_SURROGATE),
4011-
"Operation \"%s\" returns its argument for"
4012-
" UTF-16 surrogate U+%04" UVXf, desc, original);
4013-
}
4006+
ck_warner_d(packWARN(WARN_SURROGATE),
4007+
"Operation \"%s\" returns its argument for"
4008+
" UTF-16 surrogate U+%04" UVXf,
4009+
(PL_op) ? OP_DESC(PL_op) : normal,
4010+
original);
40144011
}
40154012
else if (UNLIKELY(UNICODE_IS_SUPER(original))) {
4016-
if (UNLIKELY(original > MAX_LEGAL_CP)) {
4013+
if (UNLIKELY(original > MAX_LEGAL_CP))
40174014
croak("%s", form_cp_too_large_msg(16, NULL, 0, original));
4018-
}
4019-
if (ckWARN_d(WARN_NON_UNICODE)) {
4020-
const char* desc = (PL_op) ? OP_DESC(PL_op) : normal;
4021-
warner(packWARN(WARN_NON_UNICODE),
4022-
"Operation \"%s\" returns its argument for"
4023-
" non-Unicode code point 0x%04" UVXf, desc, original);
4024-
}
4015+
4016+
ck_warner_d(packWARN(WARN_NON_UNICODE),
4017+
"Operation \"%s\" returns its argument for"
4018+
" non-Unicode code point 0x%04" UVXf,
4019+
(PL_op) ? OP_DESC(PL_op) : normal,
4020+
original);
40254021
}
40264022

40274023
/* Note that non-characters are perfectly legal, so no warning

0 commit comments

Comments
 (0)
Please sign in to comment.