6 require Config; import Config;
7 unless ($Config{'useithreads'}) {
8 print "1..0 # Skip: no useithreads\n";
15 my ($id, $ok, $name) = @_;
17 $name = '' unless defined $name;
18 # You have to do it this way or VMS will get confused.
19 print $ok ? "ok $id - $name\n" : "not ok $id - $name\n";
21 printf "# Failed test at line %d\n", (caller)[2] unless $ok;
28 use ExtUtils::testlib;
30 BEGIN { print "1..43\n" };
36 ok(2,1,"shared \@foo");
38 ok(3, $foo[0] eq 'hi', "Check assignment works");
40 ok(4, $foo[0] eq 'bar', "Check overwriting works");
41 ok(5, !defined $foo[1], "Check undef value");
43 ok(6, $foo[2] eq "test", "Check extending the array works");
44 ok(7, !defined $foo[1], "Check undef value again");
45 ok(8, scalar(@foo) == 3, "Check the length of the array");
46 ok(9,$#foo == 2, "Check last element of array");
47 threads->create(sub { $foo[0] = "thread1" })->join;
48 ok(10, $foo[0] eq "thread1", "Check that a value can be changed in another thread");
49 push(@foo, "another value");
50 ok(11, $foo[3] eq "another value", "Check that push works");
52 ok(12, $foo[-1] == 3, "More push");
53 ok(13, $foo[-2] == 2, "More push");
54 ok(14, $foo[4] == 1, "More push");
55 threads->create(sub { push @foo, "thread2" })->join();
56 ok(15, $foo[7] eq "thread2", "Check push in another thread");
57 unshift(@foo, "start");
58 ok(16, $foo[0] eq "start", "Check unshift");
60 ok(17, $foo[0] == 1, "Check multiple unshift");
61 ok(18, $foo[1] == 2, "Check multiple unshift");
62 ok(19, $foo[2] == 3, "Check multiple unshift");
63 threads->create(sub { unshift @foo, "thread3" })->join();
64 ok(20, $foo[0] eq "thread3", "Check unshift from another thread");
66 ok(21, $var eq "thread2", "Check pop");
67 threads->create(sub { my $foo = pop @foo; ok(22, $foo == 3, "Check pop works in a thread")})->join();
69 ok(23, $var == 2, "Check pop after thread");
71 ok(24, $var eq "thread3", "Check shift");
72 threads->create(sub { my $foo = shift @foo; ok(25, $foo == 1, "Check shift works in a thread");
75 ok(26, $var == 2, "Check shift after thread");
79 my $empty = shift @foo2;
80 ok(27, !defined $empty, "Check shift on empty array");
82 ok(28, !defined $empty, "Check pop on empty array");
85 foreach my $var (@foo) {
88 ok(29, scalar @foo == $i, "Check foreach");
90 ok(30, $ref->[0] == 3, "Check reference access");
91 threads->create(sub { $ref->[0] = "thread4"})->join();
92 ok(31, $ref->[0] eq "thread4", "Check that it works after another thread");
94 threads->create(sub { @foo = () })->join();
95 ok(32, @foo == 0, "Check that array is empty");
96 ok(33, exists($foo[0]) == 0, "Check that zero index doesn't index");
98 ok(34, exists($foo[0]) == 1, "Check that zero index exists now");
99 ok(35, $foo[0] eq "sky", "And check that it also contains the right value");
102 ok(36, delete($foo[20]) eq "sky", "Check delete works");
104 threads->create(sub { delete($foo[0])})->join();
105 ok(37, !defined delete($foo[0]), "Check that delete works from a thread");
110 my ($t1,$t2) = @foo[2,3];
111 ok(38, $t1 == 3, "Check slice");
112 ok(39, $t2 == 4, "Check slice again");
113 my @t1 = @foo[1...4];
114 ok(40, $t1[0] == 2, "Check slice list");
115 ok(41, $t1[2] == 4, "Check slice list 2");
116 threads->create(sub { @foo[0,1] = ("hej","hop") })->join();
117 ok(42,$foo[0] eq "hej", "Check slice assign");
121 my @t1 = splice(@foo,0,2,"hop", "hej");
123 ok(43, my $temp1 = $@ =~/Splice not implemented for shared arrays/, "Check that the warning message is correct for non splice");