feat: add text/binary options to stat_as_* for -T/-B mock support

.github/workflows/testsuite.yml

@@ -69,7 +69,7 @@ jobs:
       - uses: actions/checkout@v6
       - run: perl -V
       - name: Install Dependencies
-        run: cpm install -g --show-build-log-on-failure
+        run: cpm install -g --show-build-log-on-failure || cpanm --installdeps --notest .
       - run: perl Makefile.PL
       - run: make
       - run: make test

lib/Overload/FileCheck.pm

@@ -162,6 +162,11 @@ my %DEFAULT_ERRNO = (
 # optype_id => sub
 my $_current_mocks = {};
 
+# Side-channel for text/binary metadata from stat_as_* helpers.
+# Set by _stat_for() when text/binary options are present,
+# read by _check_from_stat() for -T/-B dispatch.
+my $_current_stat_meta;
+
 sub import {
     my ( $class, @args ) = @_;
 
@@ -308,7 +313,16 @@ sub _check_from_stat {
 
     my $stat_or_lstat = $use_lstat ? 'lstat' : 'stat';
 
+    # Save and reset stat metadata so that re-entrant calls
+    # (e.g. nested mock callbacks) don't clobber our value.
+    my $saved_stat_meta = $_current_stat_meta;
+    $_current_stat_meta = undef;
+
     my (@mocked_lstat_result) = $sub_for_stat->( $stat_or_lstat, $f_or_fh );
+
+    # Capture metadata set by stat_as_*() during the callback, then restore.
+    my $meta = $_current_stat_meta;
+    $_current_stat_meta = $saved_stat_meta;
     if (   scalar @mocked_lstat_result == 1
         && !ref $mocked_lstat_result[0]
         && $mocked_lstat_result[0] == FALLBACK_TO_REAL_OP ) {
@@ -355,10 +369,19 @@ sub _check_from_stat {
         g => sub { _xs_unmock_op($optype); _to_bool( scalar -g _ ) },    # setgid bit
         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)
-        B => sub {                                                         # binary file (opposite of -T)
+        # Heuristic text/binary checks.
+        # When stat_as_*() was called with text/binary options, use those
+        # directly instead of delegating to Perl's heuristic (which reads
+        # file content that doesn't exist for mocked files).
+        T => sub {
+            return CHECK_IS_NULL unless @stat;
+            return _to_bool( $meta->{text} ) if $meta && defined $meta->{text};
+            _xs_unmock_op($optype);
+            _to_bool( scalar -T *_ );
+        },
+        B => sub {
             return CHECK_IS_NULL unless @stat;                             # file not found
+            return _to_bool( $meta->{binary} ) if $meta && defined $meta->{binary};
             # Check directory via mode bits directly instead of calling the
             # mocked -d operator, which would trigger a redundant stat callback.
             return CHECK_IS_TRUE if _check_mode_type( $stat[ST_MODE], S_IFDIR ) == CHECK_IS_TRUE;
@@ -626,6 +649,19 @@ sub stat_as_fifo {
 sub _stat_for {
     my ( $type, $opts ) = @_;
 
+    # Extract text/binary metadata before option validation.
+    # These options control -T/-B behavior in mock_all_from_stat
+    # and are not part of the stat struct itself.
+    my $text   = delete $opts->{text};
+    my $binary = delete $opts->{binary};
+
+    if ( defined $text || defined $binary ) {
+        $_current_stat_meta = {
+            text   => $text   // ( defined $binary ? !$binary : undef ),
+            binary => $binary // ( defined $text   ? !$text   : undef ),
+        };
+    }
+
     my @stat = ( (0) x STAT_T_MAX );
 
     # set file type
@@ -980,6 +1016,21 @@ Available functions are:
 
 
 All of these functions take some optional arguments to set: uid, gid, perms, dev, ino, nlink, rdev, size, atime, mtime, ctime, blksize, blocks.
+
+=head3 text / binary options
+
+When using C<mock_all_from_stat>, the C<-T> and C<-B> file checks normally rely on Perl's
+content-based heuristic, which cannot work for files that don't actually exist on disk.
+To control the result of C<-T> and C<-B> for mocked files, pass C<text> or C<binary> options
+to any C<stat_as_*> helper:
+
+    return stat_as_file( size => 100, text => 1 );    # -T true,  -B false
+    return stat_as_file( size => 100, binary => 1 );   # -T false, -B true
+    return stat_as_file( size => 100, text => 0 );     # -T false, -B true
+
+Specifying one option automatically infers the other (they are complementary).
+When neither option is given, C<-T>/C<-B> fall back to Perl's built-in heuristic as before.
+
 Example:
 
     use Overload::FileCheck -from-stat => \&my_stat, q{:check};
@@ -1141,8 +1192,18 @@ You probably want to load and call the mock function of Overload::FileCheck as e
 =head2 -B and -T are using heuristics
 
 File check operators like -B and -T are using heuristics to guess if the file content is binary or text.
-By using mock_all_from_stat or ('-from-stat' at import time), we cannot provide an accurate -B or -T checks.
-You would need to provide a custom hooks for them
+By using mock_all_from_stat or ('-from-stat' at import time), the default behavior cannot provide accurate
+-B or -T checks for files that don't exist on disk.
+
+B<Recommended>: pass C<text> or C<binary> options to C<stat_as_*> helpers:
+
+    return stat_as_file( text => 1 );    # -T true, -B false
+    return stat_as_file( binary => 1 );  # -T false, -B true
+
+Alternatively, provide custom hooks for -T and -B:
+
+    mock_file_check( '-B' => sub { ... } );
+    mock_file_check( '-T' => sub { ... } );
 
 =head1 LICENSE
 

t/stat-text-binary.t

@@ -0,0 +1,155 @@
+#!/usr/bin/perl -w
+
+# Test text/binary options in stat_as_* helpers for -T/-B mock support.
+
+use strict;
+use warnings;
+
+use Test2::Bundle::Extended;
+use Test2::Tools::Explain;
+use Test2::Plugin::NoWarnings;
+
+use Overload::FileCheck q{:all};
+
+subtest 'stat_as_file with text => 1' => sub {
+    mock_all_from_stat(sub {
+        my ($op, $file) = @_;
+        return stat_as_file( size => 100, text => 1 ) if $file eq '/mock/script.pl';
+        return FALLBACK_TO_REAL_OP;
+    });
+
+    ok( -T '/mock/script.pl', '-T returns true for text file' );
+    ok( !-B '/mock/script.pl', '-B returns false for text file' );
+    ok( -e '/mock/script.pl', '-e still works' );
+    ok( -f '/mock/script.pl', '-f still works' );
+
+    unmock_all_file_checks();
+    unmock_stat();
+};
+
+subtest 'stat_as_file with binary => 1' => sub {
+    mock_all_from_stat(sub {
+        my ($op, $file) = @_;
+        return stat_as_file( size => 2048, binary => 1 ) if $file eq '/mock/image.png';
+        return FALLBACK_TO_REAL_OP;
+    });
+
+    ok( -B '/mock/image.png', '-B returns true for binary file' );
+    ok( !-T '/mock/image.png', '-T returns false for binary file' );
+
+    unmock_all_file_checks();
+    unmock_stat();
+};
+
+subtest 'stat_as_file with text => 0 (explicitly not text)' => sub {
+    mock_all_from_stat(sub {
+        my ($op, $file) = @_;
+        return stat_as_file( size => 100, text => 0 ) if $file eq '/mock/data.bin';
+        return FALLBACK_TO_REAL_OP;
+    });
+
+    ok( !-T '/mock/data.bin', '-T returns false when text => 0' );
+    ok( -B '/mock/data.bin', '-B returns true when text => 0 (inferred)' );
+
+    unmock_all_file_checks();
+    unmock_stat();
+};
+
+subtest 'stat_as_file with binary => 0 (explicitly not binary)' => sub {
+    mock_all_from_stat(sub {
+        my ($op, $file) = @_;
+        return stat_as_file( size => 50, binary => 0 ) if $file eq '/mock/readme.txt';
+        return FALLBACK_TO_REAL_OP;
+    });
+
+    ok( -T '/mock/readme.txt', '-T returns true when binary => 0 (inferred)' );
+    ok( !-B '/mock/readme.txt', '-B returns false when binary => 0' );
+
+    unmock_all_file_checks();
+    unmock_stat();
+};
+
+subtest 'text/binary on stat_as_directory' => sub {
+    mock_all_from_stat(sub {
+        my ($op, $file) = @_;
+        return stat_as_directory( text => 1 ) if $file eq '/mock/dir';
+        return FALLBACK_TO_REAL_OP;
+    });
+
+    ok( -d '/mock/dir', '-d still works for directory' );
+    ok( -T '/mock/dir', '-T returns true for directory with text => 1' );
+
+    unmock_all_file_checks();
+    unmock_stat();
+};
+
+subtest 'no text/binary falls back to default behavior' => sub {
+    mock_all_from_stat(sub {
+        my ($op, $file) = @_;
+        return stat_as_file( size => 100 ) if $file eq '/mock/plain';
+        return FALLBACK_TO_REAL_OP;
+    });
+
+    # Without text/binary options, -T/-B delegate to Perl's heuristic.
+    # For mocked non-existent files this may produce unexpected results,
+    # which is exactly the limitation text/binary options address.
+    # We just verify it doesn't crash.
+    my $t = eval { scalar -T '/mock/plain' };
+    my $b = eval { scalar -B '/mock/plain' };
+    pass('-T/-B without text/binary options did not crash');
+
+    unmock_all_file_checks();
+    unmock_stat();
+};
+
+subtest 'non-existent file returns undef for -T/-B' => sub {
+    mock_all_from_stat(sub {
+        my ($op, $file) = @_;
+        return [] if $file eq '/mock/gone';    # empty stat = file not found
+        return FALLBACK_TO_REAL_OP;
+    });
+
+    ok( !defined( -T '/mock/gone' ), '-T returns undef for non-existent file' );
+    ok( !defined( -B '/mock/gone' ), '-B returns undef for non-existent file' );
+
+    unmock_all_file_checks();
+    unmock_stat();
+};
+
+subtest 'multiple files with different text/binary settings' => sub {
+    mock_all_from_stat(sub {
+        my ($op, $file) = @_;
+        return stat_as_file( size => 100, text => 1 )   if $file eq '/mock/text';
+        return stat_as_file( size => 200, binary => 1 ) if $file eq '/mock/binary';
+        return stat_as_file( size => 50 )                if $file eq '/mock/unknown';
+        return FALLBACK_TO_REAL_OP;
+    });
+
+    ok(  -T '/mock/text',   '-T true for text file' );
+    ok( !-B '/mock/text',   '-B false for text file' );
+    ok( !-T '/mock/binary', '-T false for binary file' );
+    ok(  -B '/mock/binary', '-B true for binary file' );
+
+    unmock_all_file_checks();
+    unmock_stat();
+};
+
+subtest 'text/binary with stacked operators' => sub {
+    mock_all_from_stat(sub {
+        my ($op, $file) = @_;
+        return stat_as_file( size => 100, text => 1 ) if $file eq '/mock/perl.pl';
+        return FALLBACK_TO_REAL_OP;
+    });
+
+    # Stacked operators: -e && -T should both work
+    ok( -e '/mock/perl.pl' && -T '/mock/perl.pl', '-e && -T both true' );
+
+    # Size check combined with text check
+    is( -s '/mock/perl.pl', 100, '-s returns correct size' );
+    ok( -T '/mock/perl.pl', '-T still works after -s' );
+
+    unmock_all_file_checks();
+    unmock_stat();
+};
+
+done_testing;