From 490390f9411389b2669c9fac9b2ecea96d0e8137 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C5=8Dan?= Date: Mon, 11 May 2026 04:31:41 -0600 Subject: [PATCH 1/2] feat: add text/binary options to stat_as_* helpers for -T/-B mock support When using mock_all_from_stat(), -T and -B checks rely on Perl's content-based heuristic which cannot work for files that don't exist on disk. This adds text/binary options to all stat_as_* helpers so users can control -T/-B results declaratively: return stat_as_file( size => 100, text => 1 ); # -T true, -B false return stat_as_file( size => 200, binary => 1 ); # -T false, -B true Specifying one option infers the other (they are complementary). When neither is given, behavior is unchanged (falls back to heuristic). Implementation uses a save/restore pattern for the metadata side-channel, consistent with existing re-entrancy handling in _check_from_stat. Co-Authored-By: Claude Opus 4.6 --- lib/Overload/FileCheck.pm | 71 +++++++++++++++-- t/stat-text-binary.t | 155 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 221 insertions(+), 5 deletions(-) create mode 100644 t/stat-text-binary.t diff --git a/lib/Overload/FileCheck.pm b/lib/Overload/FileCheck.pm index 5034976..813b5f9 100644 --- a/lib/Overload/FileCheck.pm +++ b/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, 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 or C options +to any C 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: pass C or C options to C 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 diff --git a/t/stat-text-binary.t b/t/stat-text-binary.t new file mode 100644 index 0000000..5d7bcd9 --- /dev/null +++ b/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; From 8dd5863c59833b4270e95392ab482bec4c7325c2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C5=8Dan?= Date: Fri, 15 May 2026 06:35:09 -0600 Subject: [PATCH 2/2] ci: add cpanm fallback when cpm is unavailable Older perldocker/perl-tester images (5.10-5.22) no longer ship cpm pre-installed, causing CI failures on all PR branches. Fall back to cpanm --installdeps when cpm is not found. Co-Authored-By: Claude Opus 4.6 --- .github/workflows/testsuite.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/testsuite.yml b/.github/workflows/testsuite.yml index 8af84cc..b3673de 100644 --- a/.github/workflows/testsuite.yml +++ b/.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