diff --git a/lib/Test/MockFile.pm b/lib/Test/MockFile.pm index 17aed44..c55572c 100644 --- a/lib/Test/MockFile.pm +++ b/lib/Test/MockFile.pm @@ -2197,6 +2197,16 @@ sub unlink { $self->{'readlink'} = undef; } else { + # Unix semantics: open file descriptors survive unlink. + # Snapshot contents into each open FileHandle before clearing. + if ( $self->{'fhs'} && defined $self->{'contents'} ) { + for my $fh ( grep { defined $_ } @{ $self->{'fhs'} } ) { + my $tied = tied(*$fh); + if ( $tied && $tied->can('_preserve_contents_for_unlink') ) { + $tied->_preserve_contents_for_unlink(); + } + } + } $self->{'has_content'} = undef; $self->{'contents'} = undef; } diff --git a/lib/Test/MockFile/FileHandle.pm b/lib/Test/MockFile/FileHandle.pm index e5b1f69..48f90fd 100644 --- a/lib/Test/MockFile/FileHandle.pm +++ b/lib/Test/MockFile/FileHandle.pm @@ -83,6 +83,31 @@ sub TIEHANDLE { return $self; } +# _contents_ref: returns a scalar ref to the effective contents for this handle. +# After unlink, the mock's contents are undef but the handle may have a snapshot +# saved by _preserve_contents_for_unlink (Unix semantics: open fds survive unlink). +sub _contents_ref { + my ($self) = @_; + my $data = $self->{'data'}; + if ( $data && defined $data->{'contents'} ) { + return \$data->{'contents'}; + } + if ( exists $self->{'_orphaned_contents'} ) { + return \$self->{'_orphaned_contents'}; + } + return undef; +} + +# Called from Test::MockFile::unlink before clearing contents. +# Snapshots the current contents so open handles can continue reading/writing. +sub _preserve_contents_for_unlink { + my ($self) = @_; + my $data = $self->{'data'} or return; + if ( defined $data->{'contents'} ) { + $self->{'_orphaned_contents'} = $data->{'contents'}; + } +} + =head2 PRINT This method will be triggered every time the tied handle is printed to @@ -105,13 +130,12 @@ C<$!> to EBADF and return. sub _write_bytes { my ( $self, $output ) = @_; - my $data = $self->{'data'} or do { + my $contents = $self->_contents_ref() or do { $! = EBADF; return 0; }; - my $tell = $self->{'tell'}; - my $contents = \$data->{'contents'}; + my $tell = $self->{'tell'}; if ( $self->{'append'} ) { # Append mode (>> / +>>): always write at end regardless of tell. @@ -156,10 +180,10 @@ sub PRINT { # at the C level after PRINT returns), so this only covers explicit usage. $output .= $\ if defined $\; - my $data = $self->{'data'} or do { + if ( !$self->_contents_ref() ) { $! = EBADF; return 0; - }; + } my $bytes = $self->_write_bytes($output); $self->_update_write_times() if $bytes; @@ -269,8 +293,8 @@ read. undef is returned if tell is already at EOF. sub _READLINE_ONE_LINE { my ($self) = @_; - my $data = $self->{'data'} or return undef; - my $contents = $data->{'contents'}; + my $cref = $self->_contents_ref() or return undef; + my $contents = $$cref; my $len = length($contents); my $tell = $self->{'tell'}; @@ -385,8 +409,8 @@ sub GETC { return undef if $self->EOF; - my $data = $self->{'data'} or return undef; - my $char = substr( $data->{'contents'}, $self->{'tell'}, 1 ); + my $cref = $self->_contents_ref() or return undef; + my $char = substr( $$cref, $self->{'tell'}, 1 ); $self->{'tell'}++; $self->_update_read_time(); @@ -429,12 +453,12 @@ sub READ { # If the caller's buffer is undef, we need to make it a string of 0 length to start out with. $_[1] = '' if !defined $_[1]; - my $data = $self->{'data'} or do { + my $cref = $self->_contents_ref() or do { $! = EBADF; return 0; }; - my $contents_len = length $data->{'contents'}; + my $contents_len = length $$cref; my $buf_len = length $_[1]; $offset //= 0; @@ -448,7 +472,7 @@ sub READ { my $read_len = ( $contents_len - $tell < $len ) ? $contents_len - $tell : $len; - substr( $_[1], $offset ) = substr( $data->{'contents'}, $tell, $read_len ); + substr( $_[1], $offset ) = substr( $$cref, $tell, $read_len ); $self->{'tell'} += $read_len; $self->_update_read_time() if $read_len; @@ -532,13 +556,13 @@ C<$self-E{'tell'}>, we determine if we're at EOF. sub EOF { my ($self) = @_; - my $data = $self->{'data'} or return 1; + my $cref = $self->_contents_ref() or return 1; if ( !$self->{'read'} ) { my $path = $self->{'file'} // 'unknown'; CORE::warn("Filehandle $path opened only for output"); } - return $self->{'tell'} >= length $data->{'contents'}; + return $self->{'tell'} >= length $$cref; } =head2 BINMODE @@ -620,12 +644,12 @@ exists on this method. sub SEEK { my ( $self, $pos, $whence ) = @_; - my $data = $self->{'data'} or do { + my $cref = $self->_contents_ref() or do { $! = EBADF; return 0; }; - my $file_size = length $data->{'contents'}; + my $file_size = length $$cref; my $new_pos; diff --git a/t/unlink_open_handle.t b/t/unlink_open_handle.t new file mode 100644 index 0000000..2b3be1e --- /dev/null +++ b/t/unlink_open_handle.t @@ -0,0 +1,118 @@ +#!/usr/bin/perl -w + +# Test Unix semantics: unlink on a file with open handles should not +# affect reads through those handles. The directory entry is removed +# (-e returns false), but open filehandles continue to see the data. + +use strict; +use warnings; + +use Test2::Bundle::Extended; +use Test2::Tools::Explain; + +use Test::MockFile qw< nostrict >; + +# Test 1: Read after unlink — handle should still see the original data +{ + my $mock = Test::MockFile->file( "/tmp/unlink_read", "important data" ); + + open my $fh, '<', '/tmp/unlink_read' or die "open: $!"; + + # Unlink while handle is open + ok( unlink('/tmp/unlink_read'), "unlink succeeds on open file" ); + ok( !-e '/tmp/unlink_read', "file no longer exists after unlink" ); + + # The open handle should still be able to read the data + my $content = do { local $/; <$fh> }; + is( $content, "important data", "read through open handle returns original data after unlink" ); + + close $fh; +} + +# Test 2: eof() should not warn after unlink +{ + my $mock = Test::MockFile->file( "/tmp/unlink_eof", "data" ); + + open my $fh, '<', '/tmp/unlink_eof' or die "open: $!"; + + # Read to end + my $content = do { local $/; <$fh> }; + + unlink('/tmp/unlink_eof'); + + # eof() on the open handle should not produce warnings + my @warnings; + local $SIG{__WARN__} = sub { push @warnings, $_[0] }; + my $is_eof = eof($fh); + is( \@warnings, [], "no warnings from eof() after unlink" ); + ok( $is_eof, "eof is true after reading all data" ); + + close $fh; +} + +# Test 3: Multiple handles — all should retain access +{ + my $mock = Test::MockFile->file( "/tmp/unlink_multi", "shared data" ); + + open my $fh1, '<', '/tmp/unlink_multi' or die "open fh1: $!"; + open my $fh2, '<', '/tmp/unlink_multi' or die "open fh2: $!"; + + unlink('/tmp/unlink_multi'); + + my $c1 = do { local $/; <$fh1> }; + my $c2 = do { local $/; <$fh2> }; + + is( $c1, "shared data", "first handle reads data after unlink" ); + is( $c2, "shared data", "second handle reads data after unlink" ); + + close $fh1; + close $fh2; +} + +# Test 4: Write handle still works after unlink +{ + my $mock = Test::MockFile->file( "/tmp/unlink_write", "" ); + + open my $fh, '+>', '/tmp/unlink_write' or die "open: $!"; + print $fh "before"; + + unlink('/tmp/unlink_write'); + + # Writing to the handle after unlink should still work + print $fh " after"; + seek( $fh, 0, 0 ); + my $content = do { local $/; <$fh> }; + is( $content, "before after", "write and read through handle work after unlink" ); + + close $fh; +} + +# Test 5: sysread after unlink +{ + my $mock = Test::MockFile->file( "/tmp/unlink_sysread", "sysread data" ); + + open my $fh, '<', '/tmp/unlink_sysread' or die "open: $!"; + unlink('/tmp/unlink_sysread'); + + my $buf; + my $n = sysread( $fh, $buf, 1024 ); + is( $n, 12, "sysread returns correct byte count after unlink" ); + is( $buf, "sysread data", "sysread returns correct data after unlink" ); + + close $fh; +} + +# Test 6: getc after unlink +{ + my $mock = Test::MockFile->file( "/tmp/unlink_getc", "AB" ); + + open my $fh, '<', '/tmp/unlink_getc' or die "open: $!"; + unlink('/tmp/unlink_getc'); + + is( getc($fh), "A", "getc returns first char after unlink" ); + is( getc($fh), "B", "getc returns second char after unlink" ); + + close $fh; +} + +done_testing;