Skip to content

Commit

Permalink
perl #122747: localize PL_curpm to null in _core_swash_init
Browse files Browse the repository at this point in the history
Set PL_curpm to null before we do any swash intialization
in _core_swash_init(). This "hides" the current regop from the
swash code, with the intent of prevent weird reentrancy bugs
when the swashes are initialized.

Long term you could argue that we should just not use the regex
engine to initialize a swash, and then this would be unnecessary.

Thanks to FC for the suggestion!

(cherry picked from commit 2c1f00b)
  • Loading branch information
demerphq authored and steve-m-hay committed Dec 27, 2014
1 parent 817b6ac commit b0ed92c
Showing 1 changed file with 17 additions and 2 deletions.
19 changes: 17 additions & 2 deletions utf8.c
Expand Up @@ -2509,6 +2509,14 @@ Perl_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 minbits
SV*
Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 minbits, I32 none, SV* invlist, U8* const flags_p)
{

/*NOTE NOTE NOTE - If you want to use "return" in this routine you MUST
* use the following define */

#define CORE_SWASH_INIT_RETURN(x) \
PL_curpm= old_PL_curpm; \
return x

/* Initialize and return a swash, creating it if necessary. It does this
* by calling utf8_heavy.pl in the general case. The returned value may be
* the swash's inversion list instead if the input parameters allow it.
Expand Down Expand Up @@ -2554,6 +2562,8 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m
* <invlist> is only valid for binary properties */

dVAR;
PMOP *old_PL_curpm= PL_curpm; /* save away the old PL_curpm */

SV* retval = &PL_sv_undef;
HV* swash_hv = NULL;
const int invlist_swash_boundary =
Expand All @@ -2565,6 +2575,10 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m
assert(listsv != &PL_sv_undef || strNE(name, "") || invlist);
assert(! invlist || minbits == 1);

PL_curpm= NULL; /* reset PL_curpm so that we dont get confused between the regex
that triggered the swash init and the swash init perl logic itself.
See perl #122747 */

/* If data was passed in to go out to utf8_heavy to find the swash of, do
* so */
if (listsv != &PL_sv_undef || strNE(name, "")) {
Expand Down Expand Up @@ -2653,7 +2667,7 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m

/* If caller wants to handle missing properties, let them */
if (flags_p && *flags_p & _CORE_SWASH_INIT_RETURN_IF_UNDEF) {
return NULL;
CORE_SWASH_INIT_RETURN(NULL);
}
Perl_croak(aTHX_
"Can't find Unicode property definition \"%"SVf"\"",
Expand Down Expand Up @@ -2755,7 +2769,8 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m
}
}

return retval;
CORE_SWASH_INIT_RETURN(retval);
#undef CORE_SWASH_INIT_RETURN
}


Expand Down

0 comments on commit b0ed92c

Please sign in to comment.