1 files changed, 135 insertions, 0 deletions
diff --git a/dist/threads-shared/t/av_simple.t b/dist/threads-shared/t/av_simple.t
new file mode 100644
index 0000000000..7fab9b2b76
--- /dev/null
+++ b/dist/threads-shared/t/av_simple.t
@@ -0,0 +1,135 @@
+use strict;
+use warnings;
+
+BEGIN {
+    use Config;
+    if (! $Config{'useithreads'}) {
+        print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
+        exit(0);
+    }
+}
+
+use ExtUtils::testlib;
+
+sub ok {
+    my ($id, $ok, $name) = @_;
+
+    # You have to do it this way or VMS will get confused.
+    if ($ok) {
+        print("ok $id - $name\n");
+    } else {
+        print("not ok $id - $name\n");
+        printf("# Failed test at line %d\n", (caller)[2]);
+    }
+
+    return ($ok);
+}
+
+BEGIN {
+    $| = 1;
+    print("1..44\n");   ### Number of tests that will be run ###
+};
+
+use threads;
+use threads::shared;
+ok(1, 1, 'Loaded');
+
+### Start of Testing ###
+
+my @foo;
+share(@foo);
+ok(2,1,"shared \@foo");
+$foo[0] = "hi";
+ok(3, $foo[0] eq 'hi', "Check assignment works");
+$foo[0] = "bar";
+ok(4, $foo[0] eq 'bar', "Check overwriting works");
+ok(5, !defined $foo[1], "Check undef value");
+$foo[2] = "test";
+ok(6, $foo[2] eq "test", "Check extending the array works");
+ok(7, !defined $foo[1], "Check undef value again");
+ok(8, scalar(@foo) == 3, "Check the length of the array");
+ok(9,$#foo == 2, "Check last element of array");
+threads->create(sub { $foo[0] = "thread1" })->join;
+ok(10, $foo[0] eq "thread1", "Check that a value can be changed in another thread");
+push(@foo, "another value");
+ok(11, $foo[3] eq "another value", "Check that push works");
+push(@foo, 1,2,3);
+ok(12, $foo[-1] == 3, "More push");
+ok(13, $foo[-2] == 2, "More push");
+ok(14, $foo[4] == 1, "More push");
+threads->create(sub { push @foo, "thread2" })->join();
+ok(15, $foo[7] eq "thread2", "Check push in another thread");
+unshift(@foo, "start");
+ok(16, $foo[0] eq "start", "Check unshift");
+unshift(@foo, 1,2,3);
+ok(17, $foo[0] == 1, "Check multiple unshift");
+ok(18, $foo[1] == 2, "Check multiple unshift");
+ok(19, $foo[2] == 3, "Check multiple unshift");
+threads->create(sub { unshift @foo, "thread3" })->join();
+ok(20, $foo[0] eq "thread3", "Check unshift from another thread");
+my $var = pop(@foo);
+ok(21, $var eq "thread2", "Check pop");
+threads->create(sub { my $foo = pop @foo; ok(22, $foo == 3, "Check pop works in a thread")})->join();
+$var = pop(@foo);
+ok(23, $var == 2, "Check pop after thread");
+$var = shift(@foo);
+ok(24, $var eq "thread3", "Check shift");
+threads->create(sub { my $foo = shift @foo; ok(25, $foo  == 1, "Check shift works in a thread");
+})->join();
+$var = shift(@foo);
+ok(26, $var == 2, "Check shift after thread");
+{
+    my @foo2;
+    share @foo2;
+    my $empty = shift @foo2;
+    ok(27, !defined $empty, "Check shift on empty array");
+    $empty = pop @foo2;
+    ok(28, !defined $empty, "Check pop on empty array");
+}
+my $i = 0;
+foreach my $var (@foo) {
+    $i++;
+}
+ok(29, scalar @foo == $i, "Check foreach");
+my $ref = \@foo;
+ok(30, $ref->[0] == 3, "Check reference access");
+threads->create(sub { $ref->[0] = "thread4"})->join();
+ok(31, $ref->[0] eq "thread4", "Check that it works after another thread");
+undef($ref);
+threads->create(sub { @foo = () })->join();
+ok(32, @foo == 0, "Check that array is empty");
+ok(33, exists($foo[0]) == 0, "Check that zero index doesn't index");
+@foo = ("sky");
+ok(34, exists($foo[0]) == 1, "Check that zero index exists now");
+ok(35, $foo[0] eq "sky", "And check that it also contains the right value");
+$#foo = 20;
+$foo[20] = "sky";
+ok(36, delete($foo[20]) eq "sky", "Check delete works");
+
+threads->create(sub { delete($foo[0])})->join();
+ok(37, !defined delete($foo[0]), "Check that delete works from a thread");
+
+@foo = (1,2,3,4,5);
+
+{
+    my ($t1,$t2) = @foo[2,3];
+    ok(38, $t1 == 3, "Check slice");
+    ok(39, $t2 == 4, "Check slice again");
+    my @t1 = @foo[1...4];
+    ok(40, $t1[0] == 2, "Check slice list");
+    ok(41, $t1[2] == 4, "Check slice list 2");
+    threads->create(sub { @foo[0,1] = ("hej","hop") })->join();
+    ok(42,$foo[0] eq "hej", "Check slice assign");
+}
+{
+    eval {
+        my @t1 = splice(@foo,0,2,"hop", "hej");
+    };
+    ok(43, my $temp1 = $@ =~/Splice not implemented for shared arrays/, "Check that the warning message is correct for non splice");
+}
+
+ok(44, is_shared(@foo), "Check for sharing");
+
+exit(0);
+
+# EOF