Migrate common code in Perl_ckwarn() and Perl_ckwarn_d() to S_ckwarn_common()

diff --git a/embed.fnc b/embed.fnc
index ef0692d..1147a98 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 dc1a26f..13b56a0 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1602,21 +1602,7 @@ Perl_ckwarn(pTHX_ U32 w)
     if (isLEXWARN_off)
        return PL_dowarn & G_WARN_ON;
 
-    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)));
+    return ckwarn_common(w);
 }
 
 /* implements the ckWARN?_d macro */
@@ -1629,12 +1615,20 @@ Perl_ckwarn_d(pTHX_ U32 w)
     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)))