From: Nicholas Clark <nick@ccl4.org>
Date: Tue, 25 Mar 2003 22:59:17 +0000 (+0000)
Subject: Re: [perl #21614] 5.8.0 Unbalanced string table refcount
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=10bcdfd6e8d70ea5a2c02616001cf97fce7f3e17;p=p5sagit%2Fp5-mst-13.2.git

Re: [perl #21614] 5.8.0 Unbalanced string table refcount
Message-ID: <20030325225917.GE284@Bagpuss.unfortu.net>

p4raw-id: //depot/perl@19069
---

diff --git a/sv.c b/sv.c
index 4f6d59c..a1b44cf 100644
--- a/sv.c
+++ b/sv.c
@@ -1585,8 +1585,15 @@ Perl_sv_grow(pTHX_ register SV *sv, register STRLEN newlen)
 	    newlen = 0xFFFF;
 #endif
     }
-    else
+    else {
+	/* This is annoying, because sv_force_normal_flags will fix the flags,
+	   recurse into sv_grow to malloc a buffer of SvCUR(sv) + 1, then
+	   return back to us, only for us to potentially realloc the buffer.
+	*/
+	if (SvIsCOW(sv))
+	    sv_force_normal_flags(sv, 0);
 	s = SvPVX(sv);
+    }
 
     if (newlen > SvLEN(sv)) {		/* need more room? */
 	if (SvLEN(sv) && s) {
@@ -4448,11 +4455,11 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags)
 	    char *pvx = SvPVX(sv);
 	    STRLEN len = SvCUR(sv);
             U32 hash   = SvUVX(sv);
+	    SvFAKE_off(sv);
+	    SvREADONLY_off(sv);
 	    SvGROW(sv, len + 1);
 	    Move(pvx,SvPVX(sv),len,char);
 	    *SvEND(sv) = '\0';
-	    SvFAKE_off(sv);
-	    SvREADONLY_off(sv);
 	    unsharepvn(pvx, SvUTF8(sv) ? -(I32)len : len, hash);
 	}
 	else if (PL_curcop != &PL_compiling)
diff --git a/t/op/readline.t b/t/op/readline.t
index 1bc9ef4..8936022 100644
--- a/t/op/readline.t
+++ b/t/op/readline.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 3;
+plan tests => 5;
 
 eval { for (\2) { $_ = <FH> } };
 like($@, 'Modification of a read-only value attempted', '[perl #19566]');
@@ -18,3 +18,12 @@ like($@, 'Modification of a read-only value attempted', '[perl #19566]');
   is($a .= <A>, 4, '#21628 - $a .= <A> , A closed');
   unlink "a";
 }
+
+# 82 is chosen to exceed the length for sv_grow in do_readline (80)
+foreach my $k ('k', 'k'x82) {
+  my $result
+    = runperl (switches => '-l', stdin => '', stderr => 1,
+	       prog => "%a = qw($k v); \$_ = <> foreach keys %a; print qw(end)",
+	      );
+  is ($result, "end", '[perl #21614] for length ' . length $k);
+}