s///r leaks like a sieve

2 files changed, 7 insertions, 2 deletions

diff --git a/pp_hot.c b/pp_hot.c
index 7f80fa5296..a3fea5ca7a 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2120,7 +2120,7 @@ PP(pp_subst)
     /* In non-destructive replacement mode, duplicate target scalar so it
      * remains unchanged. */
     if (rpm->op_pmflags & PMf_NONDESTRUCT)
-	TARG = newSVsv(TARG);
+	TARG = sv_2mortal(newSVsv(TARG));
 
 #ifdef PERL_OLD_COPY_ON_WRITE
     /* Awooga. Awooga. "bool" types that are actually char are dangerous,
diff --git a/t/re/subst.t b/t/re/subst.t
index cb43510d31..8ea53a2f4a 100644
--- a/t/re/subst.t
+++ b/t/re/subst.t
@@ -7,7 +7,7 @@ BEGIN {
 }
 
 require './test.pl';
-plan( tests => 172 );
+plan( tests => 174 );
 
 # Stolen from re/ReTest.pl. Can't just use the file since it doesn't support
 # like() and it conflicts with test.pl
@@ -88,6 +88,11 @@ ok( defined tied($m), 's///r magic isn\'t lost' );
 $b = $m =~ s/xxx/yyy/r;
 ok( ! defined tied($b), 's///r magic isn\'t contagious' );
 
+my $ref = \("aaa" =~ s/aaa/bbb/r);
+is (Internals::SvREFCNT($$ref), 1, 's///r does not leak');
+$ref = \("aaa" =~ s/aaa/bbb/rg);
+is (Internals::SvREFCNT($$ref), 1, 's///rg does not leak');
+
 $x = 'foo';
 $_ = "x";
 s/x/\$x/;