Test "no indirect 'global'" with threads
[perl/modules/indirect.git] / t / 42-threads-global.t
1 #!perl -T
2
3 use strict;
4 use warnings;
5
6 use lib 't/lib';
7 use indirect::TestThreads;
8
9 use Test::Leaner;
10
11 sub expect {
12  my ($pkg) = @_;
13  qr/^Indirect call of method "new" on object "$pkg" at \(eval \d+\) line \d+/;
14 }
15
16 my $error;
17
18 no indirect 'global', 'hook' => sub { $error = indirect::msg(@_) };
19
20 sub try {
21  my $tid = threads->tid();
22
23  for my $run (1 .. 2) {
24   my $desc  = "global indirect hook (thread $tid, run $run)";
25   my $class = "Mango$tid";
26   my @warns;
27   {
28    local $SIG{__WARN__} = sub { push @warns, @_ };
29    eval "return; my \$x = new $class 1, 2;"
30   }
31   is        $@,      '',             "$desc: did not croak";
32   is_deeply \@warns, [ ],            "$desc: no warnings";
33   like      $error,  expect($class), "$desc: correct error";
34  }
35 }
36
37 my @threads = map spawn(\&try), 1 .. 10;
38
39 $_->join for @threads;
40
41 done_testing(scalar(@threads) * 3 * 2);