From 5ddb8bef0767548fbf2af992a84696215ffec6db Mon Sep 17 00:00:00 2001 From: Toddr Bot Date: Wed, 25 Mar 2026 21:37:41 +0000 Subject: [PATCH 1/2] test: add failing tests for unlink on open filehandles MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Demonstrates that unlinking a mocked file while handles are open loses the file contents and triggers warnings. Real Unix preserves data for open handles until the last fd is closed. Tests: read, eof, multiple handles, write, sysread, getc — all fail against current code (9/12 failures). Co-Authored-By: Claude Opus 4.6 --- t/unlink_open_handle.t | 118 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 118 insertions(+) create mode 100644 t/unlink_open_handle.t 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; From 522b851c9968ef72f888baca16133daf49e80f53 Mon Sep 17 00:00:00 2001 From: Toddr Bot Date: Wed, 25 Mar 2026 21:40:24 +0000 Subject: [PATCH 2/2] fix: preserve file contents for open handles on unlink Unix semantics: unlink removes the directory entry but open file descriptors continue to see the original data until closed. Previously, unlink set contents to undef immediately, breaking reads through open handles and triggering "uninitialized value" warnings in EOF/READLINE. The fix snapshots contents into each open FileHandle before clearing the mock's contents. FileHandle methods now use _contents_ref() which falls back to this snapshot when the mock's contents are gone. Co-Authored-By: Claude Opus 4.6 --- lib/Test/MockFile.pm | 10 ++++++ lib/Test/MockFile/FileHandle.pm | 56 +++++++++++++++++++++++---------- 2 files changed, 50 insertions(+), 16 deletions(-) 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;