From 852baa1ff7173968dc9d57fa31d94139f80d6f32 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C5=8Dan?= Date: Mon, 11 May 2026 06:24:19 -0600 Subject: [PATCH] feat: add is_mocked() and get_mocked_checks() introspection API Users had no way to query which file checks are currently mocked without trying to mock and catching the croak. These two functions expose mock state for debugging and conditional test logic. Co-Authored-By: Claude Opus 4.6 --- lib/Overload/FileCheck.pm | 40 +++++++++++++++++++ t/introspection.t | 81 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 121 insertions(+) create mode 100644 t/introspection.t diff --git a/lib/Overload/FileCheck.pm b/lib/Overload/FileCheck.pm index 5034976..2574687 100644 --- a/lib/Overload/FileCheck.pm +++ b/lib/Overload/FileCheck.pm @@ -60,6 +60,8 @@ my @CHECK_STATUS = qw{CHECK_IS_FALSE CHECK_IS_TRUE CHECK_IS_NULL FALLBACK_TO_REA my @STAT_HELPERS = qw{ stat_as_directory stat_as_file stat_as_symlink stat_as_socket stat_as_chr stat_as_block stat_as_fifo}; +my @INTROSPECTION = qw{ is_mocked get_mocked_checks }; + our @EXPORT_OK = ( qw{ mock_all_from_stat @@ -69,6 +71,7 @@ our @EXPORT_OK = ( @CHECK_STATUS, @STAT_T_IX, @STAT_HELPERS, + @INTROSPECTION, ); our %EXPORT_TAGS = ( @@ -454,6 +457,21 @@ sub unmock_all_file_checks { return unmock_file_check(@mocks); } +sub is_mocked { + my ($check) = @_; + + my ( undef, $optype ) = _resolve_check($check); + + return exists $_current_mocks->{$optype} ? 1 : 0; +} + +sub get_mocked_checks { + return sort + grep { $_ !~ qr{^l?stat$} } + map { $REVERSE_MAP{$_} } + keys %$_current_mocks; +} + # should not be called directly # this is called from XS to check if one OP is mocked # and trigger the callback function when mocked @@ -1053,6 +1071,28 @@ By a simple call to unmock_all_file_checks, you would disable the effect of over filecheck OPs. (not that the XS code is still plugged in, but fallback as soon as possible to the original OP) +=head2 is_mocked( $check ) + +Returns true if the given file check operator is currently mocked, false otherwise. +The leading dash is optional. + + if ( is_mocked('-e') ) { + # -e is currently mocked + } + +This also works for C and C: + + if ( is_mocked('stat') ) { ... } + +=head2 get_mocked_checks() + +Returns a sorted list of file check operator names (without dash) that are currently +mocked. C and C are excluded from the list — use C +to check those. + + my @checks = get_mocked_checks(); + # e.g. ('B', 'T', 'e', 'f') + =head2 mock_stat( CODE ) mock_stat provides one interface to setup a hook for all C and C calls. diff --git a/t/introspection.t b/t/introspection.t new file mode 100644 index 0000000..16d7804 --- /dev/null +++ b/t/introspection.t @@ -0,0 +1,81 @@ +#!perl + +use strict; +use warnings; + +use Test2::Bundle::Extended; +use Test2::Tools::Explain; + +use Overload::FileCheck qw(:all); + +# ---- is_mocked ---- + +ok( !is_mocked('-e'), '-e is not mocked initially' ); +ok( !is_mocked('e'), 'also works without leading dash' ); +ok( !is_mocked('stat'), 'stat is not mocked initially' ); + +mock_file_check( '-e' => sub { CHECK_IS_TRUE } ); +ok( is_mocked('-e'), '-e is mocked after mock_file_check' ); +ok( is_mocked('e'), 'is_mocked works without dash too' ); +ok( !is_mocked('-f'), '-f is still not mocked' ); + +unmock_file_check('-e'); +ok( !is_mocked('-e'), '-e is no longer mocked after unmock' ); + +# ---- get_mocked_checks ---- + +is( [ get_mocked_checks() ], [], 'no checks mocked initially' ); + +mock_file_check( '-f' => sub { CHECK_IS_TRUE } ); +mock_file_check( '-e' => sub { CHECK_IS_TRUE } ); + +is( [ get_mocked_checks() ], [ 'e', 'f' ], 'returns sorted list of mocked checks' ); + +unmock_file_check('-e'); +is( [ get_mocked_checks() ], [ 'f' ], 'list updates after unmock' ); + +unmock_file_check('-f'); +is( [ get_mocked_checks() ], [], 'empty after all unmocked' ); + +# ---- stat/lstat exclusion from get_mocked_checks ---- + +mock_stat( sub { FALLBACK_TO_REAL_OP } ); +ok( is_mocked('stat'), 'stat is mocked after mock_stat' ); +ok( is_mocked('lstat'), 'lstat is mocked after mock_stat' ); +is( [ get_mocked_checks() ], [], 'stat/lstat excluded from get_mocked_checks' ); + +unmock_stat(); +ok( !is_mocked('stat'), 'stat unmocked' ); +ok( !is_mocked('lstat'), 'lstat unmocked' ); + +# ---- mock_all_from_stat ---- + +mock_all_from_stat( sub { FALLBACK_TO_REAL_OP } ); +ok( is_mocked('-e'), '-e is mocked via mock_all_from_stat' ); +ok( is_mocked('-f'), '-f is mocked via mock_all_from_stat' ); +ok( is_mocked('-d'), '-d is mocked via mock_all_from_stat' ); +ok( is_mocked('stat'), 'stat is mocked via mock_all_from_stat' ); + +my @checks = get_mocked_checks(); +ok( scalar @checks > 20, 'mock_all_from_stat mocks many checks (got ' . scalar(@checks) . ')' ); + +unmock_all_file_checks(); +is( [ get_mocked_checks() ], [], 'all cleared after unmock_all_file_checks' ); + +# ---- guard interaction ---- + +{ + my $guard = mock_file_check_guard( '-d' => sub { CHECK_IS_TRUE } ); + ok( is_mocked('-d'), '-d is mocked inside guard scope' ); +} +ok( !is_mocked('-d'), '-d is unmocked after guard goes out of scope' ); + +# ---- invalid check ---- + +like( + dies { is_mocked('-Q') }, + qr/Unknown check/, + 'is_mocked croaks on unknown check' +); + +done_testing;