Skip to content

Commit 30aeaad

Browse files
ilmarimauke
ilmari
authored and
mauke
committed
Stop calling Perl_*warn*() manually in core
Except reg*.[ch], which are also compiled "outside" core for re.pm
1 parent 7066fe7 commit 30aeaad

37 files changed

+693
-732
lines changed

‎amigaos4/amigaio.c‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -632,8 +632,8 @@ static void S_exec_failed(pTHX_ const char *cmd, int fd, int do_report)
632632
if (e)
633633
{
634634
if (ckWARN(WARN_EXEC))
635-
Perl_warner(aTHX_ packWARN(WARN_EXEC),
636-
"Can't exec \"%s\": %s", cmd, Strerror(e));
635+
warner(packWARN(WARN_EXEC),
636+
"Can't exec \"%s\": %s", cmd, Strerror(e));
637637
}
638638
if (do_report)
639639
{

‎av.c‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,7 @@ Perl_av_reify(pTHX_ AV *av)
3131
return;
3232
#ifdef DEBUGGING
3333
if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied))
34-
Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "av_reify called on tied array");
34+
ck_warner_d(packWARN(WARN_DEBUGGING), "av_reify called on tied array");
3535
#endif
3636
key = AvMAX(av) + 1;
3737
while (key > AvFILLp(av) + 1)
@@ -641,7 +641,7 @@ Perl_av_clear(pTHX_ AV *av)
641641

642642
#ifdef DEBUGGING
643643
if (SvREFCNT(av) == 0) {
644-
Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "Attempt to clear deleted array");
644+
ck_warner_d(packWARN(WARN_DEBUGGING), "Attempt to clear deleted array");
645645
}
646646
#endif
647647

‎builtin.c‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -33,8 +33,8 @@ struct BuiltinFuncDescriptor {
3333
static void S_warn_experimental_builtin(pTHX_ const char *name)
3434
{
3535
/* diag_listed_as: Built-in function '%s' is experimental */
36-
Perl_ck_warner_d(aTHX_ packWARN(WARN_EXPERIMENTAL__BUILTIN),
37-
"Built-in function 'builtin::%s' is experimental", name);
36+
ck_warner_d(packWARN(WARN_EXPERIMENTAL__BUILTIN),
37+
"Built-in function 'builtin::%s' is experimental", name);
3838
}
3939

4040
/* These three utilities might want to live elsewhere to be reused from other
@@ -498,13 +498,13 @@ Perl_XS_builtin_indexed(pTHX_ CV *cv)
498498

499499
switch(GIMME_V) {
500500
case G_VOID:
501-
Perl_ck_warner(aTHX_ packWARN(WARN_VOID),
502-
"Useless use of %s in void context", "builtin::indexed");
501+
ck_warner(packWARN(WARN_VOID),
502+
"Useless use of %s in void context", "builtin::indexed");
503503
XSRETURN(0);
504504

505505
case G_SCALAR:
506-
Perl_ck_warner(aTHX_ packWARN(WARN_SCALAR),
507-
"Useless use of %s in scalar context", "builtin::indexed");
506+
ck_warner(packWARN(WARN_SCALAR),
507+
"Useless use of %s in scalar context", "builtin::indexed");
508508
ST(0) = sv_2mortal(newSViv(items * 2));
509509
XSRETURN(1);
510510

‎class.c‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -102,8 +102,7 @@ PP(pp_initfield)
102102
STRLEN svcount = PL_stack_sp - svp + 1;
103103

104104
if(svcount % 2)
105-
Perl_warner(aTHX_
106-
packWARN(WARN_MISC), "Odd number of elements in hash field initialization");
105+
warner(packWARN(WARN_MISC), "Odd number of elements in hash field initialization");
107106

108107
while(svp <= PL_stack_sp) {
109108
SV *key = *svp; svp++;

‎cygwin/cygwin.c‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -42,8 +42,8 @@ do_spawnvp (const char *path, const char * const *argv)
4242
if (childpid < 0) {
4343
status = -1;
4444
if(ckWARN(WARN_EXEC))
45-
Perl_warner(aTHX_ packWARN(WARN_EXEC),"Can't spawn \"%s\": %s",
46-
path,Strerror (errno));
45+
warner(packWARN(WARN_EXEC),"Can't spawn \"%s\": %s",
46+
path, Strerror(errno));
4747
} else {
4848
do {
4949
result = wait4pid(childpid, &status, 0);

‎doio.c‎

Lines changed: 55 additions & 58 deletions
Original file line numberDiff line numberDiff line change
@@ -636,8 +636,7 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len,
636636
#ifdef USE_STDIO
637637
if (SvROK(*svp) && !memchr(oname, '&', len)) {
638638
if (ckWARN(WARN_IO))
639-
Perl_warner(aTHX_ packWARN(WARN_IO),
640-
"Can't open a reference");
639+
warner(packWARN(WARN_IO), "Can't open a reference");
641640
SETERRNO(EINVAL, LIB_INVARG);
642641
fp = NULL;
643642
goto say_false;
@@ -685,7 +684,7 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len,
685684
if (*name == '\0') {
686685
/* command is missing 19990114 */
687686
if (ckWARN(WARN_PIPE))
688-
Perl_warner(aTHX_ packWARN(WARN_PIPE), "Missing command in piped open");
687+
warner(packWARN(WARN_PIPE), "Missing command in piped open");
689688
errno = EPIPE;
690689
fp = NULL;
691690
goto say_false;
@@ -696,7 +695,7 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len,
696695
if (!num_svs && name[len-1] == '|') {
697696
name[--len] = '\0' ;
698697
if (ckWARN(WARN_PIPE))
699-
Perl_warner(aTHX_ packWARN(WARN_PIPE), "Can't open bidirectional pipe");
698+
warner(packWARN(WARN_PIPE), "Can't open bidirectional pipe");
700699
}
701700
mode[0] = 'w';
702701
writing = 1;
@@ -919,7 +918,7 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len,
919918
if (*name == '\0') {
920919
/* command is missing 19990114 */
921920
if (ckWARN(WARN_PIPE))
922-
Perl_warner(aTHX_ packWARN(WARN_PIPE), "Missing command in piped open");
921+
warner(packWARN(WARN_PIPE), "Missing command in piped open");
923922
errno = EPIPE;
924923
fp = NULL;
925924
goto say_false;
@@ -1004,7 +1003,7 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname,
10041003
)
10051004
{
10061005
GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral); /* PL_warn_nl is constant */
1007-
Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
1006+
warner(packWARN(WARN_NEWLINE), PL_warn_nl, "open");
10081007
GCC_DIAG_RESTORE_STMT;
10091008
}
10101009
goto say_false;
@@ -1013,17 +1012,16 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname,
10131012
if (ckWARN(WARN_IO)) {
10141013
if ((IoTYPE(io) == IoTYPE_RDONLY) &&
10151014
(fp == PerlIO_stdout() || fp == PerlIO_stderr())) {
1016-
Perl_warner(aTHX_ packWARN(WARN_IO),
1017-
"Filehandle STD%s reopened as %" HEKf
1018-
" only for input",
1019-
((fp == PerlIO_stdout()) ? "OUT" : "ERR"),
1020-
HEKfARG(GvENAME_HEK(gv)));
1015+
warner(packWARN(WARN_IO),
1016+
"Filehandle STD%s reopened as %" HEKf
1017+
" only for input",
1018+
((fp == PerlIO_stdout()) ? "OUT" : "ERR"),
1019+
HEKfARG(GvENAME_HEK(gv)));
10211020
}
10221021
else if ((IoTYPE(io) == IoTYPE_WRONLY) && fp == PerlIO_stdin()) {
1023-
Perl_warner(aTHX_ packWARN(WARN_IO),
1024-
"Filehandle STDIN reopened as %" HEKf " only for output",
1025-
HEKfARG(GvENAME_HEK(gv))
1026-
);
1022+
warner(packWARN(WARN_IO),
1023+
"Filehandle STDIN reopened as %" HEKf " only for output",
1024+
HEKfARG(GvENAME_HEK(gv)));
10271025
}
10281026
}
10291027

@@ -1440,9 +1438,9 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
14401438
}
14411439
else {
14421440
if (is_fork_open(PL_oldname)) {
1443-
Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE),
1444-
"Forked open '%s' not meaningful in <>",
1445-
PL_oldname);
1441+
ck_warner_d(packWARN(WARN_INPLACE),
1442+
"Forked open '%s' not meaningful in <>",
1443+
PL_oldname);
14461444
continue;
14471445
}
14481446

@@ -1485,9 +1483,9 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
14851483
fileuid = statbuf.st_uid;
14861484
filegid = statbuf.st_gid;
14871485
if (!S_ISREG(PL_filemode)) {
1488-
Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE),
1489-
"Can't do inplace edit: %s is not a regular file",
1490-
PL_oldname );
1486+
ck_warner_d(packWARN(WARN_INPLACE),
1487+
"Can't do inplace edit: %s is not a regular file",
1488+
PL_oldname );
14911489
do_close(gv,FALSE);
14921490
continue;
14931491
}
@@ -1514,10 +1512,10 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
15141512
&& statbuf.st_ino == fileino)
15151513
)
15161514
{
1517-
Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE),
1518-
"Can't do inplace edit: %"
1519-
SVf " would not be unique",
1520-
SVfARG(sv));
1515+
ck_warner_d(packWARN(WARN_INPLACE),
1516+
"Can't do inplace edit: %"
1517+
SVf " would not be unique",
1518+
SVfARG(sv));
15211519
goto cleanup_argv;
15221520
}
15231521
#endif
@@ -1530,8 +1528,8 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
15301528
if (!S_openindirtemp(aTHX_ PL_argvoutgv, GvSV(gv), temp_name_sv)) {
15311529
SvREFCNT_dec(temp_name_sv);
15321530
/* diag_listed_as: Can't do inplace edit on %s: %s */
1533-
Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE), "Can't do inplace edit on %s: Cannot make temp name: %s",
1534-
PL_oldname, Strerror(errno) );
1531+
ck_warner_d(packWARN(WARN_INPLACE), "Can't do inplace edit on %s: Cannot make temp name: %s",
1532+
PL_oldname, Strerror(errno) );
15351533
#ifndef FLEXFILENAMES
15361534
cleanup_argv:
15371535
#endif
@@ -1583,13 +1581,13 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
15831581
Stat_t statbuf;
15841582
if (PerlLIO_stat(PL_oldname, &statbuf) >= 0
15851583
&& !S_ISREG(statbuf.st_mode)) {
1586-
Perl_warner(aTHX_ packWARN(WARN_INPLACE),
1587-
"Can't do inplace edit: %s is not a regular file",
1588-
PL_oldname);
1584+
warner(packWARN(WARN_INPLACE),
1585+
"Can't do inplace edit: %s is not a regular file",
1586+
PL_oldname);
15891587
}
15901588
else {
1591-
Perl_warner(aTHX_ packWARN(WARN_INPLACE), "Can't open %s: %s",
1592-
PL_oldname, Strerror(eno));
1589+
warner(packWARN(WARN_INPLACE), "Can't open %s: %s",
1590+
PL_oldname, Strerror(eno));
15931591
}
15941592
}
15951593
}
@@ -1964,16 +1962,16 @@ Perl_io_close(pTHX_ IO *io, GV *gv, bool is_explict, bool warn_on_fail)
19641962

19651963
if (warn_on_fail && !retval) {
19661964
if (gv)
1967-
Perl_ck_warner_d(aTHX_ packWARN(WARN_IO),
1968-
"Warning: unable to close filehandle %"
1969-
HEKf " properly: %" SVf,
1970-
HEKfARG(GvNAME_HEK(gv)),
1971-
SVfARG(get_sv("!",GV_ADD)));
1965+
ck_warner_d(packWARN(WARN_IO),
1966+
"Warning: unable to close filehandle %"
1967+
HEKf " properly: %" SVf,
1968+
HEKfARG(GvNAME_HEK(gv)),
1969+
SVfARG(get_sv("!",GV_ADD)));
19721970
else
1973-
Perl_ck_warner_d(aTHX_ packWARN(WARN_IO),
1974-
"Warning: unable to close filehandle "
1975-
"properly: %" SVf,
1976-
SVfARG(get_sv("!",GV_ADD)));
1971+
ck_warner_d(packWARN(WARN_IO),
1972+
"Warning: unable to close filehandle "
1973+
"properly: %" SVf,
1974+
SVfARG(get_sv("!",GV_ADD)));
19771975
}
19781976
}
19791977
else if (is_explict) {
@@ -2249,10 +2247,9 @@ Perl_do_print(pTHX_ SV *sv, PerlIO *fp)
22492247
if (! utf8_to_bytes_new_pv(&tmps, &len, &free_me)) {
22502248
/* Non-utf8 output stream, but string only representable in
22512249
utf8 */
2252-
Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8),
2253-
"Wide character in %s",
2254-
PL_op ? OP_DESC(PL_op) : "print"
2255-
);
2250+
ck_warner_d(packWARN(WARN_UTF8),
2251+
"Wide character in %s",
2252+
PL_op ? OP_DESC(PL_op) : "print");
22562253
/* Could also check that isn't one of the things to avoid
22572254
* in utf8 by using check_utf8_print(), but not doing so,
22582255
* since the stream isn't a UTF8 stream */
@@ -2337,7 +2334,7 @@ Perl_my_stat_flags(pTHX_ const U32 flags)
23372334
}
23382335
if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && should_warn_nl(s)) {
23392336
GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral); /* PL_warn_nl is constant */
2340-
Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat");
2337+
warner(packWARN(WARN_NEWLINE), PL_warn_nl, "stat");
23412338
GCC_DIAG_RESTORE_STMT;
23422339
}
23432340
return PL_laststatval;
@@ -2364,9 +2361,9 @@ Perl_my_lstat_flags(pTHX_ const U32 flags)
23642361
PL_laststatval = -1;
23652362
if (ckWARN(WARN_IO)) {
23662363
/* diag_listed_as: Use of -l on filehandle%s */
2367-
Perl_warner(aTHX_ packWARN(WARN_IO),
2368-
"Use of -l on filehandle %" HEKf,
2369-
HEKfARG(GvENAME_HEK(cGVOP_gv)));
2364+
warner(packWARN(WARN_IO),
2365+
"Use of -l on filehandle %" HEKf,
2366+
HEKfARG(GvENAME_HEK(cGVOP_gv)));
23702367
}
23712368
SETERRNO(EBADF,RMS_IFI);
23722369
return -1;
@@ -2388,14 +2385,14 @@ Perl_my_lstat_flags(pTHX_ const U32 flags)
23882385
&& ckWARN(WARN_IO)) {
23892386
if (isio)
23902387
/* diag_listed_as: Use of -l on filehandle%s */
2391-
Perl_warner(aTHX_ packWARN(WARN_IO),
2392-
"Use of -l on filehandle");
2388+
warner(packWARN(WARN_IO),
2389+
"Use of -l on filehandle");
23932390
else
23942391
/* diag_listed_as: Use of -l on filehandle%s */
2395-
Perl_warner(aTHX_ packWARN(WARN_IO),
2396-
"Use of -l on filehandle %" HEKf,
2397-
HEKfARG(GvENAME_HEK((const GV *)
2398-
(SvROK(sv) ? SvRV(sv) : sv))));
2392+
warner(packWARN(WARN_IO),
2393+
"Use of -l on filehandle %" HEKf,
2394+
HEKfARG(GvENAME_HEK((const GV *)
2395+
(SvROK(sv) ? SvRV(sv) : sv))));
23992396
}
24002397
file = SvPV_flags_const(sv, len, flags);
24012398
sv_setpv(PL_statname,file);
@@ -2407,7 +2404,7 @@ Perl_my_lstat_flags(pTHX_ const U32 flags)
24072404
}
24082405
if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && should_warn_nl(file)) {
24092406
GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral); /* PL_warn_nl is constant */
2410-
Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "lstat");
2407+
warner(packWARN(WARN_NEWLINE), PL_warn_nl, "lstat");
24112408
GCC_DIAG_RESTORE_STMT;
24122409
}
24132410
return PL_laststatval;
@@ -2420,7 +2417,7 @@ S_exec_failed(pTHX_ const char *cmd, int fd, int do_report)
24202417
PERL_ARGS_ASSERT_EXEC_FAILED;
24212418

24222419
if (ckWARN(WARN_EXEC))
2423-
Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
2420+
warner(packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
24242421
cmd, Strerror(e));
24252422
if (do_report) {
24262423
/* XXX silently ignore failures */
@@ -3523,7 +3520,7 @@ Perl_vms_start_glob
35233520
LEAVE;
35243521

35253522
if (!fp && ckWARN(WARN_GLOB)) {
3526-
Perl_warner(aTHX_ packWARN(WARN_GLOB), "glob failed (can't start child: %s)",
3523+
warner(packWARN(WARN_GLOB), "glob failed (can't start child: %s)",
35273524
Strerror(errno));
35283525
}
35293526

‎doop.c‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -833,8 +833,8 @@ Perl_do_vecget(pTHX_ SV *sv, STRLEN offset, int size)
833833
#ifdef UV_IS_QUAD
834834

835835
if (size == 64) {
836-
Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE),
837-
"Bit vector size > 32 non-portable");
836+
ck_warner(packWARN(WARN_PORTABLE),
837+
"Bit vector size > 32 non-portable");
838838
}
839839
#endif
840840
if (offset > Size_t_MAX / n - 1) /* would overflow */
@@ -961,8 +961,8 @@ Perl_do_vecset(pTHX_ SV *sv)
961961
#ifdef UV_IS_QUAD
962962

963963
case 64:
964-
Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE),
965-
"Bit vector size > 32 non-portable");
964+
ck_warner(packWARN(WARN_PORTABLE),
965+
"Bit vector size > 32 non-portable");
966966
s[offset+7] = (U8)( lval ); /* = size - 64 */
967967
s[offset+6] = (U8)( lval >> 8); /* = size - 56 */
968968
s[offset+5] = (U8)( lval >> 16); /* = size - 48 */

‎dquote.c‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -71,7 +71,7 @@ Perl_grok_bslash_c(pTHX_ const char source,
7171
*packed_warn = packWARN(WARN_SYNTAX);
7272
}
7373
else {
74-
Perl_warner(aTHX_ packWARN(WARN_SYNTAX), format, source, clearer);
74+
warner(packWARN(WARN_SYNTAX), format, source, clearer);
7575
}
7676
}
7777

@@ -360,7 +360,7 @@ Perl_grok_bslash_o(pTHX_ char **s, const char * const send, UV *uv,
360360
*packed_warn = packWARN(WARN_DIGIT);
361361
}
362362
else {
363-
Perl_warner(aTHX_ packWARN(WARN_DIGIT), "%s", failure);
363+
warner(packWARN(WARN_DIGIT), "%s", failure);
364364
}
365365
}
366366
}
@@ -467,7 +467,7 @@ Perl_grok_bslash_x(pTHX_ char ** s, const char * const send, UV *uv,
467467
send, UTF, FALSE);
468468

469469
if (! packed_warn) {
470-
Perl_warner(aTHX_ packWARN(WARN_DIGIT), "%s", failure);
470+
warner(packWARN(WARN_DIGIT), "%s", failure);
471471
}
472472
else {
473473
*message = failure;
@@ -546,7 +546,7 @@ Perl_grok_bslash_x(pTHX_ char ** s, const char * const send, UV *uv,
546546
const char * failure = form_alien_digit_msg(16, numbers_len, *s,
547547
send, UTF, TRUE);
548548
if (! packed_warn) {
549-
Perl_warner(aTHX_ packWARN(WARN_DIGIT), "%s", failure);
549+
warner(packWARN(WARN_DIGIT), "%s", failure);
550550
}
551551
else {
552552
*message = failure;

‎dump.c‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2964,7 +2964,7 @@ Perl_runops_debug(pTHX)
29642964
#endif
29652965

29662966
if (!PL_op) {
2967-
Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
2967+
ck_warner_d(packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
29682968
return 0;
29692969
}
29702970
DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n"));

0 commit comments

Comments
 (0)