Create internal _is_utf8_mark()

This is so we can deprecate non-core use of the existing one in a future
commit.  XS coders should be using the macros in handy.h instead of
calling such functions directly.  A future commit will deprecate all of
them, but first the core uses of this one must change so they don't
generate deprecation messages.  I will not have a chance to look for
some time, but I suspect that most uses of this function in the core
should be changed to use something else, but in the meantime, the
non-core uses can be deprecated.

6 files changed, 25 insertions, 6 deletions

diff --git a/embed.fnc b/embed.fnc
index 170d15962f..0ec56cd38b 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -681,6 +681,7 @@ AMpR	|bool	|is_utf8_print	|NN const U8 *p
 AMpR	|bool	|is_utf8_punct	|NN const U8 *p
 ADMpR	|bool	|is_utf8_xdigit	|NN const U8 *p
 AMpR	|bool	|is_utf8_mark	|NN const U8 *p
+AMpR	|bool	|_is_utf8_mark	|NN const U8 *p
 : Used in perly.y
 p	|OP*	|jmaybe		|NN OP *o
 : Used in pp.c 
diff --git a/embed.h b/embed.h
index 6c0eaa70c6..89dca3c19d 100644
--- a/embed.h
+++ b/embed.h
@@ -30,6 +30,7 @@
 #define _is_uni_FOO(a,b)	Perl__is_uni_FOO(aTHX_ a,b)
 #define _is_uni_perl_idstart(a)	Perl__is_uni_perl_idstart(aTHX_ a)
 #define _is_utf8_FOO(a,b)	Perl__is_utf8_FOO(aTHX_ a,b)
+#define _is_utf8_mark(a)	Perl__is_utf8_mark(aTHX_ a)
 #define _is_utf8_perl_idstart(a)	Perl__is_utf8_perl_idstart(aTHX_ a)
 #define _to_uni_fold_flags(a,b,c,d)	Perl__to_uni_fold_flags(aTHX_ a,b,c,d)
 #define _to_utf8_fold_flags(a,b,c,d,e)	Perl__to_utf8_fold_flags(aTHX_ a,b,c,d,e)
diff --git a/pp.c b/pp.c
index 33943e44c7..4a55e02195 100644
--- a/pp.c
+++ b/pp.c
@@ -3757,7 +3757,7 @@ PP(pp_uc)
 	    STRLEN u;
 	    STRLEN ulen;
 	    UV uv;
-	    if (in_iota_subscript && ! is_utf8_mark(s)) {
+	    if (in_iota_subscript && ! _is_utf8_mark(s)) {
 
 		/* A non-mark.  Time to output the iota subscript */
 #define GREEK_CAPITAL_LETTER_IOTA 0x0399
diff --git a/proto.h b/proto.h
index ae3e254ca4..e07eacd2ae 100644
--- a/proto.h
+++ b/proto.h
@@ -44,6 +44,12 @@ PERL_CALLCONV bool	Perl__is_utf8_FOO(pTHX_ const U8 classnum, const U8 *p)
 #define PERL_ARGS_ASSERT__IS_UTF8_FOO	\
 	assert(p)
 
+PERL_CALLCONV bool	Perl__is_utf8_mark(pTHX_ const U8 *p)
+			__attribute__warn_unused_result__
+			__attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT__IS_UTF8_MARK	\
+	assert(p)
+
 PERL_CALLCONV bool	Perl__is_utf8_perl_idstart(pTHX_ const U8 *p)
 			__attribute__warn_unused_result__
 			__attribute__nonnull__(pTHX_1);
diff --git a/toke.c b/toke.c
index d9d6f93875..4f671cccc8 100644
--- a/toke.c
+++ b/toke.c
@@ -8076,7 +8076,7 @@ Perl_yylex(pTHX)
 		for (d = s; isALNUM_lazy_if(d,UTF);) {
 		    d += UTF ? UTF8SKIP(d) : 1;
                     if (UTF) {
-                        while (UTF8_IS_CONTINUED(*d) && is_utf8_mark((U8*)d)) {
+                        while (UTF8_IS_CONTINUED(*d) && _is_utf8_mark((U8*)d)) {
                             d += UTF ? UTF8SKIP(d) : 1;
                         }
                     }
@@ -9187,7 +9187,7 @@ S_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STRLEN
 	else if (UTF && UTF8_IS_START(*s) && isALNUM_utf8((U8*)s)) {
 	    char *t = s + UTF8SKIP(s);
 	    size_t len;
-	    while (UTF8_IS_CONTINUED(*t) && is_utf8_mark((U8*)t))
+	    while (UTF8_IS_CONTINUED(*t) && _is_utf8_mark((U8*)t))
 		t += UTF8SKIP(t);
 	    len = t - s;
 	    if (d + len > e)
@@ -9241,7 +9241,7 @@ S_scan_ident(pTHX_ char *s, const char *send, char *dest, STRLEN destlen, I32 ck
 	    }
 	    else if (UTF && UTF8_IS_START(*s) && isALNUM_utf8((U8*)s)) {
 		char *t = s + UTF8SKIP(s);
-		while (UTF8_IS_CONTINUED(*t) && is_utf8_mark((U8*)t))
+		while (UTF8_IS_CONTINUED(*t) && _is_utf8_mark((U8*)t))
 		    t += UTF8SKIP(t);
 		if (d + (t - s) > e)
 		    Perl_croak(aTHX_ ident_too_long);
@@ -9304,7 +9304,7 @@ S_scan_ident(pTHX_ char *s, const char *send, char *dest, STRLEN destlen, I32 ck
 		char *end = s;
 		while ((end < send && isALNUM_lazy_if(end,UTF)) || *end == ':') {
 		    end += UTF8SKIP(end);
-		    while (end < send && UTF8_IS_CONTINUED(*end) && is_utf8_mark((U8*)end))
+		    while (end < send && UTF8_IS_CONTINUED(*end) && _is_utf8_mark((U8*)end))
 			end += UTF8SKIP(end);
 		}
 		Copy(s, d, end - s, char);
diff --git a/utf8.c b/utf8.c
index b6ca4876d8..930b148419 100644
--- a/utf8.c
+++ b/utf8.c
@@ -2288,13 +2288,24 @@ Perl_is_utf8_xdigit(pTHX_ const U8 *p)
 }
 
 bool
+Perl__is_utf8_mark(pTHX_ const U8 *p)
+{
+    dVAR;
+
+    PERL_ARGS_ASSERT__IS_UTF8_MARK;
+
+    return is_utf8_common(p, &PL_utf8_mark, "IsM");
+}
+
+
+bool
 Perl_is_utf8_mark(pTHX_ const U8 *p)
 {
     dVAR;
 
     PERL_ARGS_ASSERT_IS_UTF8_MARK;
 
-    return is_utf8_common(p, &PL_utf8_mark, "IsM");
+    return _is_utf8_mark(p);
 }
 
 /*