view release on metacpan or  search on metacpan

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

use v5.40;
use lib '../lib', 'lib';
use blib;
use Test2::Tools::Affix qw[:all];
use Affix               qw[:all];
use Config;
#
$|++;
#
subtest 'os threads' => sub {
    typedef Callback_t => Callback [ [Int] => Void ];
    typedef ThreadTask => Struct [ cb   => Callback_t(), val  => Int ];
    typedef TaskNode   => Struct [ task => ThreadTask(), next => Pointer [ ThreadTask() ] ];
    typedef TaskQueue =>
        Struct [ head => Pointer [ TaskNode() ], tail => Pointer [ TaskNode() ], lock => Pointer [Void], cond => Pointer [Void], stop => Int ];
    typedef ThreadPool => Struct [
        threads         => Pointer [Void],
        thread_count    => Int,
        task_queue      => TaskQueue(),
        pool_lock       => Pointer [Void],
        task_available  => Pointer [Void],
        active_threads  => Int,
        tasks_remaining => Int
    ];
    my $c_source = <<~'C';
        #include "std.h"
        //ext: .c
        #if _WIN32
        #include <windows.h>
        #else
        #include <pthread.h>
        #include <unistd.h>
        #endif
        #include <stdlib.h>

        typedef void (*callback_t)(int);

        typedef struct {
            callback_t cb;
            int val;
        } ThreadArgs;

        #if _WIN32
        unsigned __stdcall
        #else
        void *
        #endif
        thread_func(void* arg) {
            ThreadArgs* args = (ThreadArgs*)arg;
            // Brief sleep to ensure we aren't just getting lucky on the main thread stack
            usleep(2000000);
            // 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;