Backport of commit e9105d30 in blead perl. diff -urpN perl-5.10.1.orig/embed.fnc perl-5.10.1/embed.fnc --- perl-5.10.1.orig/embed.fnc 2009-08-15 18:36:34.000000000 +0200 +++ perl-5.10.1/embed.fnc 2009-11-26 00:12:48.000000000 +0100 @@ -1658,7 +1658,6 @@ ERsn |U8* |reghop4 |NN U8 *s|I32 off|NN #endif ERsn |U8* |reghopmaybe3 |NN U8 *s|I32 off|NN const U8 *lim ERs |char* |find_byclass |NN regexp * prog|NN const regnode *c|NN char *s|NN const char *strend|NULLOK regmatch_info *reginfo -Es |void |swap_match_buff|NN regexp * prog Es |void |to_utf8_substr |NN regexp * prog Es |void |to_byte_substr |NN regexp * prog ERs |I32 |reg_check_named_buff_matched |NN const regexp *rex \ diff -urpN perl-5.10.1.orig/embed.h perl-5.10.1/embed.h --- perl-5.10.1.orig/embed.h 2009-07-27 23:37:52.000000000 +0200 +++ perl-5.10.1/embed.h 2009-11-26 00:12:48.000000000 +0100 @@ -1452,7 +1452,6 @@ #if defined(PERL_CORE) || defined(PERL_EXT) #define reghopmaybe3 S_reghopmaybe3 #define find_byclass S_find_byclass -#define swap_match_buff S_swap_match_buff #define to_utf8_substr S_to_utf8_substr #define to_byte_substr S_to_byte_substr #define reg_check_named_buff_matched S_reg_check_named_buff_matched @@ -3783,7 +3782,6 @@ #if defined(PERL_CORE) || defined(PERL_EXT) #define reghopmaybe3 S_reghopmaybe3 #define find_byclass(a,b,c,d,e) S_find_byclass(aTHX_ a,b,c,d,e) -#define swap_match_buff(a) S_swap_match_buff(aTHX_ a) #define to_utf8_substr(a) S_to_utf8_substr(aTHX_ a) #define to_byte_substr(a) S_to_byte_substr(aTHX_ a) #define reg_check_named_buff_matched(a,b) S_reg_check_named_buff_matched(aTHX_ a,b) diff -urpN perl-5.10.1.orig/ext/Devel-PPPort/parts/embed.fnc perl-5.10.1/ext/Devel-PPPort/parts/embed.fnc --- perl-5.10.1.orig/ext/Devel-PPPort/parts/embed.fnc 2009-07-27 23:37:52.000000000 +0200 +++ perl-5.10.1/ext/Devel-PPPort/parts/embed.fnc 2009-11-26 00:12:48.000000000 +0100 @@ -1677,7 +1677,6 @@ ERsn |U8* |reghop4 |NN U8 *s|I32 off|NN #endif ERsn |U8* |reghopmaybe3 |NN U8 *s|I32 off|NN const U8 *lim ERs |char* |find_byclass |NN regexp * prog|NN const regnode *c|NN char *s|NN const char *strend|NULLOK regmatch_info *reginfo -Es |void |swap_match_buff|NN regexp * prog Es |void |to_utf8_substr |NN regexp * prog Es |void |to_byte_substr |NN regexp * prog ERs |I32 |reg_check_named_buff_matched |NN const regexp *rex \ diff -urpN perl-5.10.1.orig/pod/perlreapi.pod perl-5.10.1/pod/perlreapi.pod --- perl-5.10.1.orig/pod/perlreapi.pod 2009-07-27 23:37:52.000000000 +0200 +++ perl-5.10.1/pod/perlreapi.pod 2009-11-26 00:12:48.000000000 +0100 @@ -598,7 +598,7 @@ engine should use something else. =head2 C -TODO: document +Unused. Left in for compatibility with perl 5.10.0. =head2 C diff -urpN perl-5.10.1.orig/pod/perlreguts.pod perl-5.10.1/pod/perlreguts.pod --- perl-5.10.1.orig/pod/perlreguts.pod 2009-07-27 23:37:52.000000000 +0200 +++ perl-5.10.1/pod/perlreguts.pod 2009-11-26 00:12:48.000000000 +0100 @@ -810,13 +810,12 @@ value to other engine implementations. =item C -C is an extra set of startp/endp stored in a C -struct. This is used when the last successful match was from the same pattern -as the current pattern, so that a partial match doesn't overwrite the -previous match's results. When this field is data filled the matching -engine will swap buffers before every match attempt. If the match fails, -then it swaps them back. If it's successful it leaves them. This field -is populated on demand and is by default null. +C formerly was an extra set of startp/endp stored in a +C struct. This was used when the last successful match +was from the same pattern as the current pattern, so that a partial +match didn't overwrite the previous match's results, but it caused a +problem with re-entrant code such as trying to build the UTF-8 swashes. +Currently unused and left for backward compatibility with 5.10.0. =item C diff -urpN perl-5.10.1.orig/proto.h perl-5.10.1/proto.h --- perl-5.10.1.orig/proto.h 2009-08-15 18:36:34.000000000 +0200 +++ perl-5.10.1/proto.h 2009-11-26 00:12:48.000000000 +0100 @@ -5445,11 +5445,6 @@ STATIC char* S_find_byclass(pTHX_ regexp #define PERL_ARGS_ASSERT_FIND_BYCLASS \ assert(prog); assert(c); assert(s); assert(strend) -STATIC void S_swap_match_buff(pTHX_ regexp * prog) - __attribute__nonnull__(pTHX_1); -#define PERL_ARGS_ASSERT_SWAP_MATCH_BUFF \ - assert(prog) - STATIC void S_to_utf8_substr(pTHX_ regexp * prog) __attribute__nonnull__(pTHX_1); #define PERL_ARGS_ASSERT_TO_UTF8_SUBSTR \ diff -urpN perl-5.10.1.orig/regcomp.c perl-5.10.1/regcomp.c --- perl-5.10.1.orig/regcomp.c 2009-07-27 23:37:52.000000000 +0200 +++ perl-5.10.1/regcomp.c 2009-11-26 00:12:48.000000000 +0100 @@ -9361,7 +9361,6 @@ Perl_pregfree(pTHX_ REGEXP *r) if (r->saved_copy) SvREFCNT_dec(r->saved_copy); #endif - Safefree(r->swap); Safefree(r->offs); Safefree(r); } @@ -9413,7 +9412,6 @@ Perl_reg_temp_copy (pTHX_ REGEXP *r) { ret->saved_copy = NULL; #endif ret->mother_re = r; - ret->swap = NULL; return ret; } diff -urpN perl-5.10.1.orig/regexec.c perl-5.10.1/regexec.c --- perl-5.10.1.orig/regexec.c 2009-07-27 23:37:52.000000000 +0200 +++ perl-5.10.1/regexec.c 2009-11-26 00:12:48.000000000 +0100 @@ -1733,28 +1733,6 @@ S_find_byclass(pTHX_ regexp * prog, cons return s; } -static void -S_swap_match_buff (pTHX_ regexp *prog) -{ - regexp_paren_pair *t; - - PERL_ARGS_ASSERT_SWAP_MATCH_BUFF; - - if (!prog->swap) { - /* We have to be careful. If the previous successful match - was from this regex we don't want a subsequent paritally - successful match to clobber the old results. - So when we detect this possibility we add a swap buffer - to the re, and switch the buffer each match. If we fail - we switch it back, otherwise we leave it swapped. - */ - Newxz(prog->swap, (prog->nparens + 1), regexp_paren_pair); - } - t = prog->swap; - prog->swap = prog->offs; - prog->offs = t; -} - /* - regexec_flags - match a regexp against a string @@ -1783,7 +1761,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const I32 multiline; RXi_GET_DECL(prog,progi); regmatch_info reginfo; /* create some info to pass to regtry etc */ - bool swap_on_fail = 0; + regexp_paren_pair *swap = NULL; GET_RE_DEBUG_FLAGS_DECL; PERL_ARGS_ASSERT_REGEXEC_FLAGS; @@ -1861,9 +1839,16 @@ Perl_regexec_flags(pTHX_ REGEXP * const reginfo.ganch = strbeg; } if (PL_curpm && (PM_GETRE(PL_curpm) == prog)) { - swap_on_fail = 1; - swap_match_buff(prog); /* do we need a save destructor here for - eval dies? */ + /* We have to be careful. If the previous successful match + was from this regex we don't want a subsequent partially + successful match to clobber the old results. + So when we detect this possibility we add a swap buffer + to the re, and switch the buffer each match. If we fail + we switch it back, otherwise we leave it swapped. + */ + swap = prog->offs; + /* do we need a save destructor here for eval dies? */ + Newxz(prog->offs, (prog->nparens + 1), regexp_paren_pair); } if (!(flags & REXEC_CHECKED) && (prog->check_substr != NULL || prog->check_utf8 != NULL)) { re_scream_pos_data d; @@ -2162,6 +2147,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const goto phooey; got_it: + Safefree(swap); RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted); if (PL_reg_eval_set) @@ -2207,10 +2193,12 @@ phooey: PL_colors[4], PL_colors[5])); if (PL_reg_eval_set) restore_pos(aTHX_ prog); - if (swap_on_fail) + if (swap) { /* we failed :-( roll it back */ - swap_match_buff(prog); - + Safefree(prog->offs); + prog->offs = swap; + } + return 0; } diff -urpN perl-5.10.1.orig/regexp.h perl-5.10.1/regexp.h --- perl-5.10.1.orig/regexp.h 2009-07-27 23:37:52.000000000 +0200 +++ perl-5.10.1/regexp.h 2009-11-26 00:12:48.000000000 +0100 @@ -88,7 +88,7 @@ typedef struct regexp { /* Data about the last/current match. These are modified during matching*/ U32 lastparen; /* last open paren matched */ U32 lastcloseparen; /* last close paren matched */ - regexp_paren_pair *swap; /* Swap copy of *offs */ + regexp_paren_pair *swap; /* Unused: 5.10.1 and later */ regexp_paren_pair *offs; /* Array of offsets for (@-) and (@+) */ char *subbeg; /* saved or original string diff -urpN perl-5.10.1.orig/t/op/pat.t perl-5.10.1/t/op/pat.t --- perl-5.10.1.orig/t/op/pat.t 2009-07-27 23:37:52.000000000 +0200 +++ perl-5.10.1/t/op/pat.t 2009-11-26 00:12:48.000000000 +0100 @@ -13,7 +13,7 @@ sub run_tests; $| = 1; -my $EXPECTED_TESTS = 4065; # Update this when adding/deleting tests. +my $EXPECTED_TESTS = 4066; # Update this when adding/deleting tests. BEGIN { chdir 't' if -d 't'; @@ -4349,6 +4349,24 @@ sub run_tests { } } + # This only works under -DEBUGGING because it relies on an assert(). + { + local $BugId = '60508'; + local $Message = "Check capture offset re-entrancy of utf8 code."; + + sub fswash { $_[0] =~ s/([>X])//g; } + + my $k1 = "." x 4 . ">>"; + fswash($k1); + + my $k2 = "\x{f1}\x{2022}"; + $k2 =~ s/([\360-\362])/>/g; + fswash($k2); + + iseq($k2, "\x{2022}", "utf8::SWASHNEW doesn't cause capture leaks"); + } + + { local $BugId = 65372; # minimal CURLYM limited to 32767 matches my @pat = (