utf8.c: Add function to retrieve new _Perl_IDStart prop

7 files changed, 21 insertions, 0 deletions

diff --git a/embed.fnc b/embed.fnc
index 0665e25aca..224339749c 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -595,6 +595,7 @@ Anpd	|bool	|is_utf8_string_loclen|NN const U8 *s|STRLEN len|NULLOK const U8 **ep
 ApR	|bool	|is_utf8_alnum	|NN const U8 *p
 ApR	|bool	|is_utf8_idfirst|NN const U8 *p
 ApR	|bool	|is_utf8_xidfirst|NN const U8 *p
+EXpR	|bool	|_is_utf8__perl_idstart|NN const U8 *p
 ApR	|bool	|is_utf8_idcont	|NN const U8 *p
 ApR	|bool	|is_utf8_xidcont	|NN const U8 *p
 ApR	|bool	|is_utf8_alpha	|NN const U8 *p
diff --git a/embed.h b/embed.h
index c3f2262a3f..f033d74312 100644
--- a/embed.h
+++ b/embed.h
@@ -829,6 +829,7 @@
 #define do_spawn_nowait(a)	Perl_do_spawn_nowait(aTHX_ a)
 #endif
 #if defined(PERL_CORE) || defined(PERL_EXT)
+#define _is_utf8__perl_idstart(a)	Perl__is_utf8__perl_idstart(aTHX_ a)
 #define av_reify(a)		Perl_av_reify(aTHX_ a)
 #define is_utf8_X_L(a)		Perl_is_utf8_X_L(aTHX_ a)
 #define is_utf8_X_LV(a)		Perl_is_utf8_X_LV(aTHX_ a)
diff --git a/embedvar.h b/embedvar.h
index 2354a8b40a..3542482c52 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -343,6 +343,7 @@
 #define PL_utf8_idstart		(vTHX->Iutf8_idstart)
 #define PL_utf8_lower		(vTHX->Iutf8_lower)
 #define PL_utf8_mark		(vTHX->Iutf8_mark)
+#define PL_utf8_perl_idstart	(vTHX->Iutf8_perl_idstart)
 #define PL_utf8_print		(vTHX->Iutf8_print)
 #define PL_utf8_punct		(vTHX->Iutf8_punct)
 #define PL_utf8_space		(vTHX->Iutf8_space)
diff --git a/intrpvar.h b/intrpvar.h
index 7966a3ffac..9f812dc20d 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -668,6 +668,7 @@ PERLVAR(I, debug_pad,	struct perl_debug_pad)	/* always needed because of the re
 PERLVAR(I, utf8_idstart, SV *)
 PERLVAR(I, utf8_idcont,	SV *)
 PERLVAR(I, utf8_xidstart, SV *)
+PERLVAR(I, utf8_perl_idstart, SV *)
 PERLVAR(I, utf8_xidcont, SV *)
 
 PERLVAR(I, sort_RealCmp, SVCOMPARE_t)
diff --git a/proto.h b/proto.h
index 17fbdd8732..1a4e5719b9 100644
--- a/proto.h
+++ b/proto.h
@@ -23,6 +23,12 @@ PERL_CALLCONV int	Perl_Gv_AMupdate(pTHX_ HV* stash, bool destructing)
 	assert(stash)
 
 PERL_CALLCONV const char *	Perl_PerlIO_context_layers(pTHX_ const char *mode);
+PERL_CALLCONV bool	Perl__is_utf8__perl_idstart(pTHX_ const U8 *p)
+			__attribute__warn_unused_result__
+			__attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT__IS_UTF8__PERL_IDSTART	\
+	assert(p)
+
 PERL_CALLCONV UV	Perl__to_uni_fold_flags(pTHX_ UV c, U8 *p, STRLEN *lenp, U8 flags)
 			__attribute__nonnull__(pTHX_2)
 			__attribute__nonnull__(pTHX_3);
diff --git a/sv.c b/sv.c
index 87cc0c2420..24477ba0c0 100644
--- a/sv.c
+++ b/sv.c
@@ -13236,6 +13236,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_utf8_tofold	= sv_dup_inc(proto_perl->Iutf8_tofold, param);
     PL_utf8_idstart	= sv_dup_inc(proto_perl->Iutf8_idstart, param);
     PL_utf8_xidstart	= sv_dup_inc(proto_perl->Iutf8_xidstart, param);
+    PL_utf8_perl_idstart = sv_dup_inc(proto_perl->Iutf8_perl_idstart, param);
     PL_utf8_idcont	= sv_dup_inc(proto_perl->Iutf8_idcont, param);
     PL_utf8_xidcont	= sv_dup_inc(proto_perl->Iutf8_xidcont, param);
     PL_utf8_foldable	= sv_dup_inc(proto_perl->Iutf8_foldable, param);
diff --git a/utf8.c b/utf8.c
index 62fdf18a36..1773f2e34c 100644
--- a/utf8.c
+++ b/utf8.c
@@ -1510,6 +1510,16 @@ Perl_is_utf8_xidfirst(pTHX_ const U8 *p) /* The naming is historical. */
 }
 
 bool
+Perl__is_utf8__perl_idstart(pTHX_ const U8 *p)
+{
+    dVAR;
+
+    PERL_ARGS_ASSERT__IS_UTF8__PERL_IDSTART;
+
+    return is_utf8_common(p, &PL_utf8_perl_idstart, "_Perl_IDStart");
+}
+
+bool
 Perl_is_utf8_idcont(pTHX_ const U8 *p)
 {
     dVAR;