From b6912c02aa553169d6b7158ab7a2ddc26d60974f Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 28 Sep 2011 09:44:52 -0600 Subject: [PATCH] utf8.c: Add function to retrieve new _Perl_IDStart prop --- embed.fnc | 1 + embed.h | 1 + embedvar.h | 1 + intrpvar.h | 1 + proto.h | 6 ++++++ sv.c | 1 + utf8.c | 10 ++++++++++ 7 files changed, 21 insertions(+) diff --git a/embed.fnc b/embed.fnc index 0665e25..2243397 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 c3f2262..f033d74 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 2354a8b..3542482 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 7966a3f..9f812dc 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 17fbdd8..1a4e571 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 87cc0c2..24477ba 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 62fdf18..1773f2e 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; -- 2.7.4