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