diff --git a/lib/Overload/FileCheck.pm b/lib/Overload/FileCheck.pm index 5034976..b0180e5 100644 --- a/lib/Overload/FileCheck.pm +++ b/lib/Overload/FileCheck.pm @@ -356,7 +356,15 @@ sub _check_from_stat { k => sub { _xs_unmock_op($optype); _to_bool( scalar -k _ ) }, # sticky bit # Heuristic text/binary checks (use glob _ to pass the cached stat) - T => sub { return CHECK_IS_NULL unless @stat; _xs_unmock_op($optype); _to_bool( scalar -T *_ ) }, # ASCII or UTF-8 text (heuristic) + T => sub { # ASCII or UTF-8 text (heuristic) + return CHECK_IS_NULL unless @stat; # file not found + # Directories are always "text" in Perl (like -B, which also + # returns true for dirs). Short-circuit to avoid opening a + # possibly non-existent path on disk for the heuristic check. + return CHECK_IS_TRUE if _check_mode_type( $stat[ST_MODE], S_IFDIR ) == CHECK_IS_TRUE; + _xs_unmock_op($optype); + return _to_bool( scalar -T *_ ); + }, B => sub { # binary file (opposite of -T) return CHECK_IS_NULL unless @stat; # file not found # Check directory via mode bits directly instead of calling the @@ -368,7 +376,7 @@ sub _check_from_stat { # Existence and size (computed directly from cached stat) e => sub { return CHECK_IS_NULL unless scalar @stat; CHECK_IS_TRUE }, # file exists (stat success implies existence) - s => sub { $stat[ST_SIZE] }, # nonzero size (returns bytes); fallback breaks on symlinks + s => sub { return CHECK_IS_NULL unless @stat; $stat[ST_SIZE] }, # nonzero size (returns bytes); fallback breaks on symlinks # File type checks via mode bits (using @stat — follows symlinks) f => sub { _check_mode_type( $stat[ST_MODE], S_IFREG ) }, # plain file diff --git a/t/T-directory-check.t b/t/T-directory-check.t new file mode 100644 index 0000000..aeee15f --- /dev/null +++ b/t/T-directory-check.t @@ -0,0 +1,68 @@ +#!/usr/bin/perl -w + +# Verify that the -T handler in _check_from_stat correctly short-circuits +# for directories (returning true) without attempting to open the path on +# disk for a heuristic check. This matches the -B handler behavior — +# in Perl, both -T and -B return true for directories. + +use strict; +use warnings; + +use Test2::Bundle::Extended; +use Test2::Tools::Explain; +use Test2::Plugin::NoWarnings; + +use Overload::FileCheck q(:all); + +my $stat_call_count = 0; + +mock_all_from_stat( + sub { + my ( $op, $file ) = @_; + + return FALLBACK_TO_REAL_OP unless defined $file; + return FALLBACK_TO_REAL_OP unless $file =~ m{^MOCK/}; + + $stat_call_count++; + + if ( $file eq 'MOCK/a-directory' ) { + return stat_as_directory(); + } + + if ( $file eq 'MOCK/regular-file' ) { + return stat_as_file( size => 100 ); + } + + return []; # file not found + } +); + +# -T on a mocked directory: should return true (directories are "text" in Perl) +# and should NOT attempt to open the path for heuristic content check +$stat_call_count = 0; +my $result = -T 'MOCK/a-directory'; +is $stat_call_count, 1, '-T on directory triggers stat callback exactly once'; +ok $result, '-T on directory returns true (Perl convention: dirs are text)'; + +# -B on a mocked directory: same behavior for symmetry verification +$stat_call_count = 0; +$result = -B 'MOCK/a-directory'; +is $stat_call_count, 1, '-B on directory triggers stat callback exactly once'; +ok $result, '-B on directory returns true'; + +# -T on a non-existent mocked file: should return undef (CHECK_IS_NULL) +$stat_call_count = 0; +$result = -T 'MOCK/no-such-file'; +is $stat_call_count, 1, '-T on non-existent file triggers stat callback exactly once'; +ok !defined($result) || !$result, '-T on non-existent file is falsy'; + +# -s on a non-existent mocked file: should return undef (CHECK_IS_NULL) +$stat_call_count = 0; +$result = -s 'MOCK/no-such-file'; +is $stat_call_count, 1, '-s on non-existent file triggers stat callback exactly once'; +ok !defined($result), '-s on non-existent file returns undef'; + +unmock_all_file_checks(); +unmock_stat(); + +done_testing;