This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
$tied =~ s///e when FETCH returns a COW
authorFather Chrysostomos <sprout@cpan.org>
Fri, 2 Dec 2011 21:04:41 +0000 (13:04 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Fri, 2 Dec 2011 21:25:19 +0000 (13:25 -0800)
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.

pp_ctl.c
t/re/subst.t

index 2d93cc1..8e91ebd 100644 (file)
--- 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);
                }
index ae0fe3a..8fa649d 100644 (file)
@@ -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")