In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/6fc2092288e8c25cd8ecb2c6139053f89a23e49a?hp=4b476daa33ccf495c0ac155bb4ee5f77e349cb95>
- Log ----------------------------------------------------------------- commit 6fc2092288e8c25cd8ecb2c6139053f89a23e49a Author: Father Chrysostomos <[email protected]> Date: Fri Dec 2 13:04:41 2011 -0800 $tied =~ s///e when FETCH returns a COW This used to cause an assertion failure, or sometimes âAttempt to free nonexistent shared stringâ. All that was required to fix it was the deletion of two cpp lines. ----------------------------------------------------------------------- Summary of changes: pp_ctl.c | 2 -- t/re/subst.t | 11 ++++++++++- 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/pp_ctl.c b/pp_ctl.c index 2d93cc1..8e91ebd 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -328,11 +328,9 @@ PP(pp_substcont) targ = dstr; } else { -#ifdef PERL_OLD_COPY_ON_WRITE if (SvIsCOW(targ)) { sv_force_normal_flags(targ, SV_COW_DROP_PV); } else -#endif { SvPV_free(targ); } diff --git a/t/re/subst.t b/t/re/subst.t index ae0fe3a..8fa649d 100644 --- a/t/re/subst.t +++ b/t/re/subst.t @@ -7,7 +7,7 @@ BEGIN { } require './test.pl'; -plan( tests => 188 ); +plan( tests => 189 ); $_ = 'david'; $a = s/david/rules/r; @@ -790,3 +790,12 @@ fresh_perl_is( '$_="abcef"; s/bc|(.)\G(.)/$1 ? "[$1-$2]" : "XX"/ge; print' => 'a is(*bam =~ s/\*//r, 'main::bam', 'Can s///r a tyepglob'); is(*bam =~ s/\*//rg, 'main::bam', 'Can s///rg a tyepglob'); + +{ + sub cowBug::TIESCALAR { bless[], 'cowBug' } + sub cowBug::FETCH { __PACKAGE__ } + sub cowBug::STORE{} + tie my $kror, cowBug =>; + $kror =~ s/(?:)/""/e; +} +pass("s/// on tied var returning a cow") -- Perl5 Master Repository
