fix: reset Perl-level mock state in ithreads CLONE

.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

FileCheck.xs

@@ -532,6 +532,27 @@ mock_op(optype)
      RETVAL
 
 
+int
+_xs_is_mocked(optype)
+     SV* optype;
+CODE:
+{
+     dMY_CXT;
+     int opid;
+
+     if ( ! SvIOK(optype) )
+       croak("first argument to _xs_is_mocked must be one integer");
+
+     opid = SvIV( optype );
+     if ( !opid || opid < 0 || opid >= OP_MAX )
+         croak( "Invalid opid value %d", opid );
+
+     RETVAL = gl_overload_ft->op[opid].is_mocked;
+}
+OUTPUT:
+    RETVAL
+
+
 SV*
 get_basetime()
 CODE:
@@ -650,6 +671,10 @@ CODE:
             /* is_mocked stays 0 from Newxz */
         }
     }
+    /* Perl-level state ($_current_mocks) is reset lazily in
+     * mock_file_check() via _xs_is_mocked() check, rather than
+     * here, because call_pv() during CLONE is unreliable on
+     * some Perl builds. */
 }
 
 #endif

lib/Overload/FileCheck.pm

@@ -235,7 +235,16 @@ sub mock_file_check {
     Carp::croak(q[Second arg must be a CODE ref]) unless ref $sub eq 'CODE';
 
     my ( $name, $optype ) = _resolve_check($check);
-    Carp::croak(qq[-$name is already mocked by Overload::FileCheck]) if exists $_current_mocks->{$optype};
+
+    if ( exists $_current_mocks->{$optype} ) {
+        # In ithreads, the Perl hash may carry stale entries from the
+        # parent thread while the XS layer has already reset is_mocked.
+        # Check the actual XS state before croaking.
+        if ( _xs_is_mocked($optype) ) {
+            Carp::croak(qq[-$name is already mocked by Overload::FileCheck]);
+        }
+        delete $_current_mocks->{$optype};
+    }
 
     $_current_mocks->{$optype} = $sub;
 

t/ithreads-clone.t

@@ -0,0 +1,71 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Config;
+use Test2::V0;
+
+BEGIN {
+    plan skip_all => 'This perl is not built with ithreads support'
+        unless $Config{useithreads};
+}
+
+use threads;
+use Overload::FileCheck qw(:check mock_file_check unmock_file_check);
+
+# -- Parent thread mocks -e --------------------------------------------------
+
+mock_file_check(
+    '-e' => sub {
+        my ($file) = @_;
+        return CHECK_IS_TRUE if $file eq '/parent/file';
+        return FALLBACK_TO_REAL_OP;
+    }
+);
+
+ok( -e '/parent/file', '-e mock works in parent thread' );
+
+# -- Child thread can re-mock independently -----------------------------------
+
+my $thr = threads->create(sub {
+    # The XS CLONE resets is_mocked=0, and _clone_init clears
+    # $_current_mocks.  So the child should be able to mock -e
+    # without getting "already mocked" error.
+
+    my $can_mock = eval {
+        mock_file_check(
+            '-e' => sub {
+                my ($file) = @_;
+                return CHECK_IS_TRUE if $file eq '/child/file';
+                return FALLBACK_TO_REAL_OP;
+            }
+        );
+        1;
+    };
+
+    my $mock_error = $@;
+    my $child_works = $can_mock ? ( -e '/child/file' ? 1 : 0 ) : 0;
+
+    # Parent's mock should not be active in child
+    my $parent_leaked = -e '/parent/file' ? 1 : 0;
+
+    unmock_file_check('-e') if $can_mock;
+
+    return ( $can_mock, $mock_error, $child_works, $parent_leaked );
+});
+
+my ( $can_mock, $mock_error, $child_works, $parent_leaked ) = $thr->join;
+
+ok( $can_mock, 'child thread can mock_file_check without "already mocked" error' )
+    or diag("mock error: $mock_error");
+ok( $child_works, 'child thread mock returns correct value' );
+ok( !$parent_leaked, 'parent mock state does not leak into child thread' );
+
+# -- Parent mock still works after child exits --------------------------------
+
+ok( -e '/parent/file', 'parent mock unaffected by child thread' );
+
+unmock_file_check('-e');
+
+done_testing;