utf8.c: Add function to retrieve new _Perl_IDStart prop

diff --git a/embed.fnc b/embed.fnc
index 0665e25..2243397 100644 (file)
--- 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 c3f2262..f033d74 100644 (file)
--- 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 2354a8b..3542482 100644 (file)
--- 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 7966a3f..9f812dc 100644 (file)
--- 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 17fbdd8..1a4e571 100644 (file)
--- 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 87cc0c2..24477ba 100644 (file)
--- 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 62fdf18..1773f2e 100644 (file)
--- 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;