diff options
| -rw-r--r-- | av.c | 8 | ||||
| -rw-r--r-- | doio.c | 46 | ||||
| -rw-r--r-- | dump.c | 3 | ||||
| -rw-r--r-- | embed.fnc | 1 | ||||
| -rw-r--r-- | embed.h | 1 | ||||
| -rw-r--r-- | global.sym | 1 | ||||
| -rw-r--r-- | gv.c | 17 | ||||
| -rw-r--r-- | hv.c | 12 | ||||
| -rw-r--r-- | malloc.c | 28 | ||||
| -rw-r--r-- | numeric.c | 15 | ||||
| -rw-r--r-- | op.c | 11 | ||||
| -rw-r--r-- | pad.c | 9 | ||||
| -rw-r--r-- | perl.c | 22 | ||||
| -rw-r--r-- | proto.h | 6 | ||||
| -rw-r--r-- | sv.c | 22 | ||||
| -rw-r--r-- | taint.c | 3 | ||||
| -rw-r--r-- | toke.c | 50 | ||||
| -rw-r--r-- | utf8.c | 12 | ||||
| -rw-r--r-- | util.c | 13 |
19 files changed, 136 insertions, 144 deletions
@@ -35,8 +35,8 @@ Perl_av_reify(pTHX_ AV *av) if (AvREAL(av)) return; #ifdef DEBUGGING - if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied) && ckWARN_d(WARN_DEBUGGING)) - Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "av_reify called on tied array"); + if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied)) + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "av_reify called on tied array"); #endif key = AvMAX(av) + 1; while (key > AvFILLp(av) + 1) @@ -431,8 +431,8 @@ Perl_av_clear(pTHX_ register AV *av) assert(SvTYPE(av) == SVt_PVAV); #ifdef DEBUGGING - if (SvREFCNT(av) == 0 && ckWARN_d(WARN_DEBUGGING)) { - Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "Attempt to clear deleted array"); + if (SvREFCNT(av) == 0) { + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "Attempt to clear deleted array"); } #endif @@ -758,10 +758,9 @@ Perl_nextargv(pTHX_ register GV *gv) fileuid = PL_statbuf.st_uid; filegid = PL_statbuf.st_gid; if (!S_ISREG(PL_filemode)) { - if (ckWARN_d(WARN_INPLACE)) - Perl_warner(aTHX_ packWARN(WARN_INPLACE), - "Can't do inplace edit: %s is not a regular file", - PL_oldname ); + Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE), + "Can't do inplace edit: %s is not a regular file", + PL_oldname ); do_close(gv,FALSE); continue; } @@ -790,10 +789,9 @@ Perl_nextargv(pTHX_ register GV *gv) #endif ) { - if (ckWARN_d(WARN_INPLACE)) - Perl_warner(aTHX_ packWARN(WARN_INPLACE), - "Can't do inplace edit: %"SVf" would not be unique", - SVfARG(sv)); + Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE), + "Can't do inplace edit: %"SVf" would not be unique", + SVfARG(sv)); do_close(gv,FALSE); continue; } @@ -801,10 +799,9 @@ Perl_nextargv(pTHX_ register GV *gv) #ifdef HAS_RENAME #if !defined(DOSISH) && !defined(__CYGWIN__) && !defined(EPOC) if (PerlLIO_rename(PL_oldname,SvPVX_const(sv)) < 0) { - if (ckWARN_d(WARN_INPLACE)) - Perl_warner(aTHX_ packWARN(WARN_INPLACE), - "Can't rename %s to %"SVf": %s, skipping file", - PL_oldname, SVfARG(sv), Strerror(errno)); + Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE), + "Can't rename %s to %"SVf": %s, skipping file", + PL_oldname, SVfARG(sv), Strerror(errno)); do_close(gv,FALSE); continue; } @@ -817,10 +814,9 @@ Perl_nextargv(pTHX_ register GV *gv) #else (void)UNLINK(SvPVX_const(sv)); if (link(PL_oldname,SvPVX_const(sv)) < 0) { - if (ckWARN_d(WARN_INPLACE)) - Perl_warner(aTHX_ packWARN(WARN_INPLACE), - "Can't rename %s to %"SVf": %s, skipping file", - PL_oldname, SVfARG(sv), Strerror(errno) ); + Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE), + "Can't rename %s to %"SVf": %s, skipping file", + PL_oldname, SVfARG(sv), Strerror(errno) ); do_close(gv,FALSE); continue; } @@ -831,10 +827,9 @@ Perl_nextargv(pTHX_ register GV *gv) #if !defined(DOSISH) && !defined(AMIGAOS) # ifndef VMS /* Don't delete; use automatic file versioning */ if (UNLINK(PL_oldname) < 0) { - if (ckWARN_d(WARN_INPLACE)) - Perl_warner(aTHX_ packWARN(WARN_INPLACE), - "Can't remove %s: %s, skipping file", - PL_oldname, Strerror(errno) ); + Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE), + "Can't remove %s: %s, skipping file", + PL_oldname, Strerror(errno) ); do_close(gv,FALSE); continue; } @@ -854,9 +849,8 @@ Perl_nextargv(pTHX_ register GV *gv) O_WRONLY|O_CREAT|OPEN_EXCL,0600, #endif NULL, NULL, 0)) { - if (ckWARN_d(WARN_INPLACE)) - Perl_warner(aTHX_ packWARN(WARN_INPLACE), "Can't do inplace edit on %s: %s", - PL_oldname, Strerror(errno) ); + Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE), "Can't do inplace edit on %s: %s", + PL_oldname, Strerror(errno) ); do_close(gv,FALSE); continue; } @@ -1245,10 +1239,8 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp) } else { assert((char *)result == tmps); - if (ckWARN_d(WARN_UTF8)) { - Perl_warner(aTHX_ packWARN(WARN_UTF8), - "Wide character in print"); - } + Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), + "Wide character in print"); } } /* To detect whether the process is about to overstep its @@ -2016,8 +2016,7 @@ Perl_runops_debug(pTHX) { dVAR; if (!PL_op) { - if (ckWARN_d(WARN_DEBUGGING)) - Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN"); + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN"); return 0; } @@ -1182,6 +1182,7 @@ Afpd |void |warn |NN const char* pat|... Ap |void |vwarn |NN const char* pat|NULLOK va_list* args Afp |void |warner |U32 err|NN const char* pat|... Afp |void |ck_warner |U32 err|NN const char* pat|... +Afp |void |ck_warner_d |U32 err|NN const char* pat|... Ap |void |vwarner |U32 err|NN const char* pat|NULLOK va_list* args : FIXME p |void |watch |NN char** addr @@ -1041,6 +1041,7 @@ #define vwarn Perl_vwarn #define warner Perl_warner #define ck_warner Perl_ck_warner +#define ck_warner_d Perl_ck_warner_d #define vwarner Perl_vwarner #ifdef PERL_CORE #define watch Perl_watch diff --git a/global.sym b/global.sym index 9bdcacbe09..7205e226f5 100644 --- a/global.sym +++ b/global.sym @@ -614,6 +614,7 @@ Perl_warn Perl_vwarn Perl_warner Perl_ck_warner +Perl_ck_warner_d Perl_vwarner Perl_whichsig Perl_yylex @@ -1137,8 +1137,8 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, faking_it = SvOK(gv); - if (add & GV_ADDWARN && ckWARN_d(WARN_INTERNAL)) - Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "Had to create %s unexpectedly", nambeg); + if (add & GV_ADDWARN) + Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), "Had to create %s unexpectedly", nambeg); gv_init(gv, stash, name, len, add & GV_ADDMULTI); gv_init_sv(gv, faking_it ? SVt_PVCV : sv_type); @@ -1350,9 +1350,9 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, } case '*': case '#': - if (sv_type == SVt_PV && ckWARN2_d(WARN_DEPRECATED, WARN_SYNTAX)) - Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), - "$%c is no longer supported", *name); + if (sv_type == SVt_PV) + Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), + "$%c is no longer supported", *name); break; case '|': sv_setiv(GvSVn(gv), (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0); @@ -1559,10 +1559,9 @@ Perl_gp_free(pTHX_ GV *gv) if (!gv || !isGV_with_GP(gv) || !(gp = GvGP(gv))) return; if (gp->gp_refcnt == 0) { - if (ckWARN_d(WARN_INTERNAL)) - Perl_warner(aTHX_ packWARN(WARN_INTERNAL), - "Attempt to free unreferenced glob pointers" - pTHX__FORMAT pTHX__VALUE); + Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), + "Attempt to free unreferenced glob pointers" + pTHX__FORMAT pTHX__VALUE); return; } if (--gp->gp_refcnt > 0) { @@ -2436,12 +2436,12 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash) } } - if (!entry && ckWARN_d(WARN_INTERNAL)) - Perl_warner(aTHX_ packWARN(WARN_INTERNAL), - "Attempt to free non-existent shared string '%s'%s" - pTHX__FORMAT, - hek ? HEK_KEY(hek) : str, - ((k_flags & HVhek_UTF8) ? " (utf8)" : "") pTHX__VALUE); + if (!entry) + Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), + "Attempt to free non-existent 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); } @@ -2056,10 +2056,10 @@ Perl_mfree(Malloc_t where) #ifdef PERL_CORE { dTHX; - if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC)) - Perl_warner(aTHX_ packWARN(WARN_MALLOC), "%s free() ignored (RMAGIC, PERL_CORE)", - ovp->ov_rmagic == RMAGIC - 1 ? - "Duplicate" : "Bad"); + if (!PERL_IS_ALIVE || !PL_curcop) + Perl_ck_warner_d(aTHX_ packWARN(WARN_MALLOC), "%s free() ignored (RMAGIC, PERL_CORE)", + ovp->ov_rmagic == RMAGIC - 1 ? + "Duplicate" : "Bad"); } #else warn("%s free() ignored (RMAGIC)", @@ -2069,8 +2069,8 @@ Perl_mfree(Malloc_t where) #ifdef PERL_CORE { dTHX; - if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC)) - Perl_warner(aTHX_ packWARN(WARN_MALLOC), "%s", "Bad free() ignored (PERL_CORE)"); + if (!PERL_IS_ALIVE || !PL_curcop) + Perl_ck_warner_d(aTHX_ packWARN(WARN_MALLOC), "%s", "Bad free() ignored (PERL_CORE)"); } #else warn("%s", "Bad free() ignored"); @@ -2163,11 +2163,11 @@ Perl_realloc(void *mp, size_t nbytes) #ifdef PERL_CORE { dTHX; - if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC)) - Perl_warner(aTHX_ packWARN(WARN_MALLOC), "%srealloc() %signored", - (ovp->ov_rmagic == RMAGIC - 1 ? "" : "Bad "), - ovp->ov_rmagic == RMAGIC - 1 - ? "of freed memory " : ""); + if (!PERL_IS_ALIVE || !PL_curcop) + Perl_ck_warner_d(aTHX_ packWARN(WARN_MALLOC), "%srealloc() %signored", + (ovp->ov_rmagic == RMAGIC - 1 ? "" : "Bad "), + ovp->ov_rmagic == RMAGIC - 1 + ? "of freed memory " : ""); } #else warn2("%srealloc() %signored", @@ -2178,9 +2178,9 @@ Perl_realloc(void *mp, size_t nbytes) #ifdef PERL_CORE { dTHX; - if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC)) - Perl_warner(aTHX_ packWARN(WARN_MALLOC), "%s", - "Bad realloc() ignored"); + if (!PERL_IS_ALIVE || !PL_curcop) + Perl_ck_warner_d(aTHX_ packWARN(WARN_MALLOC), "%s", + "Bad realloc() ignored"); } #else warn("%s", "Bad realloc() ignored"); @@ -176,9 +176,8 @@ Perl_grok_bin(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) continue; } /* Bah. We're just overflowed. */ - if (ckWARN_d(WARN_OVERFLOW)) - Perl_warner(aTHX_ packWARN(WARN_OVERFLOW), - "Integer overflow in binary number"); + Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW), + "Integer overflow in binary number"); overflowed = TRUE; value_nv = (NV) value; } @@ -294,9 +293,8 @@ Perl_grok_hex(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) continue; } /* Bah. We're just overflowed. */ - if (ckWARN_d(WARN_OVERFLOW)) - Perl_warner(aTHX_ packWARN(WARN_OVERFLOW), - "Integer overflow in hexadecimal number"); + Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW), + "Integer overflow in hexadecimal number"); overflowed = TRUE; value_nv = (NV) value; } @@ -395,9 +393,8 @@ Perl_grok_oct(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) continue; } /* Bah. We're just overflowed. */ - if (ckWARN_d(WARN_OVERFLOW)) - Perl_warner(aTHX_ packWARN(WARN_OVERFLOW), - "Integer overflow in octal number"); + Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW), + "Integer overflow in octal number"); overflowed = TRUE; value_nv = (NV) value; } @@ -5583,10 +5583,9 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) maximum a prototype before. */ if (SvTYPE(gv) > SVt_NULL) { if (!SvPOK((const SV *)gv) - && !(SvIOK((const SV *)gv) && SvIVX((const SV *)gv) == -1) - && ckWARN_d(WARN_PROTOTYPE)) + && !(SvIOK((const SV *)gv) && SvIVX((const SV *)gv) == -1)) { - Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE), "Runaway prototype"); + Perl_ck_warner_d(aTHX_ packWARN(WARN_PROTOTYPE), "Runaway prototype"); } cv_ckproto_len((const CV *)gv, NULL, ps, ps_len); } @@ -6219,8 +6218,7 @@ Perl_oopsAV(pTHX_ OP *o) break; default: - if (ckWARN_d(WARN_INTERNAL)) - Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "oops: oopsAV"); + Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), "oops: oopsAV"); break; } return o; @@ -6248,8 +6246,7 @@ Perl_oopsHV(pTHX_ OP *o) break; default: - if (ckWARN_d(WARN_INTERNAL)) - Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "oops: oopsHV"); + Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), "oops: oopsHV"); break; } return o; @@ -1065,11 +1065,10 @@ Perl_pad_leavemy(pTHX) if (PL_min_intro_pending && PL_comppad_name_fill < PL_min_intro_pending) { for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) { const SV * const sv = svp[off]; - if (sv && sv != &PL_sv_undef - && !SvFAKE(sv) && ckWARN_d(WARN_INTERNAL)) - Perl_warner(aTHX_ packWARN(WARN_INTERNAL), - "%"SVf" never introduced", - SVfARG(sv)); + if (sv && sv != &PL_sv_undef && !SvFAKE(sv)) + Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), + "%"SVf" never introduced", + SVfARG(sv)); } } /* "Deintroduce" my variables that are leaving with this scope. */ @@ -1049,21 +1049,21 @@ perl_destruct(pTHXx) SvREFCNT_dec(PL_isarev); FREETMPS; - if (destruct_level >= 2 && ckWARN_d(WARN_INTERNAL)) { + if (destruct_level >= 2) { if (PL_scopestack_ix != 0) - Perl_warner(aTHX_ packWARN(WARN_INTERNAL), - "Unbalanced scopes: %ld more ENTERs than LEAVEs\n", - (long)PL_scopestack_ix); + Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), + "Unbalanced scopes: %ld more ENTERs than LEAVEs\n", + (long)PL_scopestack_ix); if (PL_savestack_ix != 0) - Perl_warner(aTHX_ packWARN(WARN_INTERNAL), - "Unbalanced saves: %ld more saves than restores\n", - (long)PL_savestack_ix); + Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), + "Unbalanced saves: %ld more saves than restores\n", + (long)PL_savestack_ix); if (PL_tmps_floor != -1) - Perl_warner(aTHX_ packWARN(WARN_INTERNAL),"Unbalanced tmps: %ld more allocs than frees\n", - (long)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); if (cxstack_ix != -1) - Perl_warner(aTHX_ packWARN(WARN_INTERNAL),"Unbalanced context: %ld more PUSHes than POPs\n", - (long)cxstack_ix + 1); + Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),"Unbalanced context: %ld more PUSHes than POPs\n", + (long)cxstack_ix + 1); } /* Now absolutely destruct everything, somehow or other, loops or no. */ @@ -3708,6 +3708,12 @@ PERL_CALLCONV void Perl_ck_warner(pTHX_ U32 err, const char* pat, ...) #define PERL_ARGS_ASSERT_CK_WARNER \ assert(pat) +PERL_CALLCONV void Perl_ck_warner_d(pTHX_ U32 err, const char* pat, ...) + __attribute__format__(__printf__,pTHX_2,pTHX_3) + __attribute__nonnull__(pTHX_2); +#define PERL_ARGS_ASSERT_CK_WARNER_D \ + assert(pat) + PERL_CALLCONV void Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args) __attribute__nonnull__(pTHX_2); #define PERL_ARGS_ASSERT_VWARNER \ @@ -353,10 +353,9 @@ S_del_sv(pTHX_ SV *p) } } if (!ok) { - if (ckWARN_d(WARN_INTERNAL)) - Perl_warner(aTHX_ packWARN(WARN_INTERNAL), - "Attempt to free non-arena SV: 0x%"UVxf - pTHX__FORMAT, PTR2UV(p) pTHX__VALUE); + Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), + "Attempt to free non-arena SV: 0x%"UVxf + pTHX__FORMAT, PTR2UV(p) pTHX__VALUE); return; } } @@ -5916,10 +5915,9 @@ Perl_sv_free2(pTHX_ SV *const sv) #ifdef DEBUGGING if (SvTEMP(sv)) { - if (ckWARN_d(WARN_DEBUGGING)) - Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), - "Attempt to free temp prematurely: SV 0x%"UVxf - pTHX__FORMAT, PTR2UV(sv) pTHX__VALUE); + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), + "Attempt to free temp prematurely: SV 0x%"UVxf + pTHX__FORMAT, PTR2UV(sv) pTHX__VALUE); return; } #endif @@ -7996,8 +7994,7 @@ Perl_newSVsv(pTHX_ register SV *const old) if (!old) return NULL; if (SvTYPE(old) == SVTYPEMASK) { - if (ckWARN_d(WARN_INTERNAL)) - Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "semi-panic: attempt to dup freed string"); + Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), "semi-panic: attempt to dup freed string"); return NULL; } new_SV(sv); @@ -9442,9 +9439,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen, goto string; } else if (n) { - if (ckWARN_d(WARN_INTERNAL)) - Perl_warner(aTHX_ packWARN(WARN_INTERNAL), - "internal %%<num>p might conflict with future printf extensions"); + Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), + "internal %%<num>p might conflict with future printf extensions"); } } q = r; @@ -66,8 +66,7 @@ Perl_taint_proper(pTHX_ const char *f, const char *const s) else ug = " while running with -T switch"; if (PL_unsafe || PL_taint_warn) { - if(ckWARN_d(WARN_TAINT)) - Perl_warner(aTHX_ packWARN(WARN_TAINT), f, s, ug); + Perl_ck_warner_d(aTHX_ packWARN(WARN_TAINT), f, s, ug); } else { Perl_croak(aTHX_ f, s, ug); @@ -1217,11 +1217,9 @@ S_check_uni(pTHX) if ((t = strchr(s, '(')) && t < PL_bufptr) return; - if (ckWARN_d(WARN_AMBIGUOUS)){ - Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS), - "Warning: Use of \"%.*s\" without parentheses is ambiguous", - (int)(s - PL_last_uni), PL_last_uni); - } + Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS), + "Warning: Use of \"%.*s\" without parentheses is ambiguous", + (int)(s - PL_last_uni), PL_last_uni); } /* @@ -5580,10 +5578,10 @@ Perl_yylex(pTHX) /* Not a method, so call it a subroutine (if defined) */ if (cv) { - if (lastchar == '-' && ckWARN_d(WARN_AMBIGUOUS)) - Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS), - "Ambiguous use of -%s resolved as -&%s()", - PL_tokenbuf, PL_tokenbuf); + if (lastchar == '-') + Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS), + "Ambiguous use of -%s resolved as -&%s()", + PL_tokenbuf, PL_tokenbuf); /* Check for a constant sub */ if ((sv = gv_const_sv(gv))) { its_constant: @@ -5725,14 +5723,13 @@ Perl_yylex(pTHX) } safe_bareword: - if ((lastchar == '*' || lastchar == '%' || lastchar == '&') - && ckWARN_d(WARN_AMBIGUOUS)) { - Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS), - "Operator or semicolon missing before %c%s", - lastchar, PL_tokenbuf); - Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS), - "Ambiguous use of %c resolved as operator %c", - lastchar, lastchar); + if ((lastchar == '*' || lastchar == '%' || lastchar == '&')) { + Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS), + "Operator or semicolon missing before %c%s", + lastchar, PL_tokenbuf); + Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS), + "Ambiguous use of %c resolved as operator %c", + lastchar, lastchar); } TOKEN(WORD); } @@ -8716,8 +8713,7 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords) name[4] == 'i' && name[5] == 'f') { /* elseif */ - if(ckWARN_d(WARN_SYNTAX)) - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "elseif should be elsif"); + Perl_ck_warner_d(aTHX_ packWARN(WARN_SYNTAX), "elseif should be elsif"); } goto unknown; @@ -12207,10 +12203,9 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) && !(PL_hints & HINT_NEW_BINARY)) { overflowed = TRUE; n = (NV) u; - if (ckWARN_d(WARN_OVERFLOW)) - Perl_warner(aTHX_ packWARN(WARN_OVERFLOW), - "Integer overflow in %s number", - base); + Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW), + "Integer overflow in %s number", + base); } else u = x | b; /* add the digit to the end */ } @@ -12703,8 +12698,7 @@ Perl_yyerror(pTHX_ const char *const s) PL_multi_end = 0; } if (PL_in_eval & EVAL_WARNONLY) { - if (ckWARN_d(WARN_SYNTAX)) - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "%"SVf, SVfARG(msg)); + Perl_ck_warner_d(aTHX_ packWARN(WARN_SYNTAX), "%"SVf, SVfARG(msg)); } else qerror(msg); @@ -12947,9 +12941,9 @@ Perl_scan_vstring(pTHX_ const char *s, const char *const e, SV *sv) const UV orev = rev; rev += (*end - '0') * mult; mult *= 10; - if (orev > rev && ckWARN_d(WARN_OVERFLOW)) - Perl_warner(aTHX_ packWARN(WARN_OVERFLOW), - "Integer overflow in decimal number"); + if (orev > rev) + Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW), + "Integer overflow in decimal number"); } } #ifdef EBCDIC @@ -731,13 +731,11 @@ Perl_utf8_length(pTHX_ const U8 *s, const U8 *e) if (e != s) { len--; 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)); - else - Perl_warner(aTHX_ packWARN(WARN_UTF8), unees); - } + if (PL_op) + Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), + "%s in %s", unees, OP_DESC(PL_op)); + else + Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), unees); } return len; @@ -1529,6 +1529,19 @@ Perl_warner_nocontext(U32 err, const char *pat, ...) #endif /* PERL_IMPLICIT_CONTEXT */ void +Perl_ck_warner_d(pTHX_ U32 err, const char* pat, ...) +{ + PERL_ARGS_ASSERT_CK_WARNER_D; + + if (Perl_ckwarn_d(aTHX_ err)) { + va_list args; + va_start(args, pat); + vwarner(err, pat, &args); + va_end(args); + } +} + +void Perl_ck_warner(pTHX_ U32 err, const char* pat, ...) { PERL_ARGS_ASSERT_CK_WARNER; |