t/70-threads/threads.t

   1 #!perl
   2
   3 use strict;
   4 use warnings;
   5
   6 sub skipall {
   7  my ($msg) = @_;
   8  require Test::More;
   9  Test::More::plan(skip_all => $msg);
  10 }
  11
  12 use Config qw<%Config>;
  13
  14 BEGIN {
  15  my $force = $ENV{PERL_RE_ENGINE_PLUGIN_TEST_THREADS} ? 1 : !1;
  16  my $t_v   = $force ? '0' : '1.67';
  17  my $ts_v  = $force ? '0' : '1.14';
  18  skipall 'This perl wasn\'t built to support threads'
  19                                                     unless $Config{useithreads};
  20  skipall 'perl 5.13.4 required to test thread safety'
  21                                                 unless $force or $] >= 5.013004;
  22  skipall "threads $t_v required to test thread safety"
  23                                               unless eval "use threads $t_v; 1";
  24  skipall "threads::shared $ts_v required to test thread safety"
  25                                      unless eval "use threads::shared $ts_v; 1";
  26 }
  27
  28 use Test::More; # after threads
  29
  30 my $threads;
  31 BEGIN { $threads = 10 }
  32
  33 BEGIN {
  34  require re::engine::Plugin;
  35  skipall 'This re::engine::Plugin isn\'t thread safe'
  36                                     unless re::engine::Plugin::REP_THREADSAFE();
  37  plan tests => 2 * 2 * $threads + 1;
  38  defined and diag "Using threads $_"         for $threads::VERSION;
  39  defined and diag "Using threads::shared $_" for $threads::shared::VERSION;
  40 }
  41
  42 my $matches : shared = '';
  43
  44 use re::engine::Plugin comp => sub {
  45  my ($re) = @_;
  46
  47  my $pat = $re->pattern;
  48
  49  $re->callbacks(
  50   exec => sub {
  51    my ($re, $str) = @_;
  52
  53    {
  54     lock $matches;
  55     $matches .= "$str==$pat\n";
  56    }
  57
  58    return $str == $pat;
  59   },
  60  );
  61 };
  62
  63 sub try {
  64  my $tid = threads->tid;
  65
  66  my $rx = qr/$tid/;
  67
  68  ok $tid =~ $rx, "'$tid' is matched in thread $tid";
  69
  70  my $wrong = $tid + 1;
  71  ok $wrong !~ $rx, "'$wrong' is not matched in thread $tid";
  72
  73  return;
  74 }
  75
  76 no re::engine::Plugin;
  77
  78 my @tids = map threads->create(\&try), 1 .. $threads;
  79
  80 $_->join for @tids;
  81
  82 my %matches = map { $_ => 1 }
  83                grep length,
  84                 split /\n/,
  85                  do { lock $matches; $matches };
  86
  87 is keys(%matches), 2 * $threads, 'regexps matched the correct number of times';
  88
  89 for my $i (1 .. $threads) {
  90  ok $matches{"$i==$i"}, "match '$i==$i' was correctly executed";
  91  my $j = $i + 1;
  92  ok $matches{"$j==$i"}, "match '$j==$i' was correctly executed";
  93 }