The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl

use strict;
use warnings;

sub skipall {
 my ($msg) = @_;
 require Test::More;
 Test::More::plan(skip_all => $msg);
}

use Config qw<%Config>;

BEGIN {
 my $force = $ENV{PERL_RE_ENGINE_PLUGIN_TEST_THREADS} ? 1 : !1;
 my $t_v   = $force ? '0' : '1.67';
 my $ts_v  = $force ? '0' : '1.14';
 skipall 'This perl wasn\'t built to support threads'
                                                    unless $Config{useithreads};
 skipall 'perl 5.13.4 required to test thread safety'
                                             unless $force or "$]" >= 5.013_004;
 skipall "threads $t_v required to test thread safety"
                                              unless eval "use threads $t_v; 1";
 skipall "threads::shared $ts_v required to test thread safety"
                                     unless eval "use threads::shared $ts_v; 1";
}

use Test::More; # after threads

my $threads;
BEGIN { $threads = 10 }

BEGIN {
 require re::engine::Plugin;
 skipall 'This re::engine::Plugin isn\'t thread safe'
                                    unless re::engine::Plugin::REP_THREADSAFE();
 plan tests => 2 * 2 * $threads + 1;
 defined and diag "Using threads $_"         for $threads::VERSION;
 defined and diag "Using threads::shared $_" for $threads::shared::VERSION;
}

my $matches : shared = '';

use re::engine::Plugin comp => sub {
 my ($re) = @_;

 my $pat = $re->pattern;

 $re->callbacks(
  exec => sub {
   my ($re, $str) = @_;

   {
    lock $matches;
    $matches .= "$str==$pat\n";
   }

   return $str == $pat;
  },
 );
};

sub try {
 my $tid = threads->tid;

 my $rx = qr/$tid/;

 ok $tid =~ $rx, "'$tid' is matched in thread $tid";

 my $wrong = $tid + 1;
 ok $wrong !~ $rx, "'$wrong' is not matched in thread $tid";

 return;
}

no re::engine::Plugin;

my @tids = map threads->create(\&try), 1 .. $threads;

$_->join for @tids;

my %matches = map { $_ => 1 }
               grep length,
                split /\n/,
                 do { lock $matches; $matches };

is keys(%matches), 2 * $threads, 'regexps matched the correct number of times';

for my $i (1 .. $threads) {
 ok $matches{"$i==$i"}, "match '$i==$i' was correctly executed";
 my $j = $i + 1;
 ok $matches{"$j==$i"}, "match '$j==$i' was correctly executed";
}