[perl #113764] Make &= duping work with PerlIO::scalar

In trying to fix bug #112780, I made in-memory handle duplication tem-
porarily hide the underlying scalar so it wouldn’t be set to the empty
string (commit 49b69fb3a).

I used PerlIO_sv_dup in j rather than PerlIOScalar_arg.  The for-
mer is usually what is called anyway.  There is only one branch of
PerlIOScalar_arg that doesn’t call PerlIO_sv_dup.  I don’t remember
what I was thinking back then, but I think I thought that branch
was there for paranoia.  But actually, it is used for "&=", so this
started failing:

open FILE, '>', \my $content or die "Couldn't open scalar filehandle";
open my $fh, ">&=FILE" or die "Couldn't open: $!";
print $fh "Foo-Bar\n";
close $fh;
close FILE;
print $content;

This commit fixes the bug in the smallest way possible, which means
switching from PerlIO_sv_dup to PerlIOScalar_arg in PerlIOScalar_arg,
which, in turn, entails fiddling with RVs.

diff --git a/ext/PerlIO-scalar/scalar.xs b/ext/PerlIO-scalar/scalar.xs
index 87c5682..d7b8828 100644 (file)
--- a/ext/PerlIO-scalar/scalar.xs
+++ b/ext/PerlIO-scalar/scalar.xs
@@ -318,17 +318,22 @@ PerlIOScalar_dup(pTHX_ PerlIO * f, PerlIO * o, CLONE_PARAMS * param,
        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);
+    PerlIOScalar *fs;
     SV * const var = os->var;
     os->var = newSVpvs("");
     if ((f = PerlIOBase_dup(aTHX_ f, o, param, flags))) {
-       PerlIOScalar *fs = PerlIOSelf(f, PerlIOScalar);
+       fs = PerlIOSelf(f, PerlIOScalar);
        /* 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;
+    if (f) {
+       SV * const rv = PerlIOScalar_arg(aTHX_ o, param, flags);
+       fs->var = SvREFCNT_inc(SvRV(rv));
+       SvREFCNT_dec(rv);
+       fs->posn = os->posn;
+    }
     return f;
 }
 

diff --git a/ext/PerlIO-scalar/t/scalar.t b/ext/PerlIO-scalar/t/scalar.t
index 403afa7..d255a05 100644 (file)
--- 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 => 81;
+use Test::More tests => 82;
 
 my $fh;
 my $var = "aaa\n";
@@ -374,3 +374,13 @@ SKIP: {
   is scalar threads::async(sub { print $fh "b"; $str })->join, "ab",
     'printing to a cloned in-memory handle works';
 }
+
+# [perl #113764] Duping via >&= (broken by the fix for #112870)
+{
+  open FILE, '>', \my $content or die "Couldn't open scalar filehandle";
+  open my $fh, ">&=FILE" or die "Couldn't open: $!";
+  print $fh "Foo-Bar\n";
+  close $fh;
+  close FILE;
+  is $content, "Foo-Bar\n", 'duping via >&=';
+}