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

4 files changed, 25 insertions, 15 deletions

diff --git a/embed.fnc b/embed.fnc
index ef0692de61..1147a98b6c 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 fa901934dd..61780eeddb 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 28923d024b..db9093db4b 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 dc1a26f329..13b56a0802 100644
--- 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)))