]> git.vpit.fr Git - perl/modules/indirect.git/blob - t/40-threads.t
Don't actually create an entry when storing NULL in the ptable
[perl/modules/indirect.git] / t / 40-threads.t
1 #!perl -T
2
3 use strict;
4 use warnings;
5
6 use Config qw/%Config/;
7
8 BEGIN {
9  if (!$Config{useithreads}) {
10   require Test::More;
11   Test::More->import;
12   plan(skip_all => 'This perl wasn\'t built to support threads');
13  }
14 }
15
16 use threads;
17
18 use Test::More;
19
20 BEGIN {
21  require indirect;
22  if (indirect::I_THREADSAFE()) {
23   plan tests => 10 * 2 * (2 + 3);
24   defined and diag "Using threads $_" for $threads::VERSION;
25  } else {
26   plan skip_all => 'This indirect isn\'t thread safe';
27  }
28 }
29
30 sub expect {
31  my ($pkg) = @_;
32  return qr/^Indirect\s+call\s+of\s+method\s+"new"\s+on\s+object\s+"$pkg"\s+at\s+\(eval\s+\d+\)\s+line\s+\d+/;
33 }
34
35 {
36  no indirect;
37
38  sub try {
39   my $tid = threads->tid();
40
41   for (1 .. 2) {
42    {
43     my $class = "Coconut$tid";
44     my @warns;
45     {
46      local $SIG{__WARN__} = sub { push @warns, "@_" };
47      eval 'die "the code compiled but it shouldn\'t have\n";
48            no indirect ":fatal"; my $x = new ' . $class . ' 1, 2;';
49     }
50     like         $@ || '', expect($class),
51                       "\"no indirect\" in eval in thread $tid died as expected";
52     is_deeply \@warns, [ ],
53                       "\"no indirect\" in eval in thread $tid didn't warn";
54    }
55
56 SKIP:
57    {
58     skip 'Hints aren\'t propagated into eval STRING below perl 5.10' => 3
59                                                              unless $] >= 5.010;
60     my $class = "Pineapple$tid";
61     my @warns;
62     {
63      local $SIG{__WARN__} = sub { push @warns, "@_" };
64      eval 'die "ok\n"; my $y = new ' . $class . ' 1, 2;';
65     }
66     is             $@, "ok\n",
67     my $first = shift @warns;
68     like $first || '', expect($class),
69               "\"no indirect\" propagated into eval in thread $tid warned once";
70     is_deeply \@warns, [ ],
71          "\"no indirect\" propagated into eval in thread $tid warned just once";
72    }
73   }
74  }
75 }
76
77 my @t = map threads->create(\&try), 1 .. 10;
78 $_->join for @t;