diff options
| -rw-r--r-- | ext/PerlIO-scalar/scalar.xs | 11 | ||||
| -rw-r--r-- | ext/PerlIO-scalar/t/scalar.t | 12 |
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 >&='; +} |