In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/49b69fb3a31122264bea3770d8f9d3e4a1a97186?hp=ad6e49a4fa69a5853518d08234bc05711a6f8bb9>
- Log ----------------------------------------------------------------- commit 49b69fb3a31122264bea3770d8f9d3e4a1a97186 Author: Father Chrysostomos <[email protected]> Date: Mon May 7 20:43:18 2012 -0700 [perl #112780] Donât set cloned in-memory handles to "" PerlIO::scalarâs dup function (PerlIOScalar_dup) calls the base imple- mentation (PerlIOBase_dup), which pushes the scalar layer on to the new file handle. When the scalar layer is pushed, if the mode is ">" then PerlIOScalar_pushed sets the scalar to the empty string. If it is already a string, it does this simply by setting SvCUR to 0, without touching the string buffer. The upshot of this is that newly-cloned in-memory handles turn into the empty string, as in this example: use threads; my $str = ''; open my $fh, ">", \$str; $str = 'a'; async { warn $str; # something's wrong }->join; This has probably always been this way. The test suite for MSCHWERN/Test-Simple-1.005000_005.tar.gz does some- thing similar to this: use threads; my $str = ''; open my $fh, ">", \$str; print $fh "a"; async { print $fh "b"; warn $str; # "ab" expected, but 5.15.7-9 gives "\0b" }->join; What was happening before commit b6597275 was that two bugs were can- celling each other out: $str would be "" when the new thread started, but with a string buffer containing "a" beyond the end of the string and $fh remembering 1 as its position. The bug fixed by b6597275 was that writing past the end of a string through a filehandle was leaving junk (whatever was in memory already) in the intervening space between the old end of string and the beginning of what was being written to the string. This allowed "" to turn magically into "ab" when "b" was written one character past the end of the string. Commit b6597275 started zeroing out the intervening space in that case, causing the cloning bug to rear its head. This commit solves the problem by hiding the scalar temporarily in PerlIOScalar_dup so that PerlIOScalar_pushed wonât be able to modify it. Should PerlIOScalar_pushed stop clobbering the string and should PerlIOScalar_open do it instead? Perhaps. But that would be a bigger change, and we are supposed to be in code freeze right now. M ext/PerlIO-scalar/scalar.xs M ext/PerlIO-scalar/t/scalar.t commit 7a3512a92b1b1f6500737192a26f4f57377e8042 Author: Father Chrysostomos <[email protected]> Date: Mon May 7 14:53:20 2012 -0700 Increase $PerlIO::scalar::VERSION to 0.14 M ext/PerlIO-scalar/scalar.pm ----------------------------------------------------------------------- Summary of changes: ext/PerlIO-scalar/scalar.pm | 2 +- ext/PerlIO-scalar/scalar.xs | 13 +++++++++++-- ext/PerlIO-scalar/t/scalar.t | 16 +++++++++++++++- 3 files changed, 27 insertions(+), 4 deletions(-) diff --git a/ext/PerlIO-scalar/scalar.pm b/ext/PerlIO-scalar/scalar.pm index dac7491..aadfdb6 100644 --- a/ext/PerlIO-scalar/scalar.pm +++ b/ext/PerlIO-scalar/scalar.pm @@ -1,5 +1,5 @@ package PerlIO::scalar; -our $VERSION = '0.13'; +our $VERSION = '0.14'; require XSLoader; XSLoader::load(); 1; diff --git a/ext/PerlIO-scalar/scalar.xs b/ext/PerlIO-scalar/scalar.xs index eac682b..87c5682 100644 --- a/ext/PerlIO-scalar/scalar.xs +++ b/ext/PerlIO-scalar/scalar.xs @@ -314,12 +314,21 @@ PerlIO * PerlIOScalar_dup(pTHX_ PerlIO * f, PerlIO * o, CLONE_PARAMS * param, int flags) { + /* Duplication causes the scalar layer to be pushed on to clone, caus- + ing the cloned scalar to be set to the empty string by + PerlIOScalar_pushed. So set aside our scalar temporarily. */ + PerlIOScalar * const os = PerlIOSelf(o, PerlIOScalar); + SV * const var = os->var; + os->var = newSVpvs(""); if ((f = PerlIOBase_dup(aTHX_ f, o, param, flags))) { PerlIOScalar *fs = PerlIOSelf(f, PerlIOScalar); - PerlIOScalar *os = PerlIOSelf(o, PerlIOScalar); - /* var has been set by implicit push */ + /* var has been set by implicit push, so replace it */ + SvREFCNT_dec(fs->var); + fs->var = PerlIO_sv_dup(aTHX_ var, param); fs->posn = os->posn; } + SvREFCNT_dec(os->var); + os->var = var; return f; } diff --git a/ext/PerlIO-scalar/t/scalar.t b/ext/PerlIO-scalar/t/scalar.t index a02107b..18bbda9 100644 --- a/ext/PerlIO-scalar/t/scalar.t +++ b/ext/PerlIO-scalar/t/scalar.t @@ -16,7 +16,7 @@ use Fcntl qw(SEEK_SET SEEK_CUR SEEK_END); # Not 0, 1, 2 everywhere. $| = 1; -use Test::More tests => 79; +use Test::More tests => 81; my $fh; my $var = "aaa\n"; @@ -360,3 +360,17 @@ SKIP: { ok has_trailing_nul $memfile, 'write appends null when growing string after seek past end'; } + +# [perl #112780] Cloning of in-memory handles +SKIP: { + skip "no threads", 2 if !$Config::Config{useithreads}; + require threads; + my $str = ''; + open my $fh, ">", \$str; + $str = 'a'; + is scalar threads::async(sub { my $foo = $str; $foo })->join, "a", + 'scalars behind in-memory handles are cloned properly'; + print $fh "a"; + is scalar async { print $fh "b"; $str }->join, "ab", + 'printing to a cloned in-memory handle works'; +} -- Perl5 Master Repository
