p5pRT commented 21 years ago

Migrated from rt.perl.org#21614 (status was 'resolved')

Searchable as RT21614$

p5pRT commented 21 years ago

From Paul@dyerhouse.com

Hi\,

This happened on Perl 5.8.0\, RedHat 8.0. Here is a code fragment that produces the error listed below it:

use IO::File (); local $/;

foreach (sort keys %altnames) { my $fh = IO::File->new; my ($hr_title) = m/(.*)\.txt/; print("\

\

$hr_title \

\n"); my $source = join '/'\, $dir\, $_; $fh->open($source); while (\<$fh>) { print($_); } $fh->close; }

I have found that I get the error even for one loop. I inserted "last;" just after the close to test.

If I comment the print($_) statement\, I still get the error.

If I comment the "while (\<$fh>)" loop entirely\, the errors go away!!

Here is the error log:

Unbalanced string table refcount: (1) for "Oracle.txt" during global destruction.

I was able to correct the error by using a lexical variable in the outer loop\, thus avoiding the $_ variable at 2 levels.

my $fh = IO::File->new;

foreach* my $file* (sort keys %altnames) { # insert each file into an IMG tag my ($hr_title) = ( $file =~ m/(.*)\.txt/ ); print "\

\

$hr_title \

\n"; unless ($fh->open("$dir/$file")) { $r->log_error("Couldn't open $dir/$file for reading: $!"); return SERVER_ERROR; } while (\<$fh>) { # read the text files with IMG tags. print; } $fh->close; }

p5pRT commented 21 years ago

From @rgs

Paul Dyer (via RT) wrote:

This happened on Perl 5.8.0\, RedHat 8.0. Here is a code fragment that produces the error listed below it:

I can't reproduce this. Is your code fragment sufficient ? I don't see a definition of %altnames.

There have been reports of problems due to UTF8 locales\, notably under RedHat 8.0. What's your locale ? Does the problem run away when you run your script under the C locale ?

p5pRT commented 21 years ago

From Paul@dyerhouse.com

Rafael Garcia-Suarez (via RT) wrote:

Paul Dyer (via RT) wrote:

This happened on Perl 5.8.0\, RedHat 8.0. Here is a code fragment that produces the error listed below it:

I can't reproduce this. Is your code fragment sufficient ? I don't see a definition of %altnames.

There have been reports of problems due to UTF8 locales\, notably under RedHat 8.0. What's your locale ? Does the problem run away when you run your script under the C locale ?

Hi\,

I'm attaching the whole script. I am running under Apache\, ModPerl.
I used the Apache::File and IO::File modules and got the errors on both.

I am using RedHat 8.0 and 7.3 with the same results. I don't know what the character set is.

Paul

p5pRT commented 21 years ago

From Paul@dyerhouse.com

package MyApache::BookPicture; # ~www/lib/perl/MyApache/BookPicture.pm

use strict; use warnings; use Apache::Constants qw(:common); use DirHandle (); use Apache::File ();

sub handler { my $r = shift;

my $dir_uri = $r->dir_config('PictureDir'); unless ($dir_uri) { $r->log_reason("No PictureDir configured"); return SERVER_ERROR; } $dir_uri .= "/" unless $dir_uri =~ m:/$:;

my $subr = $r->lookup_uri($dir_uri); my $dir = $subr->filename; # Get list of images in the directory. my $dh = DirHandle->new($dir); unless ($dh) { $r->log_error("Can't read directory $dir: $!"); return SERVER_ERROR; }

my @files; my %altnames; for my $entry ($dh->read) { # get the file's MIME type my $rr = $subr->lookup_uri($entry); my $type = $rr->content_type; next unless $type and $type =~ m:^text/:; push @files\, $rr->uri; $altnames{$entry} = $rr->uri; } $dh->close; unless (@files) { $r->log_error("No image files in directory"); return SERVER_ERROR; }

$r->content_type('text/html'); $r->send_http_header; return OK if $r->header_only;

print(\<\<END); \ \ \books\ \ \ \ \ END

my $fh; foreach (sort keys %altnames) { # insert each file into an IMG tag my ($hr_title) = m/(.*)\.txt/; print("\

\

$hr_title \

\n"); my $source = join '/'\, $dir\, $_; unless ($fh = Apache::File->new($source)) { $r->log_error("Couldn't open $source for reading: $!"); return SERVER_ERROR; } while (\<$fh>) { # read the text files with IMG tags. print ; } close $fh; } print("\"); print('\\');

return OK; }

1; __END__

p5pRT commented 21 years ago

From @rgs

Paul Dyer wrote:

I'm attaching the whole script. I am running under Apache\, ModPerl.

It's possible that it's a mod_perl problem. The startup/shutdown process of mod_perl is more complicated than for a standalone perl interpreter.

It's possible also that the problem is not related at all to mod_perl\, but in this case\, to fix it\, it would be handy to be able to replicate it without mod_perl.

Anyway\, the error you're getting is an (undocumented) internal warning that occurs on destruction of a perl interpreter. It's probably harmless.

I used the Apache::File and IO::File modules and got the errors on both.

I am using RedHat 8.0 and 7.3 with the same results. I don't know what the character set is.

The output of the locale command is usually sufficient.

p5pRT commented 21 years ago

From @nwc10

On Wed\, Mar 19\, 2003 at 03:57:21AM -0000\, Paul Dyer wrote:

Here is the error log:

Unbalanced string table refcount: (1) for "Oracle.txt" during global destruction.

On Fri\, Mar 21\, 2003 at 05:52:49PM +0100\, Rafael Garcia-Suarez wrote:

Paul Dyer wrote:

I'm attaching the whole script. I am running under Apache\, ModPerl.

It's possible that it's a mod_perl problem. The startup/shutdown process of mod_perl is more complicated than for a standalone perl interpreter.

It's possible also that the problem is not related at all to mod_perl\, but in this case\, to fix it\, it would be handy to be able to replicate it without mod_perl.

I'll second that. I can't replicate it here with pure perl - I don't have modperl or a UTF8 locale.

Anyway\, the error you're getting is an (undocumented) internal warning that occurs on destruction of a perl interpreter. It's probably harmless.

I'm surprised that there is only 1 error line. I thought that unbalanced string table refcounts usually came in pairs - one was too high\, and another was too low. (effectively a matched set). I wonder if something in the internals is clearing all the flags in $_ at some point\, rather than correctly undef()ing it. In 5.8 keys will generate a list of scalars which point directly to the string table used for hash keys (this is the table that the error message refers to) In turn\, foreach aliases $_ to the items in the list\, so $_ is pointing into the string table. If the internals clear $_ properly\, then the string table reference is tidied up\, and everything balances. But if something (I'm suspicious of the inner foreach) just blasts $_ instead\, then the reference is lost.

I used the Apache::File and IO::File modules and got the errors on both.

I am using RedHat 8.0 and 7.3 with the same results. I don't know what the character set is.

The output of the locale command is usually sufficient.

the output from perl -V would contain it. (plus a lot of other information)

If you're able to make a test case that doesn't need mod_perl that would be really useful. I think that the string table reference counts are only checked on perl compiled with -DDEBUGGING. I presume that the perl you have is\, given that mod_perl is warning. You can check - this perl is suitable:

$ perl5.8.0-32-g -D -e0

EXECUTING...

This perl is not:

$ perl5.8.0 -D -e0 Recompile perl with -DDEBUGGING to use -D switch

Nicholas Clark

p5pRT commented 21 years ago

From @nwc10

OK. My suspicions were wrong\, in that it's not a UTF8 local issue. Also I was wrong in my understanding of the string table - the string table warning occurs independent of -DDEBUGGING

On Sat\, Mar 22\, 2003 at 10:16:17PM -0600\, Paul Dyer wrote:

Here is some feedback\, but not yet a test case w/o modperl:

locale LANG=en_US LC_CTYPE="en_US" LC_NUMERIC="en_US" LC_TIME="en_US" LC_COLLATE="en_US" LC_MONETARY="en_US" LC_MESSAGES="en_US" LC_PAPER="en_US" LC_NAME="en_US" LC_ADDRESS="en_US" LC_TELEPHONE="en_US" LC_MEASUREMENT="en_US" LC_IDENTIFICATION="en_US" LC_ALL=

perl -D -e0 Recompile perl with -DDEBUGGING to use -D switch

On Sat\, Mar 22\, 2003 at 10:45:01PM -0600\, Paul Dyer wrote:

I am attaching an attempt to reproduce the error w/o modperl. I used almost the same code\, removing all the apache stuff. Sorry\, but I don't get the error. I checked my httpd compile. On this machine\, RedHat 8.0\, mod_perl.c is static. On the other RedHat machine\, mod_perl.c is a dso and the character set is en_US.iso885915. Paul

#!/usr/local/bin/perl -w # ~www/lib/perl/MyApache/BookPicture.pm

use strict; use warnings; use DirHandle (); use IO::File ();
my $r = shift;

my $dir = "/usr/local/apache/htdocs/mercury/pictures/Books";

\# Get list of images in the directory\.
my $dh = DirHandle\->new$$dir$;
unless $$dh$ \{
print$"Can't read directory $dir&#8203;: $\!"$;
exit 0;
\}

my @&#8203;files;
my %altnames;
for my $entry $$dh\->read$ \{
    next unless $ $entry =~ m/\(\.\*$\\\.txt/ \);
push @&#8203;files\, $entry;
$altnames\{$entry\} = $entry;
\}
$dh\->close;
unless $@&#8203;files$ \{
print$"No image files in directory"$;
exit 0;
\}

my $fh;
foreach $sort keys %altnames$ \{ \# insert each file into an IMG tag
  my $$hr\_title$ = m/$\.\*$\\\.txt/;
  print$"\<hr>\<h1 align=center> $hr\_title \</h1>\\n"$;
  my $source = join '/'\, $dir\, $\_;
  unless $$fh = IO&#8203;::File\->new\($source$\) \{
     print$"Couldn't open $source for reading&#8203;: $\!"$;
     exit 0;
     \}
  while $\<$fh>$ \{ \# read the text files with IMG tags\.
      print ;
      \}
  close $fh;
  \}
print$"\<\!\-\-\#FOOTER \-\->"$;
print$'\</BODY>\</HTML>'$;
exit 1;

When I run that test code under valgrind (on x86 Debian)\, with $dir changed to a directory containing 1 file\, Oracle.txt\, with 1 line "Hello World" I see memory access errors:

$ valgrind ./perl -I lib BookPicture.pl ==22221== valgrind-1.0.4\, a memory error detector for x86 GNU/Linux. ==22221== Copyright (C) 2000-2002\, and GNU GPL'd\, by Julian Seward. ==22221== Estimated CPU clock rate is 262 MHz ==22221== For more details\, rerun with: -v ==22221== ==22221== Invalid read of size 4 ==22221== at 0x808CE25: Perl_pad_allocmy (/home/nick/5.8.0-i-g/op.c:217) ==22221== by 0x807FF08: S_pending_ident (/home/nick/5.8.0-i-g/toke.c:5224) ==22221== by 0x80716CB: Perl_yylex (/home/nick/5.8.0-i-g/toke.c:2201) ==22221== by 0x80894E9: Perl_yyparse (/home/nick/5.8.0-i-g/perly.c:1470) ==22221== Address 0x40BFC510 is 0 bytes after a block of size 1008 alloc'd ==22221== at 0x4003D78E: malloc (vg_clientfuncs.c:100) ==22221== by 0x80B80C8: Perl_safesysmalloc (/home/nick/5.8.0-i-g/util.c:78) ==22221== by 0x80DD3F7: S_more_xpv (/home/nick/5.8.0-i-g/sv.c:740) ==22221== by 0x80DD32D: S_new_xpv (/home/nick/5.8.0-i-g/sv.c:715) ==22221== ==22221== Invalid read of size 4 ==22221== at 0x808CE33: Perl_pad_allocmy (/home/nick/5.8.0-i-g/op.c:217) ==22221== by 0x807FF08: S_pending_ident (/home/nick/5.8.0-i-g/toke.c:5224) ==22221== by 0x80716CB: Perl_yylex (/home/nick/5.8.0-i-g/toke.c:2201) ==22221== by 0x80894E9: Perl_yyparse (/home/nick/5.8.0-i-g/perly.c:1470) ==22221== Address 0x40BFC510 is 0 bytes after a block of size 1008 alloc'd ==22221== at 0x4003D78E: malloc (vg_clientfuncs.c:100) ==22221== by 0x80B80C8: Perl_safesysmalloc (/home/nick/5.8.0-i-g/util.c:78) ==22221== by 0x80DD3F7: S_more_xpv (/home/nick/5.8.0-i-g/sv.c:740) ==22221== by 0x80DD32D: S_new_xpv (/home/nick/5.8.0-i-g/sv.c:715) ==22221== ==22221== pthread_mutex_destroy: mutex is still in use ==22221== at 0x40273C90: pthread_error (vg_libpthread.c:275) ==22221== by 0x40274BB4: __pthread_mutex_destroy (vg_libpthread.c:952) ==22221== by 0x403202E9: (within /lib/libc-2.3.1.so) ==22221== by 0x81266C6: Perl_pp_closedir (/home/nick/5.8.0-i-g/pp_sys.c:3925) \

\

Oracle \

Hello World valgrind's libpthread.so: KLUDGED call to: siglongjmp (cleanup handlers are ignored) valgrind's libpthread.so: KLUDGED call to: pthread_cond_destroy \\\==22221== ==22221== ERROR SUMMARY: 9 errors from 3 contexts (suppressed: 0 from 0) ==22221== malloc/free: in use at exit: 582286 bytes in 12712 blocks. ==22221== malloc/free: 23363 allocs\, 10651 frees\, 1128739 bytes allocated. ==22221== For a detailed leak analysis\, rerun with: --leak-check=yes ==22221== For counts of detected errors\, rerun with: -v

Running with maintperl (5.8.1 to be) or bleadperl (the current development snapshot) valgrind reports no memory errors. So there does seem to be a bug in 5.8.0\, and it seems to have been fixed for 5.8.1 However\, I can't be sure if this illegal memory access is actually the same bug as you're seeing. I'm a bit confused by all this\, because valgrind seems to be reporting errors in the pad code\, and pads have been substantially reworked for bleadperl\, but not maintperl. Hence I'm surprised that the bug seems to be fixed in both branches\, given that the implementation differs.

I don't know if it's possible to run mod_perl under valgrind\, to see if these memory errors correlate with what you see there.

Nicholas Clark

p5pRT commented 21 years ago

From @rgs

Nicholas Clark wrote:

I don't know if it's possible to run mod_perl under valgrind\, to see if these memory errors correlate with what you see there.

Run apache in single process mode :

$ valgrind httpd -X

p5pRT commented 21 years ago

From @nwc10

On Sun\, Mar 23\, 2003 at 05:59:59PM +0000\, Nicholas Clark wrote:

OK. My suspicions were wrong\, in that it's not a UTF8 local issue. Also I was wrong in my understanding of the string table - the string table warning occurs independent of -DDEBUGGING

However\, I can't be sure if this illegal memory access is actually the same bug as you're seeing. I'm a bit confused by all this\, because valgrind seems to be reporting errors in the pad code\, and pads have been substantially reworked for bleadperl\, but not maintperl. Hence I'm surprised that the bug seems to be fixed in both branches\, given that the implementation differs.

It's probably a different bug you're seeing. I suspect it's the same as this bug:

$ ./perl -Ilib -lwe '%hash = ("perl"=>"rules"); foreach (sort keys %hash) {while (\<>) {}}' Segmentation fault (core dumped)

(for -DPERL_COPY_ON_WRITE)

I'm not quite sure what the correct fix is. The problem is that do_readline calls Sv_Grow

tmplen = SvLEN(sv); /* remember if already alloced */ if (!tmplen) Sv_Grow(sv\, 80); /* try short-buffering it */

SvLEN() is 0 for a shared hash key scalar\, so the if is true.

sv_grow ends up in this else block:

else { New(703\, s\, newlen\, char); if (SvPVX(sv) && SvCUR(sv)) { Move(SvPVX(sv)\, s\, (newlen \< SvCUR(sv)) ? newlen : SvCUR(sv)\, char); } } SvPV_set(sv\, s); SvLEN_set(sv\, newlen);

and at the end of that the shared hash key scalar:

SV = PVIV(0x812f820) at 0x812f15c REFCNT = 2 FLAGS = (POK\,FAKE\,READONLY\,pPOK) UV = 3023084856 (HASH) PV = 0x812e3a8 "perl" CUR = 4 LEN = 0

becomes the (incorrect)

SV = PVIV(0x812f820) at 0x812f15c REFCNT = 2 FLAGS = (POK\,FAKE\,READONLY\,pPOK) UV = 3023084856 (COW from 0xb4309d38) PV = 0x8130180 "perl" CUR = 4 LEN = 80

(FAKE and READONLY should be off)

I'm not sure how to solve this. The correct thing to do would be to call force_normal from sv_grow (if needed). But force_normal will allocate a minimally sized buffer using malloc()\, only for sv_grow to want to extend it again. And I'm loathe to duplicate the un-COW logic into sv_grow.

But it would explain how the warning about unbalanced string tables. (Even for 5.8.0\, which can't do copy on write)

Nicholas Clark

p5pRT commented 21 years ago

From @iabyn

On Sun\, Mar 23\, 2003 at 05:59:59PM +0000\, Nicholas Clark wrote:

However\, I can't be sure if this illegal memory access is actually the same bug as you're seeing. I'm a bit confused by all this\, because valgrind seems to be reporting errors in the pad code\, and pads have been substantially reworked for bleadperl\, but not maintperl. Hence I'm surprised that the bug seems to be fixed in both branches\, given that the implementation differs.

Most of my pad patches have recently been integrated into maintperl. (Jarkko is either very wise or insane (or both).)

-- Blaming Islam for 911 is like blaming Christianity for Oklahoma City.

p5pRT commented 21 years ago

From @nwc10

On Sun\, Mar 23\, 2003 at 05:59:59PM +0000\, Nicholas Clark wrote:

Running with maintperl (5.8.1 to be) or bleadperl (the current development snapshot) valgrind reports no memory errors. So there does seem to be a bug in 5.8.0\, and it seems to have been fixed for 5.8.1 However\, I can't be sure if this illegal memory access is actually the same bug as you're seeing. I'm a bit confused by all this\, because valgrind

It's not. It can be repeated on a debugging 5.8.0 like this:

$ echo | PERL_DESTRUCT_LEVEL=2 perl5.8.0-32-g -lwe '%a= qw(k v); foreach (keys %a) {$_ = \<>;}' Unbalanced string table refcount: (1) for "k" during global destruction.

It's present in maint:

nick@penfold:\~/19053-g$ echo | PERL_DESTRUCT_LEVEL=2 ./perl -lwe '%a= qw(k v); foreach (keys %a) {$_ = \<>;}' Assertion !((sv)->sv_flags & 0x00800000) failed: file "pp_hot.c"\, line 1528 at -e line 1.

It's fixed in blead for the normal case (not copy on write)\, but not for copy on write. The code paths in Perl_sv_force_normal_flags are completely different depending on whether perl is built with copy on write

How does one write a regression test to check for lack of warnings? Make a new perl and check that STDERR is empty?

Nicholas Clark

p5pRT commented 21 years ago

From @rgs

Nicholas Clark \nick@unfortu\.net wrote:

It's fixed in blead for the normal case (not copy on write)\, but not for copy on write. The code paths in Perl_sv_force_normal_flags are completely different depending on whether perl is built with copy on write

It produces a segfault here\, not a warning.

#0 0x80df23b in S_sv_release_COW (sv=0x8189604\, pvx=0x8197bf0 "k\r\024@ð\r\024@"\, cur=1\, len=80\, hash=2150891594\, after=0x8034004a) at sv.c:4353 4353 SV *current = SV_COW_NEXT_SV(after);

How does one write a regression test to check for lack of warnings? Make a new perl and check that STDERR is empty?

Adding it to t/lib/warnings/perl should be sufficient ? the "Unbalanced string table refcount" is marked TODO here.

p5pRT commented 21 years ago

From @nwc10

On Tue\, Mar 25\, 2003 at 09:56:03AM +0100\, Rafael Garcia-Suarez wrote:

Nicholas Clark \nick@unfortu\.net wrote:

It's fixed in blead for the normal case (not copy on write)\, but not for copy on write. The code paths in Perl_sv_force_normal_flags are completely different depending on whether perl is built with copy on write

It produces a segfault here\, not a warning.

#0 0x80df23b in S_sv_release_COW (sv=0x8189604\, pvx=0x8197bf0 "k\r\024@ð\r\024@"\, cur=1\, len=80\, hash=2150891594\, after=0x8034004a) at sv.c:4353 4353 SV *current = SV_COW_NEXT_SV(after);

That's for copy on write? That's what I see for copy on write. IIRC it's a warning on 5.8.0\, an assertion failure on maint\, a SEGV on blead with COW\, and seemingly clean on blead without COW. However\, I'm not convinced that it's actually doing the right thing on blead without COW. I think it's more chance\, and down to how sv_grow and related functions were re-written.

I'll need to think about it some more when I get home.

How does one write a regression test to check for lack of warnings? Make a new perl and check that STDERR is empty?

Adding it to t/lib/warnings/perl should be sufficient ? the "Unbalanced string table refcount" is marked TODO here.

Except that I'm trying to test that there's no warning issued for a known problem case. So I don't think that putting it in the warnings test is the right place.

It's somewhat difficult to write a correct warnings test for "Unbalanced string table refcount" given that any that show up are bugs that need fixing. Unless we deliberately write some XS.

Nicholas Clark

p5pRT commented 21 years ago

From @nwc10

On Tue\, Mar 25\, 2003 at 09:06:08AM +0000\, Nicholas Clark wrote:

That's for copy on write? That's what I see for copy on write. IIRC it's a warning on 5.8.0\, an assertion failure on maint\, a SEGV on blead

er\, I should be more careful. My copy of "maint" had 1 line added; an assertion.

Except that I'm trying to test that there's no warning issued for a known problem case. So I don't think that putting it in the warnings test is the right place.

I think that the appended works. The test fails on 5.8.0 and unpatched blead. It passes on blead with and without COW. It doubt that the sv.c patch will apply to maint because the code's been moved around quite a bit.

I'm not convinced that it's the cleanest logic yet. I think that it would actually be better to move the sv_release_COW() call from sv_force_normal_flags into sv_grow. (Which is actually back close to 5.8.0) This way for this case sv_grow gets to call malloc once with the correct size. Also it means that most third party XS code doesn't need to be aware of copy on write - if it happens to call SvGROW to ensure that a buffer is large enough before writing to it\, then it would automatically do the copy.

Nicholas Clark

Inline Patch

```diff --- t/op/readline.t.orig Thu Mar 20 23:53:46 2003 +++ t/op/readline.t Tue Mar 25 22:17:42 2003 @@ -6,7 +6,7 @@ BEGIN { require './test.pl'; } -plan tests => 3; +plan tests => 5; eval { for (\2) { $_ = } }; like($@, 'Modification of a read-only value attempted', '[perl #19566]'); @@ -17,4 +17,13 @@ like($@, 'Modification of a read-only va close A; $a = 4; is($a .= , 4, '#21628 - $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); } --- ../s19055/sv.c Wed Mar 12 12:11:43 2003 +++ sv.c Tue Mar 25 22:16:49 2003 @@ -1585,8 +1585,15 @@ Perl_sv_grow(pTHX_ register SV *sv, regi 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_ registe 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) ```

p5pRT commented 21 years ago

From @rgs

Nicholas Clark wrote:

I think that the appended works. The test fails on 5.8.0 and unpatched blead. It passes on blead with and without COW. It doubt that the sv.c patch will apply to maint because the code's been moved around quite a bit.

Anyway\, thanks\, applied as #19069 to bleadperl.

I'm not convinced that it's the cleanest logic yet. I think that it would actually be better to move the sv_release_COW() call from sv_force_normal_flags into sv_grow. (Which is actually back close to 5.8.0) This way for this case sv_grow gets to call malloc once with the correct size. Also it means that most third party XS code doesn't need to be aware of copy on write - if it happens to call SvGROW to ensure that a buffer is large enough before writing to it\, then it would automatically do the copy.

BTW I notice that SvIsCOW is not documented in perlapi.pod. That's un-nice.

p5pRT commented 21 years ago

From @nwc10

On Wed\, Mar 26\, 2003 at 11:30:05PM +0100\, Rafael Garcia-Suarez wrote:

Nicholas Clark wrote:

I think that the appended works. The test fails on 5.8.0 and unpatched blead. It passes on blead with and without COW. It doubt that the sv.c patch will apply to maint because the code's been moved around quite a bit.

Anyway\, thanks\, applied as #19069 to bleadperl.

Oh er erk. I've been working on a better one\, which is tested\, and I don't have time to resync to 19069 and then retry. Would it be possible to revert 19069 and apply the appended to blead. The first two hunks (readline.t and pp_hot.c apply to maint. Without the pp_hot.c fix maint goes:

$ PERL_DESTRUCT_LEVEL=2 ./perl /stuff/blead/19055-g/t/op/readline.t 1..11 ok 1 - [perl \#19566] ok 2 - \#21628 - $a .= \ \, A eof ok 3 - \#21628 - $a .= \ \, A closed not ok 4 - [perl \#21614] for length 1 # Failed at /stuff/blead/19055-g/t/op/readline.t line 28 # got 'endUnbalanced string table refcount: (1) for "k" during global destruction. # ' # expected 'end' not ok 5 - [perl \#21614] for length 82 # Failed at /stuff/blead/19055-g/t/op/readline.t line 28 # got 'endUnbalanced string table refcount: (1) for "kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" during global destruction. # ' # expected 'end' not ok 6 - rcatline to shared sv for length 4 # Failed at /stuff/blead/19055-g/t/op/readline.t line 37 # got 'perl rulesUnbalanced string table refcount: (1) for "perl" during global destruction. # ' # expected 'perl rules' not ok 7 - rcatline to shared sv for length 84 # Failed at /stuff/blead/19055-g/t/op/readline.t line 37 # got 'perlperlperlperlperlperlperlperlperlperlperlperlperlperlperlperlperlperlperlperl rulesUnbalanced string table refcount: (1) for "perlperlperlperlperlperlperlperlperlperlperlperlperlperlperlperlperlperlperlperlperl" during global destruction. # ' # expected 'perlperlperlperlperlperlperlperlperlperlperlperlperlperlperlperlperlperlperlperlperl rules' ok 8 - catline to COW sv for length 1 ok 9 - catline to COW sv for length 82 ok 10 - rcatline to COW sv for length 4 ok 11 - rcatline to COW sv for length 84

)

BTW I notice that SvIsCOW is not documented in perlapi.pod. That's un-nice.

I won't manage that tonight - I'm about to go to bed.

Nicholas Clark

Inline Patch

```diff --- t/op/readline.t.orig Thu Mar 20 23:53:46 2003 +++ t/op/readline.t Wed Mar 26 21:28:07 2003 @@ -6,7 +6,7 @@ BEGIN { require './test.pl'; } -plan tests => 3; +plan tests => 11; eval { for (\2) { $_ = } }; like($@, 'Modification of a read-only value attempted', '[perl #19566]'); @@ -18,3 +18,43 @@ like($@, 'Modification of a read-only va is($a .= , 4, '#21628 - $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); +} + + +foreach my $k ('perl', 'perl'x21) { + my $result + = runperl (switches => '-l', stdin => ' rules', stderr => 1, + prog => "%a = qw($k v); foreach (keys %a) {\$_ .= <>; print}", + ); + is ($result, "$k rules", 'rcatline to shared sv for length ' . length $k); +} + +foreach my $l (1, 82) { + my $k = $l; + $k = 'k' x $k; + my $copy = $k; + $k = ; + is ($k, "moo\n", 'catline to COW sv for length ' . length $copy); +} + + +foreach my $l (1, 21) { + my $k = $l; + $k = 'perl' x $k; + my $perl = $k; + $k .= ; + is ($k, "$perl rules\n", 'rcatline to COW sv for length ' . length $perl); +} +__DATA__ +moo +moo + rules + rules --- pp_hot.c.orig Thu Mar 20 23:53:46 2003 +++ pp_hot.c Wed Mar 26 22:08:59 2003 @@ -1509,7 +1509,7 @@ Perl_do_readline(pTHX) sv_unref(sv); (void)SvUPGRADE(sv, SVt_PV); tmplen = SvLEN(sv); /* remember if already alloced */ - if (!tmplen) + if (!tmplen && !SvREADONLY(sv)) Sv_Grow(sv, 80); /* try short-buffering it */ offset = 0; if (type == OP_RCATLINE && SvOK(sv)) { --- sv.c.orig Wed Mar 12 12:11:43 2003 +++ sv.c Wed Mar 26 22:09:47 2003 @@ -4448,11 +4448,11 @@ Perl_sv_force_normal_flags(pTHX_ registe 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) @@ -6289,7 +6289,8 @@ Perl_sv_gets(pTHX_ register SV *sv, regi I32 rspara = 0; I32 recsize; - SV_CHECK_THINKFIRST_COW_DROP(sv); + if (SvTHINKFIRST(sv)) + sv_force_normal_flags(sv, append ? 0 : SV_COW_DROP_PV); /* XXX. If you make this PVIV, then copy on write can copy scalars read from <>. However, perlbench says it's slower, because the existing swipe code ```

p5pRT commented 21 years ago

From @rgs

Nicholas Clark wrote:

On Wed\, Mar 26\, 2003 at 11:30:05PM +0100\, Rafael Garcia-Suarez wrote:

Nicholas Clark wrote:

I think that the appended works. The test fails on 5.8.0 and unpatched blead. It passes on blead with and without COW. It doubt that the sv.c patch will apply to maint because the code's been moved around quite a bit.

Anyway\, thanks\, applied as #19069 to bleadperl.

Oh er erk. I've been working on a better one\, which is tested\, and I don't have time to resync to 19069 and then retry. Would it be possible to revert 19069 and apply the appended to blead.

Yup\, it's possible. Thanks\, applied as #19071.

p5pRT commented 21 years ago

From @nwc10

On Tue\, Mar 25\, 2003 at 10:59:17PM +0000\, Nicholas Clark wrote:

I'm not convinced that it's the cleanest logic yet. I think that it would actually be better to move the sv_release_COW() call from sv_force_normal_flags into sv_grow. (Which is actually back close to 5.8.0) This way for this case sv_grow gets to call malloc once with the correct size. Also it means that most third party XS code doesn't need to be aware of copy on write - if it happens to call SvGROW to ensure that a buffer is large enough before writing to it\, then it would automatically do the copy.

I can't see a clean way to do this. (which is annoying). It's do-able\, but it looks like it will add two bursts of checking for COW for every call to SvGROW

On Thu\, Mar 27\, 2003 at 12:21:39AM +0100\, Rafael Garcia-Suarez wrote:

Nicholas Clark wrote:

Oh er erk. I've been working on a better one\, which is tested\, and I don't have time to resync to 19069 and then retry. Would it be possible to revert 19069 and apply the appended to blead.

Yup\, it's possible. Thanks\, applied as #19071.

Thanks

On Wed\, Mar 26\, 2003 at 11:30:05PM +0100\, Rafael Garcia-Suarez wrote:

BTW I notice that SvIsCOW is not documented in perlapi.pod. That's un-nice.

Is this suitable?

Nicholas Clark

Inline Patch

```diff --- sv.h.orig Tue Mar 11 19:29:28 2003 +++ sv.h Thu Mar 27 22:28:53 2003 @@ -920,6 +920,14 @@ Like C, but converts sv to byte re Guarantees to evaluate sv only once; use the more efficient C otherwise. +=for apidoc Am|bool|SvIsCOW|SV* sv +Returns a boolean indicating whether the SV is Copy-On-Write. (either shared +hash key scalars, or full Copy On Write scalars if 5.9.0 is configured for +COW) + +=for apidoc Am|bool|SvIsCOW_shared_hash|SV* sv +Returns a boolean indicating whether the SV is Copy-On-Write shared hash key +scalar. =cut */ ```

p5pRT commented 21 years ago

From @rgs

Nicholas Clark wrote:

BTW I notice that SvIsCOW is not documented in perlapi.pod. That's un-nice.

Is this suitable?

Yes : thanks\, applied as #19079.

p5pRT commented 21 years ago

@rspier - Status changed from 'new' to 'resolved'

Perl / perl5

5.8.0 Unbalanced string table refcount #6387

From Paul@dyerhouse.com

$hr_title \

$hr_title \

From @rgs

From Paul@dyerhouse.com

From Paul@dyerhouse.com

$hr_title \

From @rgs

From @nwc10

From @nwc10

Oracle \

From @rgs

From @nwc10

From @iabyn

From @nwc10

From @rgs

From @nwc10

From @nwc10

From @rgs

From @nwc10

From @rgs

From @nwc10

From @rgs