]> git.vpit.fr Git - perl/modules/autovivification.git/blob - t/50-threads.t
Use the op free hook to clean up pointer table entries when available
[perl/modules/autovivification.git] / t / 50-threads.t
1 #!perl -T
2
3 use strict;
4 use warnings;
5
6 use lib 't/lib';
7 use autovivification::TestThreads;
8
9 use Test::Leaner;
10
11 my $threads = 10;
12 my $runs    = 2;
13
14 {
15  no autovivification;
16
17  sub try {
18   my $tid = threads->tid();
19
20   for my $run (1 .. $runs) {
21    {
22     my $x;
23     my $y = $x->{foo};
24     is $x, undef, "fetch does not autovivify at thread $tid run $run";
25    }
26    {
27     my $x;
28     my $y = exists $x->{foo};
29     is $x, undef, "exists does not autovivify at thread $tid run $run";
30    }
31    {
32     my $x;
33     my $y = delete $x->{foo};
34     is $x, undef, "delete does not autovivify at thread $tid run $run";
35    }
36
37 SKIP:
38    {
39     skip 'Hints aren\'t propagated into eval STRING below perl 5.10' => 3 * 2
40                                                            unless "$]" >= 5.010;
41     {
42      my $x;
43      eval 'my $y = $x->{foo}';
44      is $@, '',    "fetch in eval does not croak at thread $tid run $run";
45      is $x, undef, "fetch in eval does not autovivify at thread $tid run $run";
46     }
47     {
48      my $x;
49      eval 'my $y = exists $x->{foo}';
50      is $@, '',    "exists in eval does not croak at thread $tid run $run";
51      is $x, undef, "exists in eval does not autovivify at thread $tid run $run";
52     }
53     {
54      my $x;
55      eval 'my $y = delete $x->{foo}';
56      is $@, '',    "delete in eval does not croak at thread $tid run $run";
57      is $x, undef, "delete in eval does not autovivify at thread $tid run $run";
58     }
59    }
60   }
61  }
62 }
63
64 my @threads = map spawn(\&try), 1 .. $threads;
65
66 $_->join for @threads;
67
68 pass 'done';
69
70 done_testing(scalar(@threads) * $runs * 3 * (1 + 2) + 1);