fix: reject I/O operations on closed mocked filehandles

lib/Test/MockFile/FileHandle.pm

@@ -136,6 +136,11 @@ sub _write_bytes {
 sub PRINT {
     my ( $self, @list ) = @_;
 
+    if ( $self->_is_closed_with_warning('print') ) {
+        $! = EBADF;
+        return undef;
+    }
+
     if ( !$self->{'write'} ) {
 
         # Filehandle $fh opened only for input at t/readline.t line 27, <$fh> line 2.
@@ -184,6 +189,11 @@ sub PRINTF {
     my $self   = shift;
     my $format = shift;
 
+    if ( $self->_is_closed_with_warning('printf') ) {
+        $! = EBADF;
+        return undef;
+    }
+
     if ( !$self->{'write'} ) {
         $! = EBADF;
         return;
@@ -216,6 +226,11 @@ works reveals there are all sorts of weird corner cases.
 sub WRITE {
     my ( $self, $buf, $len, $offset ) = @_;
 
+    if ( $self->_is_closed_with_warning('syswrite') ) {
+        $! = EBADF;
+        return undef;
+    }
+
     if ( !$self->{'write'} ) {
         $! = EBADF;
         return 0;
@@ -343,6 +358,10 @@ sub _READLINE_ONE_LINE {
 sub READLINE {
     my ($self) = @_;
 
+    if ( $self->_is_closed_with_warning('readline') ) {
+        return undef;
+    }
+
     if ( !$self->{'read'} ) {
         my $path = $self->{'file'} // 'unknown';
         CORE::warn("Filehandle $path opened only for output");
@@ -385,6 +404,10 @@ returned. Returns undef at EOF.
 sub GETC {
     my ($self) = @_;
 
+    if ( $self->_is_closed_with_warning('getc') ) {
+        return undef;
+    }
+
     if ( !$self->{'read'} ) {
         my $path = $self->{'file'} // 'unknown';
         CORE::warn("Filehandle $path opened only for output");
@@ -414,6 +437,11 @@ end up with some really weird strings with null bytes in them.
 sub READ {
     my ( $self, undef, $len, $offset ) = @_;
 
+    if ( $self->_is_closed_with_warning('read') ) {
+        $! = EBADF;
+        return undef;
+    }
+
     if ( !$self->{'read'} ) {
         $! = EBADF;
         return undef;
@@ -475,6 +503,14 @@ is removed. Further calls to this object should fail.
 sub CLOSE {
     my ($self) = @_;
 
+    # Double close: return false with EBADF, matching real Perl behavior.
+    if ( $self->{'closed'} ) {
+        $! = EBADF;
+        return 0;
+    }
+
+    $self->{'closed'} = 1;
+
     # Remove this specific handle from the mock's fhs list.
     # Each handle has its own tied object, so we match by tied identity.
     # Try through the weak data ref first, then fall back to the global hash.
@@ -492,6 +528,17 @@ sub CLOSE {
     return 1;
 }
 
+# Emit a Perl-style "op() on closed filehandle" warning and return true
+# if the handle has been closed.  Returns false if the handle is still open.
+sub _is_closed_with_warning {
+    my ( $self, $op ) = @_;
+    return 0 unless $self->{'closed'};
+
+    my $path = $self->{'file'} // 'unknown';
+    CORE::warn("$op() on closed filehandle $path at @{[ join ' line ', (caller(1))[1,2] ]}.\n");
+    return 1;
+}
+
 =head2 UNTIE
 
 As with the other types of ties, this method will be called when untie
@@ -540,6 +587,8 @@ C<$self-E<gt>{'tell'}>, we determine if we're at EOF.
 sub EOF {
     my ($self) = @_;
 
+    return 1 if $self->{'closed'};
+
     my $data = $self->{'data'} or return 1;
 
     if ( !$self->{'read'} ) {
@@ -628,6 +677,10 @@ exists on this method.
 sub SEEK {
     my ( $self, $pos, $whence ) = @_;
 
+    if ( $self->_is_closed_with_warning('seek') ) {
+        return 0;
+    }
+
     my $data = $self->{'data'} or do {
         $! = EBADF;
         return 0;
@@ -676,6 +729,11 @@ exists on this method.
 
 sub TELL {
     my ($self) = @_;
+
+    if ( $self->_is_closed_with_warning('tell') ) {
+        return -1;
+    }
+
     return $self->{'tell'};
 }
 

t/closed_fh_ops.t

@@ -0,0 +1,130 @@
+#!/usr/bin/perl -w
+
+# Test that I/O operations on a closed mocked filehandle behave the same
+# as real Perl: warn, set appropriate error indicators, and return the
+# correct failure values.  Prior to the fix, all of these operations
+# silently succeeded on closed mocked handles.
+
+use strict;
+use warnings;
+
+use Test2::Bundle::Extended;
+use Test2::Tools::Warnings qw/warning/;
+
+use Test::MockFile qw< nostrict >;
+
+# --- print on closed handle ---
+subtest 'print on closed handle returns undef and warns' => sub {
+    my $mock = Test::MockFile->file( '/tmp/closed_print.txt', 'hello' );
+    open my $fh, '>', '/tmp/closed_print.txt' or die "open: $!";
+    close $fh or die "close: $!";
+
+    my $ret;
+    my $w = warning { $ret = print $fh 'should fail' };
+
+    ok( !defined $ret, 'print returns undef on closed handle' );
+    like( $w, qr/closed filehandle/i, 'warning mentions closed filehandle' );
+};
+
+# --- syswrite on closed handle ---
+subtest 'syswrite on closed handle returns undef and warns' => sub {
+    my $mock = Test::MockFile->file( '/tmp/closed_syswrite.txt', 'hello' );
+    open my $fh, '>', '/tmp/closed_syswrite.txt' or die "open: $!";
+    close $fh or die "close: $!";
+
+    my $ret;
+    my $w = warning { $ret = syswrite( $fh, 'fail', 4 ) };
+
+    ok( !defined $ret, 'syswrite returns undef on closed handle' );
+    like( $w, qr/closed filehandle/i, 'warning mentions closed filehandle' );
+};
+
+# --- read on closed handle ---
+subtest 'read on closed handle returns undef and warns' => sub {
+    my $mock = Test::MockFile->file( '/tmp/closed_read.txt', 'hello' );
+    open my $fh, '<', '/tmp/closed_read.txt' or die "open: $!";
+    close $fh or die "close: $!";
+
+    my $ret;
+    my $buf;
+    my $w = warning { $ret = read( $fh, $buf, 10 ) };
+
+    ok( !defined $ret, 'read returns undef on closed handle' );
+    like( $w, qr/closed filehandle/i, 'warning mentions closed filehandle' );
+};
+
+# --- readline on closed handle ---
+subtest 'readline on closed handle returns undef and warns' => sub {
+    my $mock = Test::MockFile->file( '/tmp/closed_readline.txt', "line1\n" );
+    open my $fh, '<', '/tmp/closed_readline.txt' or die "open: $!";
+    close $fh or die "close: $!";
+
+    my $ret;
+    my $w = warning { $ret = readline($fh) };
+
+    ok( !defined $ret, 'readline returns undef on closed handle' );
+    like( $w, qr/closed filehandle/i, 'warning mentions closed filehandle' );
+};
+
+# --- tell on closed handle ---
+subtest 'tell on closed handle returns -1 and warns' => sub {
+    my $mock = Test::MockFile->file( '/tmp/closed_tell.txt', 'hello' );
+    open my $fh, '<', '/tmp/closed_tell.txt' or die "open: $!";
+    close $fh or die "close: $!";
+
+    my $ret;
+    my $w = warning { $ret = tell($fh) };
+
+    is( $ret, -1, 'tell returns -1 on closed handle' );
+    like( $w, qr/closed filehandle/i, 'warning mentions closed filehandle' );
+};
+
+# --- seek on closed handle ---
+subtest 'seek on closed handle returns false and warns' => sub {
+    my $mock = Test::MockFile->file( '/tmp/closed_seek.txt', 'hello' );
+    open my $fh, '<', '/tmp/closed_seek.txt' or die "open: $!";
+    close $fh or die "close: $!";
+
+    my $ret;
+    my $w = warning { $ret = seek( $fh, 0, 0 ) };
+
+    ok( !$ret, 'seek returns false on closed handle' );
+    like( $w, qr/closed filehandle/i, 'warning mentions closed filehandle' );
+};
+
+# --- eof on closed handle ---
+subtest 'eof on closed handle returns true' => sub {
+    my $mock = Test::MockFile->file( '/tmp/closed_eof.txt', 'hello' );
+    open my $fh, '<', '/tmp/closed_eof.txt' or die "open: $!";
+    close $fh or die "close: $!";
+
+    # Real Perl: eof on closed handle returns 1 (no warning)
+    my $ret = eof($fh);
+    ok( $ret, 'eof returns true on closed handle' );
+};
+
+# --- getc on closed handle ---
+subtest 'getc on closed handle returns undef and warns' => sub {
+    my $mock = Test::MockFile->file( '/tmp/closed_getc.txt', 'hello' );
+    open my $fh, '<', '/tmp/closed_getc.txt' or die "open: $!";
+    close $fh or die "close: $!";
+
+    my $ret;
+    my $w = warning { $ret = getc($fh) };
+
+    ok( !defined $ret, 'getc returns undef on closed handle' );
+    like( $w, qr/closed filehandle/i, 'warning mentions closed filehandle' );
+};
+
+# --- double close returns false ---
+subtest 'double close returns false' => sub {
+    my $mock = Test::MockFile->file( '/tmp/closed_double.txt', 'hello' );
+    open my $fh, '>', '/tmp/closed_double.txt' or die "open: $!";
+    close $fh or die "close: $!";
+
+    my $ret = close $fh;
+
+    ok( !$ret, 'double close returns false' );
+};
+
+done_testing;