In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/26c7b074d5d3f0a79fab5f1c4eb28f38e81b88d2?hp=2acdbac104deb9113282247f3dbee83c4705a525>
- Log ----------------------------------------------------------------- commit 26c7b074d5d3f0a79fab5f1c4eb28f38e81b88d2 Author: Nicholas Clark <[email protected]> Date: Tue Oct 13 11:41:36 2009 +0100 Migrate common code in Perl_ckwarn() and Perl_ckwarn_d() to S_ckwarn_common() M embed.fnc M embed.h M proto.h M util.c commit ad287e37d27b33d67ab22c0c8a7294f1eb467342 Author: Nicholas Clark <[email protected]> Date: Tue Oct 13 11:30:14 2009 +0100 In Perl_ckwarn() and Perl_ckwarn_d() disentangle the complex conditionals. It's much easier to see what is going on, if we use multiple return statements. M util.c ----------------------------------------------------------------------- Summary of changes: embed.fnc | 3 +++ embed.h | 10 ++++++++++ proto.h | 3 +++ util.c | 60 ++++++++++++++++++++++++++++++------------------------------ 4 files changed, 46 insertions(+), 30 deletions(-) diff --git a/embed.fnc b/embed.fnc index ef0692d..1147a98 100644 --- a/embed.fnc +++ b/embed.fnc @@ -2087,6 +2087,9 @@ p |void |dump_sv_child |NN SV *sv #ifdef PERL_DONT_CREATE_GVSV Apbm |GV* |gv_SVadd |NULLOK GV *gv #endif +#if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) +s |bool |ckwarn_common |U32 w +#endif Apo |bool |ckwarn |U32 w Apo |bool |ckwarn_d |U32 w : FIXME - exported for ByteLoader - public or private? diff --git a/embed.h b/embed.h index fa90193..61780ee 100644 --- a/embed.h +++ b/embed.h @@ -1885,6 +1885,11 @@ #endif #ifdef PERL_DONT_CREATE_GVSV #endif +#if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) +#ifdef PERL_CORE +#define ckwarn_common S_ckwarn_common +#endif +#endif #ifdef PERL_CORE #define offer_nice_chunk Perl_offer_nice_chunk #endif @@ -4243,6 +4248,11 @@ #endif #ifdef PERL_DONT_CREATE_GVSV #endif +#if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) +#ifdef PERL_CORE +#define ckwarn_common(a) S_ckwarn_common(aTHX_ a) +#endif +#endif #if defined(PERL_CORE) || defined(PERL_EXT) #endif #ifdef PERL_CORE diff --git a/proto.h b/proto.h index 28923d0..db9093d 100644 --- a/proto.h +++ b/proto.h @@ -6350,6 +6350,9 @@ PERL_CALLCONV void Perl_dump_sv_child(pTHX_ SV *sv) #ifdef PERL_DONT_CREATE_GVSV /* PERL_CALLCONV GV* Perl_gv_SVadd(pTHX_ GV *gv); */ #endif +#if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) +STATIC bool S_ckwarn_common(pTHX_ U32 w); +#endif PERL_CALLCONV bool Perl_ckwarn(pTHX_ U32 w); PERL_CALLCONV bool Perl_ckwarn_d(pTHX_ U32 w); PERL_CALLCONV STRLEN * Perl_new_warnings_bitfield(pTHX_ STRLEN *buffer, const char *const bits, STRLEN size) diff --git a/util.c b/util.c index 94820ef..13b56a0 100644 --- a/util.c +++ b/util.c @@ -1598,20 +1598,11 @@ bool Perl_ckwarn(pTHX_ U32 w) { dVAR; - return isLEXWARN_on - ? (PL_curcop->cop_warnings != pWARN_NONE - && ( - PL_curcop->cop_warnings == pWARN_ALL - || isWARN_on(PL_curcop->cop_warnings, unpackWARN1(w)) - || (unpackWARN2(w) && - isWARN_on(PL_curcop->cop_warnings, unpackWARN2(w))) - || (unpackWARN3(w) && - isWARN_on(PL_curcop->cop_warnings, unpackWARN3(w))) - || (unpackWARN4(w) && - isWARN_on(PL_curcop->cop_warnings, unpackWARN4(w))) - ) - ) - : (PL_dowarn & G_WARN_ON); + /* If lexical warnings have not been set, use $^W. */ + if (isLEXWARN_off) + return PL_dowarn & G_WARN_ON; + + return ckwarn_common(w); } /* implements the ckWARN?_d macro */ @@ -1620,22 +1611,31 @@ bool Perl_ckwarn_d(pTHX_ U32 w) { dVAR; - return - isLEXWARN_off - || PL_curcop->cop_warnings == pWARN_ALL - || ( - PL_curcop->cop_warnings != pWARN_NONE - && ( - isWARN_on(PL_curcop->cop_warnings, unpackWARN1(w)) - || (unpackWARN2(w) && - isWARN_on(PL_curcop->cop_warnings, unpackWARN2(w))) - || (unpackWARN3(w) && - isWARN_on(PL_curcop->cop_warnings, unpackWARN3(w))) - || (unpackWARN4(w) && - isWARN_on(PL_curcop->cop_warnings, unpackWARN4(w))) - ) - ) - ; + /* If lexical warnings have not been set then default classes warn. */ + if (isLEXWARN_off) + return TRUE; + + return ckwarn_common(w); +} + +static bool +S_ckwarn_common(pTHX_ U32 w) +{ + if (PL_curcop->cop_warnings == pWARN_ALL) + return TRUE; + + if (PL_curcop->cop_warnings == pWARN_NONE) + return FALSE; + + /* Right, dealt with all the special cases, which are implemented as non- + pointers, so there is a pointer to a real warnings mask. */ + return isWARN_on(PL_curcop->cop_warnings, unpackWARN1(w)) + || (unpackWARN2(w) && + isWARN_on(PL_curcop->cop_warnings, unpackWARN2(w))) + || (unpackWARN3(w) && + isWARN_on(PL_curcop->cop_warnings, unpackWARN3(w))) + || (unpackWARN4(w) && + isWARN_on(PL_curcop->cop_warnings, unpackWARN4(w))); } /* Set buffer=NULL to get a new one. */ -- Perl5 Master Repository
