From 3001bc2af4c038b77f1a9a8d35b1944c00b9dc50 Mon Sep 17 00:00:00 2001 From: Toddr Bot Date: Fri, 24 Jul 2026 03:01:40 +0000 Subject: [PATCH] fix: handle open(<&, $fh) dup mode on mocked filehandles MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit open() with dup modes (<&, >&, <&=, >&=) on a mocked filehandle fell through to CORE::open, which failed with "Bad file descriptor" because mocked handles have synthetic filenos. Detect dup modes in __open and, when the source handle belongs to a mocked file, create a new tied handle that shares the same mock data. The duplicate inherits the source handle's access mode (r/w/a) and seek position, while maintaining an independent position pointer afterward — matching Perl's buffered-IO dup semantics. Non-mocked handles still fall through to CORE::open as before. --- lib/Test/MockFile.pm | 40 +++++++++++++++++ t/dup_handle.t | 104 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 144 insertions(+) create mode 100644 t/dup_handle.t diff --git a/lib/Test/MockFile.pm b/lib/Test/MockFile.pm index 6c5d4cf..6f3fb76 100644 --- a/lib/Test/MockFile.pm +++ b/lib/Test/MockFile.pm @@ -3066,6 +3066,46 @@ sub __open (*;$@) { return CORE::open( $_[0], $mode, $file ); } + # Handle dup modes: <&, >&, <&=, >&= (3-arg form only). + # When the source handle is a mocked filehandle, create a new tied + # handle that shares the same mock data instead of falling through + # to CORE::open (which would fail because mocked filenos are fake). + if ( $mode =~ m/^[<>]\&=?$/ && ref $file ) { + my $src_path = _fh_to_file($file); + if ( defined $src_path ) { + my $mock_file = _get_file_object($src_path); + if ($mock_file) { + my $src_tied = tied *{$file}; + my $rw = ''; + if ($src_tied) { + $rw .= 'r' if $src_tied->{'read'}; + $rw .= 'w' if $src_tied->{'write'}; + $rw .= 'a' if $src_tied->{'append'}; + } + else { + $rw = 'r'; + } + + my $filefh = IO::File->new; + tie *{$filefh}, 'Test::MockFile::FileHandle', $src_path, $rw; + + if ($src_tied) { + my $dup_tied = tied *{$filefh}; + $dup_tied->{'tell'} = $src_tied->{'tell'}; + $dup_tied->{'line_number'} = $src_tied->{'line_number'}; + } + + $_[0] = $filefh; + + $mock_file->{'fhs'} //= []; + push @{ $mock_file->{'fhs'} }, $_[0]; + Scalar::Util::weaken( $mock_file->{'fhs'}[-1] ) if ref $_[0]; + + return 1; + } + } + } + my $abs_path = _find_file_or_fh( $file, 1 ); # Follow the link. confess() if !$abs_path && $mode ne '|-' && $mode ne '-|'; diff --git a/t/dup_handle.t b/t/dup_handle.t new file mode 100644 index 0000000..8208462 --- /dev/null +++ b/t/dup_handle.t @@ -0,0 +1,104 @@ +#!/usr/bin/perl -w + +use strict; +use warnings; + +use Test2::V0; +use Test2::Tools::Explain; +use Test::MockFile (); + +subtest 'open <& duplicates a mocked read handle' => sub { + my $mock = Test::MockFile->file( "/tmp/dup_read", "line1\nline2\nline3\n" ); + open( my $fh, '<', '/tmp/dup_read' ) or die "open: $!"; + my $l1 = <$fh>; + chomp $l1; + is( $l1, 'line1', 'original read first line' ); + + ok( open( my $dup, '<&', $fh ), 'dup via <& succeeds' ); + my $l2 = <$dup>; + chomp $l2; + is( $l2, 'line2', 'dup inherits position from source' ); + + my $l3 = <$fh>; + chomp $l3; + is( $l3, 'line2', 'original handle position is independent after dup' ); + + close($dup); + close($fh); +}; + +subtest 'open >& duplicates a mocked write handle' => sub { + my $mock = Test::MockFile->file( "/tmp/dup_write", '' ); + open( my $fh, '>', '/tmp/dup_write' ) or die "open: $!"; + print $fh "original\n"; + + ok( open( my $dup, '>&', $fh ), 'dup via >& succeeds' ); + print $dup "from_dup\n"; + close($dup); + close($fh); + + open( $fh, '<', '/tmp/dup_write' ) or die; + my @lines = <$fh>; + close($fh); + chomp @lines; + is( \@lines, [ 'original', 'from_dup' ], 'both handles wrote to same mock' ); +}; + +subtest 'dup of +< handle inherits read-write mode' => sub { + my $mock = Test::MockFile->file( "/tmp/dup_rw", "hello\n" ); + open( my $fh, '+<', '/tmp/dup_rw' ) or die "open: $!"; + + ok( open( my $dup, '<&', $fh ), 'dup of +< handle via <&' ); + + seek( $dup, 0, 0 ); + my $line = <$dup>; + chomp $line; + is( $line, 'hello', 'dup can read' ); + + seek( $dup, 0, 2 ); + print $dup "world\n"; + close($dup); + close($fh); + + open( $fh, '<', '/tmp/dup_rw' ) or die; + my @lines = <$fh>; + close($fh); + chomp @lines; + is( \@lines, [ 'hello', 'world' ], 'dup could write (inherited rw)' ); +}; + +subtest 'open <&= (fdopen) works on mocked handle' => sub { + my $mock = Test::MockFile->file( "/tmp/dup_fdopen", "content\n" ); + open( my $fh, '<', '/tmp/dup_fdopen' ) or die "open: $!"; + + ok( open( my $dup, '<&=', $fh ), 'fdopen via <&= succeeds' ); + my $line = <$dup>; + chomp $line; + is( $line, 'content', 'fdopen handle reads correctly' ); + + close($dup); + close($fh); +}; + +subtest 'dup handle cleanup on scope exit' => sub { + my $mock = Test::MockFile->file( "/tmp/dup_scope", "data\n" ); + { + open( my $fh, '<', '/tmp/dup_scope' ) or die; + open( my $dup, '<&', $fh ) or die; + } + ok( 1, 'no leak or crash when dup goes out of scope' ); +}; + +subtest 'close on dup does not affect original' => sub { + my $mock = Test::MockFile->file( "/tmp/dup_close", "abc\ndef\n" ); + open( my $fh, '<', '/tmp/dup_close' ) or die; + open( my $dup, '<&', $fh ) or die; + close($dup); + + my $line = <$fh>; + chomp $line; + is( $line, 'abc', 'original handle still readable after dup closed' ); + close($fh); +}; + +done_testing();