diff options
| author | Nicholas Clark <nick@ccl4.org> | 2003-03-25 22:59:17 +0000 |
|---|---|---|
| committer | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2003-03-26 21:14:33 +0000 |
| commit | 10bcdfd6e8d70ea5a2c02616001cf97fce7f3e17 (patch) | |
| tree | c819b0996ea7f237b1a6b5c030f62b61d5aa21a5 | |
| parent | 83cd6e83f6f67657e252f6e633e259439425d98a (diff) | |
| download | perl-10bcdfd6e8d70ea5a2c02616001cf97fce7f3e17.tar.gz | |
Re: [perl #21614] 5.8.0 Unbalanced string table refcount
Message-ID: <20030325225917.GE284@Bagpuss.unfortu.net>
p4raw-id: //depot/perl@19069
| -rw-r--r-- | sv.c | 13 | ||||
| -rw-r--r-- | t/op/readline.t | 11 |
2 files changed, 20 insertions, 4 deletions
@@ -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 1bc9ef44f7..8936022b2e 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); +} |