In perl.git, the branch smoke-me/yves-revert_skipwhite has been updated <http://perl5.git.perl.org/perl.git/commitdiff/aa92869cf6c53d9eb86a54300cc39720259c68cd?hp=f5c29cdd38b1a8046b274f3f0471813b781f545e>
- Log ----------------------------------------------------------------- commit aa92869cf6c53d9eb86a54300cc39720259c68cd Author: Yves Orton <[email protected]> Date: Tue Mar 26 12:09:48 2013 +0100 preserve the original flags so pattern caching works properly This adds a new property to the regexp structure, "compflags", and related macros for accessing it. We preserve the original flags passed into the compilation process, so we can compare when we are trying to decide if we need to recompile. Things are a touch tricky as the UTF8 flag is handled specially. ----------------------------------------------------------------------- Summary of changes: dump.c | 15 +++++++++++++-- regcomp.c | 13 +++++++++---- regexp.h | 3 +++ t/re/recompile.t | 8 +++++++- 4 files changed, 32 insertions(+), 7 deletions(-) diff --git a/dump.c b/dump.c index 1e906ed..eaf6674 100644 --- a/dump.c +++ b/dump.c @@ -2095,7 +2095,17 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo dumpregexp: { struct regexp * const r = ReANY((REGEXP*)sv); - flags = RX_EXTFLAGS((REGEXP*)sv); + flags = r->compflags; + sv_setpv(d,""); + append_flags(d, flags, regexp_flags_names); + if (*(SvEND(d) - 1) == ',') { + SvCUR_set(d, SvCUR(d) - 1); + SvPVX(d)[SvCUR(d)] = '\0'; + } + Perl_dump_indent(aTHX_ level, file, " COMPFLAGS = 0x%"UVxf" (%s)\n", + (UV)(r->compflags), SvPVX_const(d)); + + flags = r->extflags; sv_setpv(d,""); append_flags(d, flags, regexp_flags_names); if (*(SvEND(d) - 1) == ',') { @@ -2103,7 +2113,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo SvPVX(d)[SvCUR(d)] = '\0'; } Perl_dump_indent(aTHX_ level, file, " EXTFLAGS = 0x%"UVxf" (%s)\n", - (UV)flags, SvPVX_const(d)); + (UV)(r->extflags), SvPVX_const(d)); + Perl_dump_indent(aTHX_ level, file, " INTFLAGS = 0x%"UVxf"\n", (UV)(r->intflags)); Perl_dump_indent(aTHX_ level, file, " NPARENS = %"UVuf"\n", diff --git a/regcomp.c b/regcomp.c index 85ce79d..34a4e9f 100644 --- a/regcomp.c +++ b/regcomp.c @@ -5651,13 +5651,16 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, } /* return old regex if pattern hasn't changed */ - /* XXX: note in the below we have to check the flags - they could differ - - * this check is probably pessimistic */ + /* XXX: note in the below we have to check the flags as well as the pattern. + * + * Things get a touch tricky as we have to compare the utf8 flag independently + * from the compile flags. + */ if ( old_re && !recompile - && !!RX_UTF8(old_re) == !!RExC_utf8 - && ( ( RX_EXTFLAGS(old_re) & RXf_PMf_FLAGCOPYMASK ) == ( orig_rx_flags & RXf_PMf_FLAGCOPYMASK )) /*XXX: see above */ + && !!RX_UTF8(old_re) == !!RExC_utf8 + && ( RX_COMPFLAGS(old_re) == ( orig_rx_flags & RXf_PMf_FLAGCOPYMASK ) ) && RX_PRECOMP(old_re) && RX_PRELEN(old_re) == plen && memEQ(RX_PRECOMP(old_re), exp, plen)) @@ -5812,6 +5815,8 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, RXi_SET( r, ri ); r->engine= eng; r->extflags = rx_flags; + RXp_COMPFLAGS(r) = orig_rx_flags & RXf_PMf_FLAGCOPYMASK; + if (pm_flags & PMf_IS_QR) { ri->code_blocks = pRExC_state->code_blocks; ri->num_code_blocks = pRExC_state->num_code_blocks; diff --git a/regexp.h b/regexp.h index e90bb5a..40eb8e7 100644 --- a/regexp.h +++ b/regexp.h @@ -129,6 +129,7 @@ struct reg_code_block { I32 subcoffset; /* suboffset equiv, but in chars (for @-/@+) */ \ /* Information about the match that isn't often used */ \ /* offset from wrapped to the start of precomp */ \ + PERL_BITFIELD32 compflags:9; \ PERL_BITFIELD32 pre_prefix:4; \ CV *qr_anoncv /* the anon sub wrapped round qr/(?{..})/ */ @@ -464,6 +465,7 @@ get_regex_charset_name(const U32 flags, STRLEN* const lenp) : RX_MATCH_COPIED_off(prog)) #define RXp_EXTFLAGS(rx) ((rx)->extflags) +#define RXp_COMPFLAGS(rx) ((rx)->compflags) /* For source compatibility. We used to store these explicitly. */ #define RX_PRECOMP(prog) (RX_WRAPPED(prog) + ReANY(prog)->pre_prefix) @@ -478,6 +480,7 @@ get_regex_charset_name(const U32 flags, STRLEN* const lenp) #define RX_CHECK_SUBSTR(prog) (ReANY(prog)->check_substr) #define RX_REFCNT(prog) SvREFCNT(prog) #define RX_EXTFLAGS(prog) RXp_EXTFLAGS(ReANY(prog)) +#define RX_COMPFLAGS(prog) RXp_COMPFLAGS(ReANY(prog)) #define RX_ENGINE(prog) (ReANY(prog)->engine) #define RX_SUBBEG(prog) (ReANY(prog)->subbeg) #define RX_SUBOFFSET(prog) (ReANY(prog)->suboffset) diff --git a/t/re/recompile.t b/t/re/recompile.t index ad00df8..63a7068 100644 --- a/t/re/recompile.t +++ b/t/re/recompile.t @@ -22,7 +22,7 @@ BEGIN { } -plan tests => 36; +plan tests => 38; my $results = runperl( switches => [ '-Dr' ], @@ -187,3 +187,9 @@ my $y = '(?{1})'; BEGIN { $^H |= 0x00200000 } # lightweight "use re 'eval'" "a" =~ qr/a$x$_/ for $y, $y, $y; CODE + +comp_n(6, <<'CODE', 'embedded code qr'); +my $x = qr/a/i; +my $y = qr/a/; +"a" =~ qr/a$_/ for $x, $y, $x, $y; +CODE -- Perl5 Master Repository
