]> git.vpit.fr Git - perl/modules/re-engine-Plugin.git/blob - t/70-threads/threads.t
Stop leaking the stash
[perl/modules/re-engine-Plugin.git] / 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.013_004;
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 }