[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.

2 files changed, 26 insertions, 3 deletions

diff --git a/ext/PerlIO-scalar/scalar.xs b/ext/PerlIO-scalar/scalar.xs
index eac682b5c3..87c5682388 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 a02107b17d..18bbda9404 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';
+}