From 6502e08109cd003b2cdf39bc94ef35e52203240b Mon Sep 17 00:00:00 2001 From: David Mitchell Date: Thu, 26 Jul 2012 16:04:09 +0100 Subject: [PATCH] Don't copy all of the match string buffer When a pattern matches, and that pattern contains captures (or $`, $&, $' or /p are present), a copy is made of the whole original string, so that $1 et al continue to hold the correct value even if the original string is subsequently modified. This can have severe performance penalties; for example, this code causes a 1Mb buffer to be allocated, copied and freed a million times: $&; $x = 'x' x 1_000_000; 1 while $x =~ /(.)/g; This commit changes this so that, where possible, only the needed substring of the original string is copied: in the above case, only a 1-byte buffer is copied each time. Also, it now reuses or reallocs the buffer, rather than freeing and mallocing each time. Now that PL_sawampersand is a 3-bit flag indicating separately whether $`, $& and $' have been seen, they each contribute only their own individual penalty; which ones have been seen will limit the extent to which we can avoid copying the whole buffer. Note that the above code *without* the $& is not currently slow, but only because the copying is artificially disabled to avoid the performance hit. The next but one commit will remove that hack, meaning that it will still be fast, but will now be correct in the presence of a modified original string. We achieve this by by adding suboffset and subcoffset fields to the existing subbeg and sublen fields of a regex, to indicate how many bytes and characters have been skipped from the logical start of the string till the physical start of the buffer. To avoid copying stuff at the end, we just reduce sublen. For example, in this: "abcdefgh" =~ /(c)d/ subbeg points to a malloced buffer containing "c\0"; sublen == 1, and suboffset == 2 (as does subcoffset). while if $& has been seen, subbeg points to a malloced buffer containing "cd\0"; sublen == 2, and suboffset == 2. If in addition $' has been seen, then subbeg points to a malloced buffer containing "cdefgh\0"; sublen == 6, and suboffset == 2. The regex engine won't do this by default; there are two new flag bits, REXEC_COPY_SKIP_PRE and REXEC_COPY_SKIP_POST, which in conjunction with REXEC_COPY_STR, request that the engine skip the start or end of the buffer (it will still copy in the presence of the relevant $`, $&, $', /p). Only pp_match has been enhanced to use these extra flags; substitution can't easily benefit, since the usual action of s///g is to copy the whole string first time round, then perform subsequent matching iterations against the copy, without further copying. So you still need to copy most of the buffer. --- dump.c | 4 ++ ext/Devel-Peek/t/Peek.t | 2 + mg.c | 8 ++- pod/perlreapi.pod | 22 +++++++-- pp.c | 3 ++ pp_ctl.c | 13 +++-- pp_hot.c | 32 +++++++++--- regcomp.c | 10 ++-- regexec.c | 108 ++++++++++++++++++++++++++++++++++++++--- regexp.h | 25 ++++++++++ t/porting/known_pod_issues.dat | 2 +- t/re/re_tests | 5 ++ 12 files changed, 207 insertions(+), 27 deletions(-) diff --git a/dump.c b/dump.c index ada6ae9..46893d6 100644 --- a/dump.c +++ b/dump.c @@ -2056,6 +2056,10 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo (UV)(r->pre_prefix)); Perl_dump_indent(aTHX_ level, file, " SUBLEN = %"IVdf"\n", (IV)(r->sublen)); + Perl_dump_indent(aTHX_ level, file, " SUBOFFSET = %"IVdf"\n", + (IV)(r->suboffset)); + Perl_dump_indent(aTHX_ level, file, " SUBCOFFSET = %"IVdf"\n", + (IV)(r->subcoffset)); if (r->subbeg) Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x%"UVxf" %s\n", PTR2UV(r->subbeg), diff --git a/ext/Devel-Peek/t/Peek.t b/ext/Devel-Peek/t/Peek.t index 6913d59..164e2ff 100644 --- a/ext/Devel-Peek/t/Peek.t +++ b/ext/Devel-Peek/t/Peek.t @@ -350,6 +350,8 @@ do_test('reference to regexp', GOFS = 0 PRE_PREFIX = 4 SUBLEN = 0 + SUBOFFSET = 0 + SUBCOFFSET = 0 SUBBEG = 0x0 ENGINE = $ADDR MOTHER_RE = $ADDR diff --git a/mg.c b/mg.c index 37b8125..26cabbe 100644 --- a/mg.c +++ b/mg.c @@ -637,6 +637,8 @@ Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg) return (U32)-1; } +/* @-, @+ */ + int Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg) { @@ -665,7 +667,9 @@ Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg) if (i > 0 && RX_MATCH_UTF8(rx)) { const char * const b = RX_SUBBEG(rx); if (b) - i = utf8_length((U8*)b, (U8*)(b+i)); + i = RX_SUBCOFFSET(rx) + + utf8_length((U8*)b, + (U8*)(b-RX_SUBOFFSET(rx)+i)); } sv_setiv(sv, i); @@ -675,6 +679,8 @@ Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg) return 0; } +/* @-, @+ */ + int Perl_magic_regdatum_set(pTHX_ SV *sv, MAGIC *mg) { diff --git a/pod/perlreapi.pod b/pod/perlreapi.pod index ec07218..1ccc6d8 100644 --- a/pod/perlreapi.pod +++ b/pod/perlreapi.pod @@ -555,6 +555,8 @@ values. char *subbeg; /* saved or original string so \digit works forever. */ SV_SAVED_COPY /* If non-NULL, SV which is COW from original */ I32 sublen; /* Length of string pointed by subbeg */ + I32 suboffset; /* byte offset of subbeg from logical start of str */ + I32 subcoffset; /* suboffset equiv, but in chars (for @-/@+) */ /* Information about the match that isn't often used */ I32 prelen; /* length of precomp */ @@ -695,9 +697,23 @@ occur at a floating offset from the start of the pattern. Used to do Fast-Boyer-Moore searches on the string to find out if its worth using the regex engine at all, and if so where in the string to search. -=head2 C C C - -Used during execution phase for managing search and replace patterns. +=head2 C C C C C + +Used during the execution phase for managing search and replace patterns, +and for providing the text for C<$&>, C<$1> etc. C points to a +buffer (either the original string, or a copy in the case of +C), and C is the length of the buffer. The +C start and end indices index into this buffer. + +In the presence of the C flag, but with the addition of +the C or C flags, an engine +can choose not to copy the full buffer (although it must still do so in +the presence of C or the relevant bits being set in +C). In this case, it may set C to indicate the +number of bytes from the logical start of the buffer to the physical start +(i.e. C). It should also set C, the number of +characters in the offset. The latter is needed to support C<@-> and C<@+> +which work in characters, not bytes. =head2 C C diff --git a/pp.c b/pp.c index 29db8ed..1c7b18a 100644 --- a/pp.c +++ b/pp.c @@ -5549,6 +5549,9 @@ PP(pp_split) if (rex_return == 0) break; TAINT_IF(RX_MATCH_TAINTED(rx)); + /* we never pass the REXEC_COPY_STR flag, so it should + * never get copied */ + assert(!RX_MATCH_COPIED(rx)); if (RX_MATCH_COPIED(rx) && RX_SUBBEG(rx) != orig) { m = s; s = orig; diff --git a/pp_ctl.c b/pp_ctl.c index 1477373..ecb8c9f 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -289,6 +289,7 @@ PP(pp_substcont) if (RX_MATCH_COPIED(rx) && RX_SUBBEG(rx) != orig) { m = s; s = orig; + assert(!RX_SUBOFFSET(rx)); cx->sb_orig = orig = RX_SUBBEG(rx); s = orig + (m - s); cx->sb_strend = s + (cx->sb_strend - m); @@ -353,9 +354,9 @@ Perl_rxres_save(pTHX_ void **rsp, REGEXP *rx) if (!p || p[1] < RX_NPARENS(rx)) { #ifdef PERL_OLD_COPY_ON_WRITE - i = 7 + RX_NPARENS(rx) * 2; + i = 7 + (RX_NPARENS(rx)+1) * 2; #else - i = 6 + RX_NPARENS(rx) * 2; + i = 6 + (RX_NPARENS(rx)+1) * 2; #endif if (!p) Newx(p, i, UV); @@ -364,7 +365,7 @@ Perl_rxres_save(pTHX_ void **rsp, REGEXP *rx) *rsp = (void*)p; } - *p++ = PTR2UV(RX_MATCH_COPIED(rx) ? RX_SUBBEG(rx) : NULL); + *p++ = RX_MATCH_COPIED(rx) ? 1 : 0; RX_MATCH_COPIED_off(rx); #ifdef PERL_OLD_COPY_ON_WRITE @@ -373,9 +374,10 @@ Perl_rxres_save(pTHX_ void **rsp, REGEXP *rx) #endif *p++ = RX_NPARENS(rx); - *p++ = PTR2UV(RX_SUBBEG(rx)); *p++ = (UV)RX_SUBLEN(rx); + *p++ = (UV)RX_SUBOFFSET(rx); + *p++ = (UV)RX_SUBCOFFSET(rx); for (i = 0; i <= RX_NPARENS(rx); ++i) { *p++ = (UV)RX_OFFS(rx)[i].start; *p++ = (UV)RX_OFFS(rx)[i].end; @@ -403,9 +405,10 @@ S_rxres_restore(pTHX_ void **rsp, REGEXP *rx) #endif RX_NPARENS(rx) = *p++; - RX_SUBBEG(rx) = INT2PTR(char*,*p++); RX_SUBLEN(rx) = (I32)(*p++); + RX_SUBOFFSET(rx) = (I32)*p++; + RX_SUBCOFFSET(rx) = (I32)*p++; for (i = 0; i <= RX_NPARENS(rx); ++i) { RX_OFFS(rx)[i].start = (I32)(*p++); RX_OFFS(rx)[i].end = (I32)(*p++); diff --git a/pp_hot.c b/pp_hot.c index 6c3f4f6..91958ac 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -1325,9 +1325,19 @@ PP(pp_match) appears to be quite tricky. Test for the unsafe vars are TODO for now. */ if ( (!global && RX_NPARENS(rx)) - || SvTEMP(TARG) || SvAMAGIC(TARG) || PL_sawampersand - || (RX_EXTFLAGS(rx) & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY))) - r_flags |= REXEC_COPY_STR; + || PL_sawampersand + || SvTEMP(TARG) + || SvAMAGIC(TARG) + || (RX_EXTFLAGS(rx) & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY)) + ) { + r_flags |= (REXEC_COPY_STR|REXEC_COPY_SKIP_PRE); + /* in @a =~ /(.)/g, we iterate multiple times, but copy the buffer + * only on the first iteration. Therefore we need to copy $' as well + * as $&, to make the rest of the string available for captures in + * subsequent iterations */ + if (! (global && gimme == G_ARRAY)) + r_flags |= REXEC_COPY_SKIP_POST; + }; play_it_again: if (global && RX_OFFS(rx)[0].start != -1) { @@ -1472,6 +1482,8 @@ yup: /* Confirmed by INTUIT */ if (global) { /* FIXME - should rx->subbeg be const char *? */ RX_SUBBEG(rx) = (char *) truebase; + RX_SUBOFFSET(rx) = 0; + RX_SUBCOFFSET(rx) = 0; RX_OFFS(rx)[0].start = s - truebase; if (RX_MATCH_UTF8(rx)) { char * const t = (char*)utf8_hop((U8*)s, RX_MINLENRET(rx)); @@ -1507,6 +1519,8 @@ yup: /* Confirmed by INTUIT */ #endif } RX_SUBLEN(rx) = strend - t; + RX_SUBOFFSET(rx) = 0; + RX_SUBCOFFSET(rx) = 0; RX_MATCH_COPIED_on(rx); off = RX_OFFS(rx)[0].start = s - t; RX_OFFS(rx)[0].end = off + RX_MINLENRET(rx); @@ -2127,9 +2141,14 @@ PP(pp_subst) pm = PL_curpm; rx = PM_GETRE(pm); } - r_flags = (RX_NPARENS(rx) || SvTEMP(TARG) || PL_sawampersand - || (RX_EXTFLAGS(rx) & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY)) ) - ? REXEC_COPY_STR : 0; + + r_flags = ( RX_NPARENS(rx) + || PL_sawampersand + || SvTEMP(TARG) + || (RX_EXTFLAGS(rx) & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY)) + ) + ? REXEC_COPY_STR + : 0; orig = m = s; if (RX_EXTFLAGS(rx) & RXf_USE_INTUIT) { @@ -2331,6 +2350,7 @@ PP(pp_subst) if (RX_MATCH_COPIED(rx) && RX_SUBBEG(rx) != orig) { m = s; s = orig; + assert(RX_SUBOFFSET(rx) == 0); orig = RX_SUBBEG(rx); s = orig + (m - s); strend = s + (strend - m); diff --git a/regcomp.c b/regcomp.c index 1c4bad5..a9e92e1 100644 --- a/regcomp.c +++ b/regcomp.c @@ -6722,8 +6722,8 @@ Perl_reg_numbered_buff_fetch(pTHX_ REGEXP * const r, const I32 paren, && rx->offs[0].end != -1) { /* $', ${^POSTMATCH} */ - s = rx->subbeg + rx->offs[0].end; - i = rx->sublen - rx->offs[0].end; + s = rx->subbeg - rx->suboffset + rx->offs[0].end; + i = rx->sublen + rx->suboffset - rx->offs[0].end; } else if ( 0 <= n && n <= (I32)rx->nparens && @@ -6732,7 +6732,7 @@ Perl_reg_numbered_buff_fetch(pTHX_ REGEXP * const r, const I32 paren, { /* $&, ${^MATCH}, $1 ... */ i = t1 - s1; - s = rx->subbeg + s1; + s = rx->subbeg + s1 - rx->suboffset; } else { goto ret_undef; } @@ -6859,7 +6859,7 @@ Perl_reg_numbered_buff_length(pTHX_ REGEXP * const r, const SV * const sv, } getlen: if (i > 0 && RXp_MATCH_UTF8(rx)) { - const char * const s = rx->subbeg + s1; + const char * const s = rx->subbeg - rx->suboffset + s1; const U8 *ep; STRLEN el; @@ -14462,6 +14462,8 @@ Perl_save_re_context(pTHX) PL_reg_oldsaved = NULL; PL_reg_oldsavedlen = 0; + PL_reg_oldsavedoffset = 0; + PL_reg_oldsavedcoffset = 0; PL_reg_maxiter = 0; PL_reg_leftiter = 0; PL_reg_poscache = NULL; diff --git a/regexec.c b/regexec.c index df815b2..fa69a50 100644 --- a/regexec.c +++ b/regexec.c @@ -2566,9 +2566,7 @@ got_it: /* make sure $`, $&, $', and $digit will work later */ if ( !(flags & REXEC_NOT_FIRST) ) { - RX_MATCH_COPY_FREE(rx); if (flags & REXEC_COPY_STR) { - const I32 i = PL_regeol - strbeg; #ifdef PERL_OLD_COPY_ON_WRITE if ((SvIsCOW(sv) || (SvFLAGS(sv) & CAN_COW_MASK) == CAN_COW_FLAGS)) { @@ -2580,17 +2578,105 @@ got_it: prog->saved_copy = sv_setsv_cow(prog->saved_copy, sv); prog->subbeg = (char *)SvPVX_const(prog->saved_copy); assert (SvPOKp(prog->saved_copy)); + prog->sublen = PL_regeol - strbeg; + prog->suboffset = 0; + prog->subcoffset = 0; } else #endif { - RX_MATCH_COPIED_on(rx); - s = savepvn(strbeg, i); - prog->subbeg = s; - } - prog->sublen = i; + I32 min = 0; + I32 max = PL_regeol - strbeg; + I32 sublen; + + if ( (flags & REXEC_COPY_SKIP_POST) + && !(RX_EXTFLAGS(rx) & RXf_PMf_KEEPCOPY) /* //p */ + && !(PL_sawampersand & SAWAMPERSAND_RIGHT) + ) { /* don't copy $' part of string */ + U32 n = (PL_sawampersand & SAWAMPERSAND_MIDDLE) ? 0 : 1; + max = -1; + /* calculate the right-most part of the string covered + * by a capture. Due to look-ahead, this may be to + * the right of $&, so we have to scan all captures */ + while (n <= prog->lastparen) { + if (prog->offs[n].end > max) + max = prog->offs[n].end; + n++; + } + if (max == -1) + max = (PL_sawampersand & SAWAMPERSAND_LEFT) + ? prog->offs[0].start + : 0; + assert(max >= 0 && max <= PL_regeol - strbeg); + } + + if ( (flags & REXEC_COPY_SKIP_PRE) + && !(RX_EXTFLAGS(rx) & RXf_PMf_KEEPCOPY) /* //p */ + && !(PL_sawampersand & SAWAMPERSAND_LEFT) + ) { /* don't copy $` part of string */ + U32 n = (PL_sawampersand & SAWAMPERSAND_MIDDLE) ? 0 : 1; + min = max; + /* calculate the left-most part of the string covered + * by a capture. Due to look-behind, this may be to + * the left of $&, so we have to scan all captures */ + while (min && n <= prog->lastparen) { + if ( prog->offs[n].start != -1 + && prog->offs[n].start < min) + { + min = prog->offs[n].start; + } + n++; + } + if ((PL_sawampersand & SAWAMPERSAND_RIGHT) + && min > prog->offs[0].end + ) + min = prog->offs[0].end; + + } + + assert(min >= 0 && min <= max && min <= PL_regeol - strbeg); + sublen = max - min; + + if (RX_MATCH_COPIED(rx)) { + if (sublen > prog->sublen) + prog->subbeg = + (char*)saferealloc(prog->subbeg, sublen+1); + } + else + prog->subbeg = (char*)safemalloc(sublen+1); + Copy(strbeg + min, prog->subbeg, sublen, char); + prog->subbeg[sublen] = '\0'; + prog->suboffset = min; + prog->sublen = sublen; + } + RX_MATCH_COPIED_on(rx); + prog->subcoffset = prog->suboffset; + if (prog->suboffset && utf8_target) { + /* Convert byte offset to chars. + * XXX ideally should only compute this if @-/@+ + * has been seen, a la PL_sawampersand ??? */ + + /* If there's a direct correspondence between the + * string which we're matching and the original SV, + * then we can use the utf8 len cache associated with + * the SV. In particular, it means that under //g, + * sv_pos_b2u() will use the previously cached + * position to speed up working out the new length of + * subcoffset, rather than counting from the start of + * the string each time. This stops + * $x = "\x{100}" x 1E6; 1 while $x =~ /(.)/g; + * from going quadratic */ + if (SvPOKp(sv) && SvPVX(sv) == strbeg) + sv_pos_b2u(sv, &(prog->subcoffset)); + else + prog->subcoffset = utf8_length((U8*)strbeg, + (U8*)(strbeg+prog->suboffset)); + } } else { + RX_MATCH_COPY_FREE(rx); prog->subbeg = strbeg; + prog->suboffset = 0; + prog->subcoffset = 0; prog->sublen = PL_regeol - strbeg; /* strend may have been modified */ } } @@ -2695,6 +2781,8 @@ S_regtry(pTHX_ regmatch_info *reginfo, char **startpos) $` inside (?{}) could fail... */ PL_reg_oldsaved = prog->subbeg; PL_reg_oldsavedlen = prog->sublen; + PL_reg_oldsavedoffset = prog->suboffset; + PL_reg_oldsavedcoffset = prog->suboffset; #ifdef PERL_OLD_COPY_ON_WRITE PL_nrs = prog->saved_copy; #endif @@ -2703,6 +2791,8 @@ S_regtry(pTHX_ regmatch_info *reginfo, char **startpos) else PL_reg_oldsaved = NULL; prog->subbeg = PL_bostr; + prog->suboffset = 0; + prog->subcoffset = 0; prog->sublen = PL_regeol - PL_bostr; /* strend may have been modified */ } #ifdef DEBUGGING @@ -4535,6 +4625,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog) RXp_MATCH_COPIED_off(re); re->subbeg = rex->subbeg; re->sublen = rex->sublen; + re->suboffset = rex->suboffset; + re->subcoffset = rex->subcoffset; rei = RXi_GET(re); DEBUG_EXECUTE_r( debug_start_match(re_sv, utf8_target, locinput, PL_regeol, @@ -7167,6 +7259,8 @@ restore_pos(pTHX_ void *arg) if (PL_reg_oldsaved) { rex->subbeg = PL_reg_oldsaved; rex->sublen = PL_reg_oldsavedlen; + rex->suboffset = PL_reg_oldsavedoffset; + rex->subcoffset = PL_reg_oldsavedcoffset; #ifdef PERL_OLD_COPY_ON_WRITE rex->saved_copy = PL_nrs; #endif diff --git a/regexp.h b/regexp.h index df3369a..3e245d0 100644 --- a/regexp.h +++ b/regexp.h @@ -124,6 +124,8 @@ struct reg_code_block { char *subbeg; \ SV_SAVED_COPY /* If non-NULL, SV which is COW from original */\ I32 sublen; /* Length of string pointed by subbeg */ \ + I32 suboffset; /* byte offset of subbeg from logical start of str */ \ + 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 pre_prefix:4; \ @@ -477,6 +479,18 @@ get_regex_charset_name(const U32 flags, STRLEN* const lenp) assert(SvTYPE(_rx_subbeg) == SVt_REGEXP); \ &SvANY(_rx_subbeg)->subbeg; \ })) +# define RX_SUBOFFSET(prog) \ + (*({ \ + const REGEXP *const _rx_suboffset = (prog); \ + assert(SvTYPE(_rx_suboffset) == SVt_REGEXP); \ + &SvANY(_rx_suboffset)->suboffset; \ + })) +# define RX_SUBCOFFSET(prog) \ + (*({ \ + const REGEXP *const _rx_subcoffset = (prog); \ + assert(SvTYPE(_rx_subcoffset) == SVt_REGEXP); \ + &SvANY(_rx_subcoffset)->subcoffset; \ + })) # define RX_OFFS(prog) \ (*({ \ const REGEXP *const _rx_offs = (prog); \ @@ -493,6 +507,8 @@ get_regex_charset_name(const U32 flags, STRLEN* const lenp) # define RX_EXTFLAGS(prog) RXp_EXTFLAGS((struct regexp *)SvANY(prog)) # define RX_ENGINE(prog) (((struct regexp *)SvANY(prog))->engine) # define RX_SUBBEG(prog) (((struct regexp *)SvANY(prog))->subbeg) +# define RX_SUBOFFSET(prog) (((struct regexp *)SvANY(prog))->suboffset) +# define RX_SUBCOFFSET(prog) (((struct regexp *)SvANY(prog))->subcoffset) # define RX_OFFS(prog) (((struct regexp *)SvANY(prog))->offs) # define RX_NPARENS(prog) (((struct regexp *)SvANY(prog))->nparens) #endif @@ -541,6 +557,11 @@ get_regex_charset_name(const U32 flags, STRLEN* const lenp) #define REXEC_SCREAM 0x04 /* use scream table. */ #define REXEC_IGNOREPOS 0x08 /* \G matches at start. */ #define REXEC_NOT_FIRST 0x10 /* This is another iteration of //g. */ + /* under REXEC_COPY_STR, it's ok for the + * engine (modulo PL_sawamperand etc) + * to skip copying ... */ +#define REXEC_COPY_SKIP_PRE 0x20 /* ...the $` part of the string, or */ +#define REXEC_COPY_SKIP_POST 0x40 /* ...the $' part of the string */ #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) # define ReREFCNT_inc(re) \ @@ -763,6 +784,8 @@ typedef struct regmatch_slab { #define PL_reg_curpm PL_reg_state.re_state_reg_curpm #define PL_reg_oldsaved PL_reg_state.re_state_reg_oldsaved #define PL_reg_oldsavedlen PL_reg_state.re_state_reg_oldsavedlen +#define PL_reg_oldsavedoffset PL_reg_state.re_state_reg_oldsavedoffset +#define PL_reg_oldsavedcoffset PL_reg_state.re_state_reg_oldsavedcoffset #define PL_reg_maxiter PL_reg_state.re_state_reg_maxiter #define PL_reg_leftiter PL_reg_state.re_state_reg_leftiter #define PL_reg_poscache PL_reg_state.re_state_reg_poscache @@ -784,6 +807,8 @@ struct re_save_state { PMOP *re_state_reg_curpm; /* from regexec.c */ char *re_state_reg_oldsaved; /* old saved substr during match */ STRLEN re_state_reg_oldsavedlen; /* old length of saved substr during match */ + STRLEN re_state_reg_oldsavedoffset; /* old offset of saved substr during match */ + STRLEN re_state_reg_oldsavedcoffset;/* old coffset of saved substr during match */ STRLEN re_state_reg_poscache_size; /* size of pos cache of WHILEM */ I32 re_state_reg_oldpos; /* from regexec.c */ I32 re_state_reg_maxiter; /* max wait until caching pos */ diff --git a/t/porting/known_pod_issues.dat b/t/porting/known_pod_issues.dat index f316fa7..ba4ccf6 100644 --- a/t/porting/known_pod_issues.dat +++ b/t/porting/known_pod_issues.dat @@ -266,7 +266,7 @@ pod/perlpacktut.pod Verbatim line length including indents exceeds 79 by 6 pod/perlperf.pod Verbatim line length including indents exceeds 79 by 154 pod/perlpodspec.pod Verbatim line length including indents exceeds 79 by 9 pod/perlpodstyle.pod Verbatim line length including indents exceeds 79 by 1 -pod/perlreapi.pod Verbatim line length including indents exceeds 79 by 17 +pod/perlreapi.pod Verbatim line length including indents exceeds 79 by 18 pod/perlrebackslash.pod Verbatim line length including indents exceeds 79 by 1 pod/perlref.pod Verbatim line length including indents exceeds 79 by 1 pod/perlreguts.pod Verbatim line length including indents exceeds 79 by 17 diff --git a/t/re/re_tests b/t/re/re_tests index f44bdc1..94b7a38 100644 --- a/t/re/re_tests +++ b/t/re/re_tests @@ -1702,5 +1702,10 @@ ab[c\\\](??{"x"})]{3}d ab\\](d y - - \W \x{200D} n - - /^(?d:\xdf|_)*_/i \x{17f}\x{17f}_ y $& \x{17f}\x{17f}_ +# +# check that @-, @+ count chars, not bytes; especially if beginning of +# string is not copied + +(\x{100}) \x{2000}\x{2000}\x{2000}\x{100} y $-[0]:$-[1]:$+[0]:$+[1] 3:3:4:4 # vim: softtabstop=0 noexpandtab -- 2.7.4