Change 19069 by [EMAIL PROTECTED] on 2003/03/26 21:14:33
Subject: [PATCH] Re: [perl #21614] 5.8.0 Unbalanced string table refcount
From: Nicholas Clark <[EMAIL PROTECTED]>
Date: Tue, 25 Mar 2003 22:59:17 +0000
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/sv.c#645 edit
... //depot/perl/t/op/readline.t#3 edit
Differences ...
==== //depot/perl/sv.c#645 (text) ====
Index: perl/sv.c
--- perl/sv.c#644~18954~ Wed Mar 12 02:59:03 2003
+++ perl/sv.c Wed Mar 26 13:14:33 2003
@@ -1585,8 +1585,15 @@
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 @@
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)
==== //depot/perl/t/op/readline.t#3 (text) ====
Index: perl/t/op/readline.t
--- perl/t/op/readline.t#2~19039~ Thu Mar 20 14:40:38 2003
+++ perl/t/op/readline.t Wed Mar 26 13:14:33 2003
@@ -6,7 +6,7 @@
require './test.pl';
}
-plan tests => 3;
+plan tests => 5;
eval { for (\2) { $_ = <FH> } };
like($@, 'Modification of a read-only value attempted', '[perl #19566]');
@@ -17,4 +17,13 @@
close A; $a = 4;
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);
}
End of Patch.
