In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/dced9957a01acb38e272402bbc989e849f25b68f?hp=49143bdc2f098cbb6c3513be408d13f261a699c1>
- Log ----------------------------------------------------------------- commit dced9957a01acb38e272402bbc989e849f25b68f Author: Father Chrysostomos <[email protected]> Date: Thu Dec 19 22:19:35 2013 -0800 regen pod issues M t/porting/known_pod_issues.dat commit 4cba5ac0e07b709d489a2aaedf4c007712a09e51 Author: Father Chrysostomos <[email protected]> Date: Thu Dec 19 22:06:47 2013 -0800 Fix string corruption with (??{}) and PERL_NO_COW Commit 9ffd39ab75, which allowed PADTMPsâ string buffers to be stolen, caused "$a$b" =~ /(??{})/ to cause string corruption with match varia- bles on some systems, because the buffer from "$a$b"âs return value was being stolen when âcopiedâ into a new $_ for the code block. The string copy necessary for $& and $1 to work would happen only after the code blockâs $_ had been freed, and consequently after the string buffer had been freed. Whether this would cause observable buggy behaviour (as opposed to things only memory tools like valgrind would catch) depended on whether the malloc implementation would modify the string immediately when freeing it. Dave Mitchell observed in <[email protected]> that tests were failing under -DPERL_NO_COW. The added test will also fail (for me at least) under copy-on-write, because the string is long enough to favour swiping the buffer. (It happens for me only on Linux, not Dar- win, incidentally.) Copying the string with _nosteal fixes the problem. M regexec.c M t/re/pat_re_eval.t ----------------------------------------------------------------------- Summary of changes: regexec.c | 2 +- t/porting/known_pod_issues.dat | 2 +- t/re/pat_re_eval.t | 9 ++++++++- 3 files changed, 10 insertions(+), 3 deletions(-) diff --git a/regexec.c b/regexec.c index 7f6acb2..fab9009 100644 --- a/regexec.c +++ b/regexec.c @@ -2409,7 +2409,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend, Not newSVsv, either, as it does not COW. */ reginfo->sv = newSV(0); - sv_setsv(reginfo->sv, sv); + SvSetSV_nosteal(reginfo->sv, sv); SAVEFREESV(reginfo->sv); } diff --git a/t/porting/known_pod_issues.dat b/t/porting/known_pod_issues.dat index 90fa755..342b72a 100644 --- a/t/porting/known_pod_issues.dat +++ b/t/porting/known_pod_issues.dat @@ -270,7 +270,7 @@ pod/perlvms.pod ? Should you be using F<...> or maybe L<...> instead of 1 pod/perlwin32.pod Verbatim line length including indents exceeds 79 by 12 porting/epigraphs.pod Verbatim line length including indents exceeds 79 by 12 porting/expand-macro.pl Verbatim line length including indents exceeds 79 by 2 -porting/release_managers_guide.pod Verbatim line length including indents exceeds 79 by 5 +porting/release_managers_guide.pod Verbatim line length including indents exceeds 79 by 6 porting/todo.pod Verbatim line length including indents exceeds 79 by 7 utils/c2ph Verbatim line length including indents exceeds 79 by 44 lib/benchmark.pm Verbatim line length including indents exceeds 79 by 2 diff --git a/t/re/pat_re_eval.t b/t/re/pat_re_eval.t index 96614d2..551788b 100644 --- a/t/re/pat_re_eval.t +++ b/t/re/pat_re_eval.t @@ -22,7 +22,7 @@ BEGIN { } -plan tests => 524; # Update this when adding/deleting tests. +plan tests => 525; # Update this when adding/deleting tests. run_tests() unless caller; @@ -1215,6 +1215,13 @@ sub run_tests { is "@matchsticks", "1 ", 'qr magic is not cached on refs'; } + { + my ($foo, $bar) = ("foo"x1000, "bar"x1000); + "$foo$bar" =~ /(??{".*"})/; + is "$&", "foo"x1000 . "bar"x1000, + 'padtmp swiping does not affect "$a$b" =~ /(??{})/' + } + } # End of sub run_tests 1; -- Perl5 Master Repository
