diff -up perl-5.10.0/embed.fnc.much perl-5.10.0/embed.fnc --- perl-5.10.0/embed.fnc.much 2009-07-27 08:31:33.839374246 +0200 +++ perl-5.10.0/embed.fnc 2009-07-27 08:32:05.322374620 +0200 @@ -1441,7 +1441,6 @@ ERsn |U8* |reghop4 |NN U8 *pos|I32 off|N #endif ERsn |U8* |reghopmaybe3 |NN U8 *pos|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|NN const regnode *prog diff -up perl-5.10.0/embed.h.much perl-5.10.0/embed.h --- perl-5.10.0/embed.h.much 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/embed.h 2009-07-27 08:31:34.016378805 +0200 @@ -1426,7 +1426,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 @@ -3714,7 +3713,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 -up perl-5.10.0/ext/Devel/PPPort/parts/embed.fnc.much perl-5.10.0/ext/Devel/PPPort/parts/embed.fnc --- perl-5.10.0/ext/Devel/PPPort/parts/embed.fnc.much 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/ext/Devel/PPPort/parts/embed.fnc 2009-07-27 08:32:58.859374528 +0200 @@ -1436,7 +1436,6 @@ ERsn |U8* |reghop4 |NN U8 *pos|I32 off|N #endif ERsn |U8* |reghopmaybe3 |NN U8 *pos|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|NN const regnode *prog diff -up perl-5.10.0/pod/perlapi.pod.much perl-5.10.0/pod/perlapi.pod diff -up perl-5.10.0/pod/perlguts.pod.much perl-5.10.0/pod/perlguts.pod diff -up perl-5.10.0/proto.h.much perl-5.10.0/proto.h --- perl-5.10.0/proto.h.much 2009-07-27 08:31:33.000000000 +0200 +++ perl-5.10.0/proto.h 2009-07-27 08:35:52.103374484 +0200 @@ -3851,9 +3851,6 @@ STATIC char* S_find_byclass(pTHX_ regexp __attribute__nonnull__(pTHX_3) __attribute__nonnull__(pTHX_4); -STATIC void S_swap_match_buff(pTHX_ regexp * prog) - __attribute__nonnull__(pTHX_1); - STATIC void S_to_utf8_substr(pTHX_ regexp * prog) __attribute__nonnull__(pTHX_1); diff -up perl-5.10.0/regcomp.c.much perl-5.10.0/regcomp.c --- perl-5.10.0/regcomp.c.much 2009-07-27 08:31:33.000000000 +0200 +++ perl-5.10.0/regcomp.c 2009-07-27 08:37:09.598625044 +0200 @@ -9167,7 +9167,6 @@ Perl_pregfree(pTHX_ struct regexp *r) if (r->saved_copy) SvREFCNT_dec(r->saved_copy); #endif - Safefree(r->swap); Safefree(r->offs); Safefree(r); } @@ -9216,7 +9215,6 @@ Perl_reg_temp_copy (pTHX_ struct regexp ret->saved_copy = NULL; #endif ret->mother_re = r; - ret->swap = NULL; return ret; } diff -up perl-5.10.0/regexec.c.much perl-5.10.0/regexec.c --- perl-5.10.0/regexec.c.much 2007-12-18 11:47:08.000000000 +0100 +++ perl-5.10.0/regexec.c 2009-07-27 08:40:15.966404877 +0200 @@ -1718,26 +1718,6 @@ S_find_byclass(pTHX_ regexp * prog, cons return s; } -static void -S_swap_match_buff (pTHX_ regexp *prog) { - regexp_paren_pair *t; - - 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 */ @@ -1765,7 +1745,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; @@ -1843,9 +1823,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; @@ -2144,6 +2131,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) @@ -2189,10 +2177,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 -up perl-5.10.0/regexp.h.much perl-5.10.0/regexp.h --- perl-5.10.0/regexp.h.much 2007-12-18 11:47:08.000000000 +0100 +++ perl-5.10.0/regexp.h 2009-07-27 08:41:06.882374786 +0200 @@ -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 -up perl-5.10.0/t/op/pat.t.much perl-5.10.0/t/op/pat.t --- perl-5.10.0/t/op/pat.t.much 2007-12-18 11:47:08.000000000 +0100 +++ perl-5.10.0/t/op/pat.t 2009-07-27 08:44:50.343375513 +0200 @@ -4558,10 +4558,27 @@ ok($@=~/\QSequence \k... not terminated ok("aaa" =~ /$s/, "#45337"); } +# 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"); +} + # Put new tests above the dotted line about a page above this comment iseq(0+$::test,$::TestCount,"Got the right number of tests!"); # Don't forget to update this! BEGIN { - $::TestCount = 4013; + $::TestCount = 4014; print "1..$::TestCount\n"; } +