Commit | Line | Data |
7473853a |
1 | use strict; |
13c1b207 |
2 | use warnings; |
3 | |
8eea0bff |
4 | BEGIN { |
7473853a |
5 | if ($ENV{'PERL_CORE'}){ |
6 | chdir 't'; |
7 | unshift @INC, '../lib'; |
8 | } |
9 | use Config; |
10 | if (! $Config{'useithreads'}) { |
11 | print("1..0 # Skip: Perl not compiled with 'useithreads'\n"); |
12 | exit(0); |
8eea0bff |
13 | } |
14 | } |
15 | |
7473853a |
16 | use ExtUtils::testlib; |
8eea0bff |
17 | |
18 | sub ok { |
19 | my ($id, $ok, $name) = @_; |
20 | |
21 | # You have to do it this way or VMS will get confused. |
7473853a |
22 | if ($ok) { |
23 | print("ok $id - $name\n"); |
24 | } else { |
25 | print("not ok $id - $name\n"); |
26 | printf("# Failed test at line %d\n", (caller)[2]); |
27 | } |
8eea0bff |
28 | |
7473853a |
29 | return ($ok); |
8eea0bff |
30 | } |
31 | |
7473853a |
32 | BEGIN { |
33 | $| = 1; |
34 | print("1..14\n"); ### Number of tests that will be run ### |
35 | }; |
36 | |
8eea0bff |
37 | use threads; |
38 | use threads::shared; |
7473853a |
39 | ok(1, 1, 'Loaded'); |
40 | |
41 | ### Start of Testing ### |
8eea0bff |
42 | |
43 | my $sv; |
44 | share($sv); |
45 | $sv = "hi"; |
7473853a |
46 | |
8eea0bff |
47 | my @av; |
48 | share(@av); |
7473853a |
49 | push(@av, $sv); |
50 | |
51 | ok(2, $av[0] eq "hi", 'Array holds value'); |
52 | |
53 | push(@av, "foo"); |
54 | ok(3, $av[1] eq 'foo', 'Array holds 2nd value'); |
55 | |
56 | my $av = threads->create(sub { |
57 | my $av; |
8eea0bff |
58 | my @av2; |
59 | share($av); |
60 | share(@av2); |
61 | $av = \@av2; |
7473853a |
62 | push(@$av, "bar", \@av); |
63 | return ($av); |
8eea0bff |
64 | })->join(); |
7473853a |
65 | |
66 | ok(4,$av->[0] eq "bar", 'Thread added to array'); |
67 | ok(5,$av->[1]->[0] eq 'hi', 'Shared in shared'); |
68 | |
8eea0bff |
69 | threads->create(sub { $av[0] = "hihi" })->join(); |
7473853a |
70 | ok(6,$av->[1]->[0] eq 'hihi', 'Replaced shared in shared'); |
71 | ok(7, pop(@{$av->[1]}) eq "foo", 'Pop shared array'); |
72 | ok(8, scalar(@{$av->[1]}) == 1, 'Array size'); |
73 | |
8eea0bff |
74 | threads->create(sub { @$av = () })->join(); |
7473853a |
75 | threads->create(sub { ok(9, scalar @$av == 0, 'Array cleared in thread'); })->join(); |
8eea0bff |
76 | |
7473853a |
77 | threads->create(sub { |
78 | unshift(@$av, threads->create(sub { |
79 | my @array; |
80 | share(@array); |
81 | return (\@array); |
82 | })->join()); |
83 | })->join(); |
8eea0bff |
84 | |
7473853a |
85 | ok(10, ref($av->[0]) eq 'ARRAY', 'Array in array'); |
8eea0bff |
86 | |
7473853a |
87 | threads->create(sub { push @{$av->[0]}, \@av })->join(); |
88 | threads->create(sub { $av[0] = 'testtest'})->join(); |
89 | threads->create(sub { ok(11, $av->[0]->[0]->[0] eq 'testtest', 'Nested'); })->join(); |
8eea0bff |
90 | |
7473853a |
91 | ok(12, is_shared($sv), "Check for sharing"); |
92 | ok(13, is_shared(@av), "Check for sharing"); |
8eea0bff |
93 | |
7473853a |
94 | my $x :shared; |
95 | ok(14, is_shared($x), "Check for sharing"); |
8eea0bff |
96 | |
7473853a |
97 | # EOF |