feat: override IO::File::open for mocked file compatibility

lib/Test/MockFile.pm

@@ -1966,6 +1966,151 @@ sub _goto_is_available {
     return 0;    # 5.
 }
 
+################
+# IO::File     #
+################
+
+# IO::File::open() uses CORE::open internally, which bypasses CORE::GLOBAL::open.
+# This means IO::File->new($mocked_file) would NOT use the mock.
+# Fix: override IO::File::open to check for mocked files first.
+
+my $_orig_io_file_open;
+
+sub _io_file_mock_open {
+    my ( $fh, $abs_path, $mode ) = @_;
+    my $mock_file = _get_file_object($abs_path);
+
+    # If contents is undef and reading, file doesn't exist
+    if ( !defined $mock_file->contents() && grep { $mode eq $_ } qw/< +</ ) {
+        $! = ENOENT;
+        return;
+    }
+
+    my $rw = '';
+    $rw .= 'r' if grep { $_ eq $mode } qw/+< +> +>> </;
+    $rw .= 'w' if grep { $_ eq $mode } qw/+< +> +>> > >>/;
+
+    # Tie the existing IO::File glob directly (don't create a new one)
+    tie *{$fh}, 'Test::MockFile::FileHandle', $abs_path, $rw;
+
+    # Track the handle
+    $mock_file->{'fh'} = $fh;
+    Scalar::Util::weaken( $mock_file->{'fh'} ) if ref $fh;
+
+    # Handle append/truncate modes
+    if ( $mode eq '>>' or $mode eq '+>>' ) {
+        $mock_file->{'contents'} //= '';
+        seek $fh, length( $mock_file->{'contents'} ), 0;
+    }
+    elsif ( $mode eq '>' or $mode eq '+>' ) {
+        $mock_file->{'contents'} = '';
+    }
+
+    return 1;
+}
+
+sub _io_file_open_override {
+    @_ >= 2 && @_ <= 4
+      or croak('usage: $fh->open(FILENAME [,MODE [,PERMS]])');
+
+    my $fh   = $_[0];
+    my $file = $_[1];
+
+    # Numeric mode (sysopen flags)
+    if ( @_ > 2 && $_[2] =~ /^\d+$/ ) {
+        my $sysmode = $_[2];
+        my $abs_path = _find_file_or_fh( $file, 1 );
+        my $mock_file;
+        if ( $abs_path && !ref $abs_path ) {
+            $mock_file = _get_file_object($abs_path);
+        }
+
+        if ( !$mock_file ) {
+            # Not mocked — fall through to real sysopen
+            my $perms = defined $_[3] ? $_[3] : 0666;
+            return sysopen( $fh, $file, $sysmode, $perms );
+        }
+
+        # Handle O_CREAT / O_TRUNC / O_EXCL on the mock
+        if ( $sysmode & Fcntl::O_EXCL && $sysmode & Fcntl::O_CREAT && defined $mock_file->{'contents'} ) {
+            $! = EEXIST;
+            return;
+        }
+        if ( $sysmode & Fcntl::O_CREAT && !defined $mock_file->{'contents'} ) {
+            $mock_file->{'contents'} = '';
+        }
+        if ( !defined $mock_file->{'contents'} ) {
+            $! = ENOENT;
+            return;
+        }
+
+        # Convert sysopen flags to string mode for _io_file_mock_open
+        my $rd_wr = $sysmode & 3;
+        my $mode =
+            $rd_wr == Fcntl::O_RDONLY ? '<'
+          : $rd_wr == Fcntl::O_WRONLY ? '>'
+          : $rd_wr == Fcntl::O_RDWR   ? '+<'
+          :                             '<';
+
+        if ( $sysmode & Fcntl::O_TRUNC ) {
+            $mock_file->{'contents'} = '';
+        }
+        if ( $sysmode & Fcntl::O_APPEND ) {
+            $mode = '>>' if $rd_wr == Fcntl::O_WRONLY;
+            $mode = '+>>' if $rd_wr == Fcntl::O_RDWR;
+        }
+
+        return _io_file_mock_open( $fh, $abs_path, $mode );
+    }
+
+    my $mode;
+    if ( @_ > 2 ) {
+        if ( $_[2] =~ /:/ ) {
+
+            # IO layer mode like "<:utf8" — extract base mode
+            if ( $_[2] =~ /^([+]?[<>]{1,2})/ ) {
+                $mode = $1;
+            }
+            else {
+                # Pure layer spec without mode prefix — default to read
+                $mode = '<';
+            }
+        }
+        else {
+            $mode = IO::Handle::_open_mode_string( $_[2] );
+        }
+    }
+    else {
+        # 2-arg form: mode may be embedded in filename
+        if ( $file =~ /^\s*(>>|[+]?[<>])\s*(.+)\s*$/ ) {
+            $mode = $1;
+            $file = $2;
+        }
+        else {
+            $mode = '<';
+        }
+    }
+
+    # Pipe opens — not mockable
+    if ( $mode eq '|-' || $mode eq '-|' ) {
+        goto &$_orig_io_file_open;
+    }
+
+    # Check if file is mocked
+    my $abs_path = _find_file_or_fh( $file, 1 );
+    if ( !$abs_path || ( ref $abs_path && ( $abs_path eq BROKEN_SYMLINK || $abs_path eq CIRCULAR_SYMLINK ) ) ) {
+        goto &$_orig_io_file_open;
+    }
+
+    my $mock_file = _get_file_object($abs_path);
+    if ( !$mock_file ) {
+        goto &$_orig_io_file_open;
+    }
+
+    # File is mocked — handle via mock layer
+    return _io_file_mock_open( $fh, $abs_path, $mode );
+}
+
 ############
 # KEYWORDS #
 ############
@@ -2857,6 +3002,14 @@ BEGIN {
         *Cwd::fast_abs_path = \&__cwd_abs_path;
         *Cwd::fast_realpath = \&__cwd_abs_path;
     }
+
+    # Override IO::File::open to intercept mocked files.
+    # IO::File uses CORE::open internally which bypasses CORE::GLOBAL::open.
+    $_orig_io_file_open = \&IO::File::open;
+    {
+        no warnings 'redefine';
+        *IO::File::open = \&_io_file_open_override;
+    }
 }
 
 =head1 CAEATS AND LIMITATIONS

t/io_file_compat.t

@@ -0,0 +1,177 @@
+#!/usr/bin/perl -w
+
+use strict;
+use warnings;
+
+use Test::More;
+use Errno qw/ENOENT/;
+
+use Test::MockFile qw< nostrict >;
+
+# IO::File is loaded by Test::MockFile itself, so it's available.
+# The key issue: IO::File::open() uses CORE::open which bypasses CORE::GLOBAL::open.
+
+note "-------------- IO::File->new with mocked file --------------";
+{
+    my $mock = Test::MockFile->file( '/fake/iofile_test', "hello world\n" );
+
+    my $fh = IO::File->new( '/fake/iofile_test', 'r' );
+    ok( defined $fh, "IO::File->new opens a mocked file" );
+    if ($fh) {
+        my $line = <$fh>;
+        is( $line, "hello world\n", " ... reads correct content" );
+        is( <$fh>, undef,           " ... EOF" );
+        $fh->close;
+    }
+}
+
+note "-------------- IO::File->new read mode (default) --------------";
+{
+    my $mock = Test::MockFile->file( '/fake/iofile_default', "line1\nline2\n" );
+
+    my $fh = IO::File->new('/fake/iofile_default');
+    ok( defined $fh, "IO::File->new with bare filename opens mocked file" );
+    if ($fh) {
+        my @lines = <$fh>;
+        is_deeply( \@lines, [ "line1\n", "line2\n" ], " ... reads all lines" );
+        $fh->close;
+    }
+}
+
+note "-------------- IO::File->new with explicit read mode '<' --------------";
+{
+    my $mock = Test::MockFile->file( '/fake/iofile_read', "content here\n" );
+
+    my $fh = IO::File->new( '/fake/iofile_read', '<' );
+    ok( defined $fh, "IO::File->new with '<' mode opens mocked file" );
+    if ($fh) {
+        my $line = <$fh>;
+        is( $line, "content here\n", " ... reads correct content" );
+        $fh->close;
+    }
+}
+
+note "-------------- IO::File->new with write mode 'w' --------------";
+{
+    my $mock = Test::MockFile->file( '/fake/iofile_write', '' );
+
+    my $fh = IO::File->new( '/fake/iofile_write', 'w' );
+    ok( defined $fh, "IO::File->new with 'w' mode opens mocked file" );
+    if ($fh) {
+        print $fh "written via IO::File\n";
+        $fh->close;
+    }
+
+    is( $mock->contents(), "written via IO::File\n", " ... content was written to mock" );
+}
+
+note "-------------- IO::File->new with append mode 'a' --------------";
+{
+    my $mock = Test::MockFile->file( '/fake/iofile_append', "existing\n" );
+
+    my $fh = IO::File->new( '/fake/iofile_append', 'a' );
+    ok( defined $fh, "IO::File->new with 'a' mode opens mocked file" );
+    if ($fh) {
+        print $fh "appended\n";
+        $fh->close;
+    }
+
+    is( $mock->contents(), "existing\nappended\n", " ... content was appended" );
+}
+
+note "-------------- IO::File->new with read-write mode 'r+' --------------";
+{
+    my $mock = Test::MockFile->file( '/fake/iofile_rw', "original\n" );
+
+    my $fh = IO::File->new( '/fake/iofile_rw', 'r+' );
+    ok( defined $fh, "IO::File->new with 'r+' mode opens mocked file" );
+    if ($fh) {
+        my $line = <$fh>;
+        is( $line, "original\n", " ... reads existing content" );
+        $fh->close;
+    }
+}
+
+note "-------------- IO::File->new on non-existent mock --------------";
+{
+    my $mock = Test::MockFile->file('/fake/iofile_noexist');
+
+    my $fh = IO::File->new( '/fake/iofile_noexist', 'r' );
+    ok( !defined $fh, "IO::File->new returns undef for non-existent mock" );
+}
+
+note "-------------- IO::File->new with numeric sysopen mode --------------";
+{
+    use Fcntl qw/O_RDONLY O_WRONLY O_CREAT O_TRUNC/;
+
+    my $mock = Test::MockFile->file( '/fake/iofile_sysopen', "sysopen data\n" );
+
+    my $fh = IO::File->new( '/fake/iofile_sysopen', O_RDONLY );
+    ok( defined $fh, "IO::File->new with O_RDONLY opens mocked file" );
+    if ($fh) {
+        my $line = <$fh>;
+        is( $line, "sysopen data\n", " ... reads correct content via sysopen" );
+        $fh->close;
+    }
+}
+
+note "-------------- IO::File->open method on existing object --------------";
+{
+    my $mock = Test::MockFile->file( '/fake/iofile_method', "method test\n" );
+
+    my $fh = IO::File->new;
+    ok( defined $fh, "IO::File->new creates empty handle" );
+
+    my $result = $fh->open( '/fake/iofile_method', 'r' );
+    ok( $result, " ... open method succeeds on mocked file" );
+    if ($result) {
+        my $line = <$fh>;
+        is( $line, "method test\n", " ... reads correct content" );
+        $fh->close;
+    }
+}
+
+note "-------------- IO::File with 2-arg embedded mode --------------";
+{
+    my $mock = Test::MockFile->file( '/fake/iofile_2arg', '' );
+
+    my $fh = IO::File->new('>/fake/iofile_2arg');
+    ok( defined $fh, "IO::File->new with '>/path' opens mocked file for write" );
+    if ($fh) {
+        print $fh "two-arg write\n";
+        $fh->close;
+    }
+
+    is( $mock->contents(), "two-arg write\n", " ... content was written" );
+}
+
+note "-------------- IO::File with write+truncate via sysopen mode --------------";
+{
+    my $mock = Test::MockFile->file( '/fake/iofile_trunc', "old data" );
+
+    my $fh = IO::File->new( '/fake/iofile_trunc', O_WRONLY | O_TRUNC );
+    ok( defined $fh, "IO::File->new with O_WRONLY|O_TRUNC opens mocked file" );
+    if ($fh) {
+        print $fh "new";
+        $fh->close;
+    }
+
+    is( $mock->contents(), "new", " ... old content was truncated" );
+}
+
+note "-------------- IO::File getline method on mocked file --------------";
+{
+    my $mock = Test::MockFile->file( '/fake/iofile_getline', "first\nsecond\nthird\n" );
+
+    my $fh = IO::File->new( '/fake/iofile_getline', 'r' );
+    ok( defined $fh, "IO::File->new opens for getline test" );
+    if ($fh) {
+        is( $fh->getline, "first\n",  " ... getline returns first line" );
+        is( $fh->getline, "second\n", " ... getline returns second line" );
+        is( $fh->getline, "third\n",  " ... getline returns third line" );
+        is( $fh->getline, undef,      " ... getline returns undef at EOF" );
+        $fh->close;
+    }
+}
+
+done_testing();