summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2012-06-20 23:33:28 -0700
committerRicardo Signes <rjbs@cpan.org>2012-06-24 18:28:57 -0400
commita3d9b85b2bd480dc8c97e633ab1cda7845c06266 (patch)
treedfdc78e4eac8e46ead396c95a43e2a826a9bc4c3
parentcc921a8a9f393ad2ced442a7757e1b2cf28d715c (diff)
downloadperl-a3d9b85b2bd480dc8c97e633ab1cda7845c06266.tar.gz
[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.
-rw-r--r--ext/PerlIO-scalar/scalar.xs11
-rw-r--r--ext/PerlIO-scalar/t/scalar.t12
2 files changed, 19 insertions, 4 deletions
diff --git a/ext/PerlIO-scalar/scalar.xs b/ext/PerlIO-scalar/scalar.xs
index 87c5682388..d7b8828fcb 100644
--- 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 403afa7e90..d255a05993 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 => 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 >&=';
+}