fix: preserve file contents for open handles on unlink

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;
     }

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<gt>{'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;
 

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;