In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/ef463b6d87c1ce4e4946bdf785d47e481c1f33f2?hp=6e53b6cab73f4cc348a8366106f0569e65c858f1>
- Log -----------------------------------------------------------------
commit ef463b6d87c1ce4e4946bdf785d47e481c1f33f2
Author: Father Chrysostomos <spr...@cpan.org>
Date: Wed Jan 22 21:31:04 2014 -0800
perldelta for Cow Tools
I somehow missed this.
M pod/perldelta.pod
commit 865ec3f2de36b6663f3e2e06ad07e5b5b0c65ecd
Author: Father Chrysostomos <spr...@cpan.org>
Date: Tue Jan 28 17:55:04 2014 -0800
op.c: fix grammar in apidocs
M op.c
commit 7e68f15291c4da4e5b8237bfe9690edbd9c5a5d3
Author: Father Chrysostomos <spr...@cpan.org>
Date: Tue Jan 28 17:50:45 2014 -0800
Fix crash with (??{undef *^R}) and (?{})
$ ./perl -Ilib -e '"" =~ /(??{undef *^R;""})(?{42})/'
Segmentation fault: 11
This started crashing in 4b22688e5c.
What happens is that the undef frees the scalar pointed to by oreplsv
in regtry, Then that scalar is reused for the regexp object created
from the return value of the ?? block. sv_setsv(oreplsv,...) ends up
trying to set the IV slot of a regexp, overwriting the engine field
(sv_setsv probably needs an assertion). Then later accesses crash
because r->engine is now a bad pointer.
(Though why it only started crashing in 4b22688e5c and not before I
have not figured out.)
The solution is for S_regtry to hang on to the SV with an extra refer-
ence count in case it gets freed.
M regexec.c
M t/re/pat.t
-----------------------------------------------------------------------
Summary of changes:
op.c | 2 +-
pod/perldelta.pod | 16 ++++++++++++++--
regexec.c | 3 +++
t/re/pat.t | 11 ++++++++++-
4 files changed, 28 insertions(+), 4 deletions(-)
diff --git a/op.c b/op.c
index 68d058e..5c67db2 100644
--- a/op.c
+++ b/op.c
@@ -675,7 +675,7 @@ S_op_destroy(pTHX_ OP *o)
/*
=for apidoc Am|void|op_free|OP *o
-Frees an op when it no longer linked in any optree.
+Frees an op when it is no longer linked in any optree.
=cut
*/
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index ac1cd11..cf78e26 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -43,6 +43,16 @@ written for platforms that support locales can run on
locale-less
platforms without change. Attempts to change the locale away from the
"C" locale will, of course, fail.
+=head2 PERL_DEBUG_READONLY_COW
+
+On some operating systems Perl can be compiled in such a way that any
+attempt to modify string buffers shared by multiple SVs will crash. This
+way XS authors can test that their modules handle copy-on-write scalars
+correctly. See L<perlguts/"Copy on Write"> for detail.
+
+This feature was actually added in 5.19.8, but was unintentionally omitted
+from its delta document.
+
=head1 Security
XXX Any security-related notices go here. In particular, any security
@@ -180,13 +190,15 @@ XXX Changes which significantly change existing files in
F<pod/> go here.
However, any changes to F<pod/perldiag.pod> should go in the L</Diagnostics>
section.
-=head3 L<XXX>
+=head3 L<perlguts>
=over 4
=item *
-XXX Description of the change here
+New sections on L<Read-Only Values|perlguts/"Read-Only Values"> and
+L<Copy on Write|perlguts/"Copy on Write"> have been added. They were
+actually added in 5.19.8 but accidentally omitted from its delta document.
=back
diff --git a/regexec.c b/regexec.c
index 0f6805b..ffa3b0c 100644
--- a/regexec.c
+++ b/regexec.c
@@ -3749,6 +3749,9 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos,
regnode *prog)
GET_RE_DEBUG_FLAGS_DECL;
#endif
+ /* protect against undef(*^R) */
+ SAVEFREESV(SvREFCNT_inc_simple_NN(oreplsv));
+
/* shut up 'may be used uninitialized' compiler warnings for dMULTICALL */
multicall_oldcatch = 0;
multicall_cv = NULL;
diff --git a/t/re/pat.t b/t/re/pat.t
index d875ea6..b53853b 100644
--- a/t/re/pat.t
+++ b/t/re/pat.t
@@ -20,7 +20,7 @@ BEGIN {
require './test.pl';
}
-plan tests => 710; # Update this when adding/deleting tests.
+plan tests => 711; # Update this when adding/deleting tests.
run_tests() unless caller;
@@ -1485,6 +1485,15 @@ EOP
*^R = *caretRglobwithnoscalar;
"" =~ /(?{42})/;
is $^R, 42, 'assigning to *^R does not result in a crash';
+ is runperl(
+ stderr => 1,
+ prog => 'eval q|'
+ .' q-..- =~ /(??{undef *^R;q--})(?{42})/; '
+ .' print qq-$^R\n-'
+ .'|'
+ ),
+ "42\n",
+ 'undefining *^R within (??{}) does not result in a crash';
}
{
--
Perl5 Master Repository
