view release on metacpan or  search on metacpan

t/027_thread_safety.t  view on Meta::CPAN

            // Execute Perl callback from this foreign thread
            // This will SEGFAULT if Affix doesn't inject Perl context!
            args->cb(args->val);
            return 0;
        }

        void run_in_foreign_thread(callback_t cb, int val) {
        #if _WIN32
            ThreadArgs* args = (ThreadArgs*)malloc(sizeof(ThreadArgs));
            args->cb = cb;
            args->val = val;
            unsigned threadID;
            HANDLE hThread = (HANDLE)_beginthreadex(NULL, 0, &thread_func, args, 0, &threadID);
            // Block main thread to simulate WebUI/MainLoop behavior
            WaitForSingleObject(hThread, INFINITE);
            CloseHandle(hThread);
            free(args);
        #else
            pthread_t thread_id;
            ThreadArgs* args = (ThreadArgs*)malloc(sizeof(ThreadArgs));
            args->cb = cb;
            args->val = val;
            pthread_create(&thread_id, NULL, thread_func, args);
            // Block main thread to simulate WebUI/MainLoop behavior
            pthread_join(thread_id, NULL);
            free(args);
        #endif
        }
    C

    # Pass reference (\$c_source) so Affix::Build treats it as code, not a filename
    my $lib = compile_ok($c_source);
    ok $lib && -e $lib, 'Compiled a threaded test library';
    #
    ok affix( $lib, 'run_in_foreign_thread', [ Callback_t(), Int ] => Void ), 'affix run_in_foreign_thread';
    #
    my $ok_flag = 0;
    my $str;

    # This calls C, which spawns a thread, which calls this sub
    run_in_foreign_thread(
        sub ($val) {

            # Allocating memory here (creating SVs) tests the memory allocator context
            $str     = 'Received: ' . $val;
            $ok_flag = $val;
        },
        123
    );
    is $ok_flag, 123, 'Callback executed successfully from foreign thread without crashing';
    diag $str;
};
#
subtest ithreads => sub {
    skip_all 'No ithreads', 1 unless $Config{useithreads};
    require threads;

    # Test core affix cloning and usage across threads
    ok affix libc(), [ abs => 'absolute' ], [Int] => Int;
    is absolute(-42), 42, 'Main thread: absolute(-42) == 42';
    my @threads = map {
        threads->create(
            sub {
                my $tid = threads->tid();
                my $res = absolute( -100 * $tid );
                return $res == ( 100 * $tid );
            }
        )
    } 1 .. 5;
    for my $thr (@threads) {
        my $tid = $thr->tid();
        ok $thr->join(), "Thread $tid: absolute() worked correctly after cloning";
    }
};
#
done_testing();