diff --git a/lib/Test/MockFile.pm b/lib/Test/MockFile.pm index 86e3781..6703ddc 100644 --- a/lib/Test/MockFile.pm +++ b/lib/Test/MockFile.pm @@ -982,6 +982,60 @@ sub file_from_disk { return __PACKAGE__->file( $file, $contents, @stats ); } +=head2 file_passthrough + +Args: C<($file)> + +Registers C<$file> with Test::MockFile but delegates B file +operations (C, C, C<-f>, etc.) to the real filesystem. +The path is not actually mocked: it is simply allowed through strict +mode so that XS-based modules (e.g. L, L) that +perform C-level I/O can create and use the file while Perl-level +checks remain consistent. + + use Test::MockFile; # strict mode by default + use DBI; + + my $mock = Test::MockFile->file_passthrough('/tmp/test.db'); + my $dbh = DBI->connect("dbi:SQLite:dbname=/tmp/test.db", "", ""); + + ok $dbh->ping, 'ping works'; + ok -f '/tmp/test.db', 'file exists on disk'; + +When the returned object goes out of scope, the strict-mode rule is +removed but the real file is B deleted. Clean up the file +yourself if needed: + + undef $mock; + unlink '/tmp/test.db'; + +=cut + +sub file_passthrough { + my ( $class, $file ) = @_; + + ( defined $file && length $file ) or confess("No file provided to instantiate $class"); + + my $path = _abs_path_to_file($file); + + # Build a strict-mode rule that allows all operations on this path. + my $rule = { + 'command_rule' => qr/.*/, + 'file_rule' => qr/^\Q$path\E$/, + 'action' => 1, + }; + push @STRICT_RULES, $rule; + + # We intentionally do NOT register in %files_being_mocked. + # This means _mock_stat, __open, etc. will all fall through to the + # real filesystem via FALLBACK_TO_REAL_OP / goto &CORE::*. + return bless { + 'path' => $path, + '_passthrough' => 1, + '_passthrough_rule' => $rule, + }, $class; +} + =head2 symlink Args: ($readlink, $file ) @@ -1762,6 +1816,14 @@ sub DESTROY { my $path = $self->{'path'}; defined $path or return; + # Passthrough mocks are not in %files_being_mocked — just remove + # the strict-mode rule that was created for them. + if ( $self->{'_passthrough'} ) { + my $rule = $self->{'_passthrough_rule'}; + @STRICT_RULES = grep { $_ != $rule } @STRICT_RULES if $rule; + return; + } + # Clean up autovivify tracking delete $_autovivify_dirs{$path}; diff --git a/t/file_passthrough.t b/t/file_passthrough.t new file mode 100644 index 0000000..21bfcb5 --- /dev/null +++ b/t/file_passthrough.t @@ -0,0 +1,148 @@ +#!/usr/bin/perl -w + +use strict; +use warnings; + +use Test2::Bundle::Extended; +use Test2::Tools::Explain; +use Test2::Plugin::NoWarnings; + +# Create temp dir BEFORE loading Test::MockFile to avoid +# File::Temp's internal stat/chmod hitting our overrides. +my $dir; +BEGIN { + $dir = "/tmp/tmf_passthrough_$$"; + CORE::mkdir( $dir, 0700 ) or die "Cannot create $dir: $!"; +} + +# Strict mode is the default — file_passthrough must work with it. +use Test::MockFile; + +subtest( + 'file_passthrough returns a mock object' => sub { + my $file = "$dir/basic.txt"; + + my $mock = Test::MockFile->file_passthrough($file); + isa_ok( $mock, ['Test::MockFile'], 'returns a Test::MockFile object' ); + } +); + +subtest( + 'file_passthrough delegates to real filesystem' => sub { + my $file = "$dir/delegate.txt"; + my $mock = Test::MockFile->file_passthrough($file); + + # File doesn't exist yet on real FS + ok( !-e $file, 'file does not exist yet on real FS' ); + + # Create the real file via Perl open (goes through CORE::GLOBAL::open override) + ok( open( my $fh, '>', $file ), 'can open file for writing via override' ); + print {$fh} "hello world\n"; + close $fh; + + # Perl-level checks should see the real file + ok( -e $file, '-e sees the real file' ); + ok( -f $file, '-f sees the real file' ); + ok( !-d $file, '-d correctly returns false' ); + + my $size = -s $file; + is( $size, 12, '-s returns correct size' ); + + # Can read back via Perl open + ok( open( my $fh2, '<', $file ), 'can open file for reading via override' ); + my $content = <$fh2>; + close $fh2; + is( $content, "hello world\n", 'content matches what was written' ); + + # stat works + my @stat = stat($file); + ok( scalar @stat, 'stat returns data' ); + is( $stat[7], 12, 'stat size is correct' ); + + # unlink works + ok( unlink($file), 'can unlink via override' ); + ok( !-e $file, 'file is gone after unlink' ); + } +); + +subtest( + 'file_passthrough coexists with regular mocks' => sub { + my $mocked_file = "$dir/regular.txt"; + my $pass_file = "$dir/pass.txt"; + + my $regular_mock = Test::MockFile->file( $mocked_file, "mocked content" ); + my $pass_mock = Test::MockFile->file_passthrough($pass_file); + + # Regular mock works as expected + ok( -f $mocked_file, 'regular mock file exists in mock world' ); + ok( open( my $fh, '<', $mocked_file ), 'can open regular mock' ); + my $content = <$fh>; + close $fh; + is( $content, "mocked content", 'regular mock has mocked content' ); + + # Passthrough falls through to real FS + ok( !-e $pass_file, 'passthrough file does not exist on disk yet' ); + + # Create real file for passthrough + ok( open( my $fh2, '>', $pass_file ), 'can write to passthrough path' ); + print {$fh2} "real content\n"; + close $fh2; + + ok( -f $pass_file, 'passthrough file now exists on disk' ); + } +); + +subtest( + 'file_passthrough strict rule cleanup on scope exit' => sub { + my $file = "$dir/scoped.txt"; + + { + my $mock = Test::MockFile->file_passthrough($file); + + # Should be able to access the file without strict mode dying + ok( !-e $file, 'file does not exist (no strict violation)' ); + + # Create it + ok( open( my $fh, '>', $file ), 'can create file in passthrough scope' ); + print {$fh} "temporary\n"; + close $fh; + ok( -f $file, 'file exists while passthrough is alive' ); + + # Clean up the real file before mock goes out of scope + CORE::unlink($file); + } + + # After scope exit, accessing the unmocked file in strict mode should die + like( + dies { -e $file }, + qr/unmocked file/, + 'strict mode violation after passthrough goes out of scope', + ); + } +); + +subtest( + 'file_passthrough rejects undefined path' => sub { + like( + dies { Test::MockFile->file_passthrough(undef) }, + qr/No file provided/, + 'dies with undef path', + ); + + like( + dies { Test::MockFile->file_passthrough('') }, + qr/No file provided/, + 'dies with empty path', + ); + } +); + +done_testing(); + +# Cleanup — use CORE:: to bypass Test::MockFile strict mode +END { + if ( defined $dir ) { + CORE::unlink "$dir/$_" for qw(basic.txt delegate.txt regular.txt pass.txt scoped.txt); + CORE::rmdir $dir; + } +}