From 6c6525b86477e0001fa63ee65eb355329aeef26a Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 5 Jan 2012 21:10:28 -0700 Subject: [PATCH] regexec.c: Allow for returning shared swash This changes the function that returns the swash associated with a bracketed character class so that it returns the original swash and not a copy. The function is renamed and made accessible only from within regexec.c, and a new wrapper function with the original name is created that just calls the other one and returns a copy of the swash. Thus, all access from outside regexec.c will use a copy which if overwritten will not harm others; while the option exists from within regexec.c to use a shared version. --- embed.fnc | 3 +++ embed.h | 1 + proto.h | 6 ++++++ regexec.c | 17 ++++++++++++----- 4 files changed, 22 insertions(+), 5 deletions(-) diff --git a/embed.fnc b/embed.fnc index ab2cc87..292ccaa 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1967,6 +1967,9 @@ ERs |bool |reginclass |NULLOK const regexp * const prog|NN const regnode * const Es |CHECKPOINT|regcppush |I32 parenfloor Es |char* |regcppop |NN const regexp *rex ERsn |U8* |reghop3 |NN U8 *s|I32 off|NN const U8 *lim +ERsM |SV* |core_regclass_swash|NULLOK const regexp *prog \ + |NN const struct regnode *node|bool doinit \ + |NULLOK SV **listsvp|NULLOK SV **altsvp #ifdef XXX_dmq ERsn |U8* |reghop4 |NN U8 *s|I32 off|NN const U8 *llim \ |NN const U8 *rlim diff --git a/embed.h b/embed.h index 1cd59b2..62e9bee 100644 --- a/embed.h +++ b/embed.h @@ -960,6 +960,7 @@ #define _swash_to_invlist(a) Perl__swash_to_invlist(aTHX_ a) # endif # if defined(PERL_IN_REGEXEC_C) +#define core_regclass_swash(a,b,c,d,e) S_core_regclass_swash(aTHX_ a,b,c,d,e) #define find_byclass(a,b,c,d,e) S_find_byclass(aTHX_ a,b,c,d,e) #define reg_check_named_buff_matched(a,b) S_reg_check_named_buff_matched(aTHX_ a,b) #define regcppop(a) S_regcppop(aTHX_ a) diff --git a/proto.h b/proto.h index b9a7a7a..c28ec54 100644 --- a/proto.h +++ b/proto.h @@ -6604,6 +6604,12 @@ PERL_CALLCONV SV* Perl__swash_to_invlist(pTHX_ SV* const swash) #endif #if defined(PERL_IN_REGEXEC_C) +STATIC SV* S_core_regclass_swash(pTHX_ const regexp *prog, const struct regnode *node, bool doinit, SV **listsvp, SV **altsvp) + __attribute__warn_unused_result__ + __attribute__nonnull__(pTHX_2); +#define PERL_ARGS_ASSERT_CORE_REGCLASS_SWASH \ + assert(node) + STATIC char* S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, const char *strend, regmatch_info *reginfo) __attribute__warn_unused_result__ __attribute__nonnull__(pTHX_1) diff --git a/regexec.c b/regexec.c index 66d2ef8..4275b37 100644 --- a/regexec.c +++ b/regexec.c @@ -6476,12 +6476,20 @@ S_regrepeat(pTHX_ const regexp *prog, const regnode *p, I32 max, int depth) #if !defined(PERL_IN_XSUB_RE) || defined(PLUGGABLE_RE_EXTENSION) /* -- regclass_swash - prepare the utf8 swash -*/ - +- regclass_swash - prepare the utf8 swash. Wraps the shared core version to +create a copy so that changes the caller makes won't change the shared one + */ SV * Perl_regclass_swash(pTHX_ const regexp *prog, register const regnode* node, bool doinit, SV** listsvp, SV **altsvp) { + PERL_ARGS_ASSERT_REGCLASS_SWASH; + return newSVsv(core_regclass_swash(prog, node, doinit, listsvp, altsvp)); +} +#endif + +STATIC SV * +S_core_regclass_swash(pTHX_ const regexp *prog, register const regnode* node, bool doinit, SV** listsvp, SV **altsvp) +{ /* Returns the swash for the input 'node' in the regex 'prog'. * If is true, will attempt to create the swash if not already * done. @@ -6500,7 +6508,7 @@ Perl_regclass_swash(pTHX_ const regexp *prog, register const regnode* node, bool RXi_GET_DECL(prog,progi); const struct reg_data * const data = prog ? progi->data : NULL; - PERL_ARGS_ASSERT_REGCLASS_SWASH; + PERL_ARGS_ASSERT_CORE_REGCLASS_SWASH; assert(ANYOF_NONBITMAP(node)); @@ -6587,7 +6595,6 @@ Perl_regclass_swash(pTHX_ const regexp *prog, register const regnode* node, bool return sw; } -#endif /* - reginclass - determine if a character falls into a character class -- 2.7.4