view release on metacpan or  search on metacpan

t/av_simple.t  view on Meta::CPAN

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..47\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;