use strict;
use warnings;
BEGIN {
use Config;
if (! $Config{'useithreads'}) {
print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
exit(0);
}
if ($] < 5.010) {
print("1..0 # SKIP Needs Perl 5.10.0 or later\n");
exit(0);
}
}
use ExtUtils::testlib;
BEGIN {
$| = 1;
print("1..122\n"); ### Number of tests that will be run ###
};
use threads;
use threads::shared;
my $TEST;
BEGIN {
share($TEST);
$TEST = 1;
}
sub ok {
my ($ok, $name) = @_;
lock($TEST);
my $id = $TEST++;
# 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);
}
ok(1, 'Loaded');
### Start of Testing ###
my $ID :shared = -1;
my (@created, @destroyed);
{ package HashObj;
sub new {
my $class = shift;
my $self = &threads::shared::share({});
$$self{'ID'} = ++$ID;
$created[$ID] = 1;
return bless($self, $class);
}
sub DESTROY {
my $self = shift;
$destroyed[$$self{'ID'}] = 1;
}
}
{ package AryObj;
sub new {
my $class = shift;
my $self = &threads::shared::share([]);
$$self[0] = ++$ID;
$created[$ID] = 1;
return bless($self, $class);
}
sub DESTROY {
my $self = shift;
$destroyed[$$self[0]] = 1;
}
}
{ package SclrObj;
sub new {
my $class = shift;
my $self = \do{ my $scalar = ++$ID; };
$created[$ID] = 1;
threads::shared::share($self);
return bless($self, $class);
}
sub DESTROY {
my $self = shift;
$destroyed[$$self] = 1;
}
}
# Testing with normal array
my @normal_ary;
# Testing with hash object
$normal_ary[0] = HashObj->new();
ok($created[$ID], 'Created hash object in normal array');
delete($normal_ary[0]);
ok($destroyed[$ID], 'Deleted hash object in normal array');
$normal_ary[0] = HashObj->new();
ok($created[$ID], 'Created hash object in normal array');
$normal_ary[0] = undef;
ok($destroyed[$ID], 'Undef hash object in normal array');
$normal_ary[0] = HashObj->new();
ok($created[$ID], 'Created hash object in normal array');
$normal_ary[0] = HashObj->new();
ok($created[$ID], 'Created hash object in normal array');
ok($destroyed[$ID-1], 'Replaced hash object in normal array');
@normal_ary = ();
ok($destroyed[$ID], 'Hash object removed from cleared normal array');
$normal_ary[0] = HashObj->new();
ok($created[$ID], 'Created hash object in normal array');
undef(@normal_ary);
ok($destroyed[$ID], 'Hash object removed from undef normal array');
# Testing with array object
$normal_ary[0] = AryObj->new();
ok($created[$ID], 'Created array object in normal array');
delete($normal_ary[0]);
ok($destroyed[$ID], 'Deleted array object in normal array');
$normal_ary[0] = AryObj->new();
ok($created[$ID], 'Created array object in normal array');
$normal_ary[0] = undef;
ok($destroyed[$ID], 'Undef array object in normal array');
$normal_ary[0] = AryObj->new();
ok($created[$ID], 'Created array object in normal array');
$normal_ary[0] = AryObj->new();
ok($created[$ID], 'Created array object in normal array');
ok($destroyed[$ID-1], 'Replaced array object in normal array');
@normal_ary = ();
ok($destroyed[$ID], 'Array object removed from cleared normal array');
$normal_ary[0] = AryObj->new();
ok($created[$ID], 'Created array object in normal array');
undef(@normal_ary);
ok($destroyed[$ID], 'Array object removed from undef normal array');
# Testing with scalar object
$normal_ary[0] = SclrObj->new();
ok($created[$ID], 'Created scalar object in normal array');
delete($normal_ary[0]);
ok($destroyed[$ID], 'Deleted scalar object in normal array');
$normal_ary[0] = SclrObj->new();
ok($created[$ID], 'Created scalar object in normal array');
$normal_ary[0] = undef;
ok($destroyed[$ID], 'Undef scalar object in normal array');
$normal_ary[0] = SclrObj->new();
ok($created[$ID], 'Created scalar object in normal array');
$normal_ary[0] = SclrObj->new();
ok($created[$ID], 'Created scalar object in normal array');
ok($destroyed[$ID-1], 'Replaced scalar object in normal array');
@normal_ary = ();
ok($destroyed[$ID], 'Scalar object removed from cleared normal array');
$normal_ary[0] = SclrObj->new();
ok($created[$ID], 'Created scalar object in normal array');
undef(@normal_ary);
ok($destroyed[$ID], 'Scalar object removed from undef normal array');
# Testing with normal hash
my %normal_hash;
# Testing with hash object
$normal_hash{'obj'} = HashObj->new();
ok($created[$ID], 'Created hash object in normal hash');
delete($normal_hash{'obj'});
ok($destroyed[$ID], 'Deleted hash object in normal hash');
$normal_hash{'obj'} = HashObj->new();
ok($created[$ID], 'Created hash object in normal hash');
$normal_hash{'obj'} = undef;
ok($destroyed[$ID], 'Undef hash object in normal hash');
$normal_hash{'obj'} = HashObj->new();
ok($created[$ID], 'Created hash object in normal hash');
$normal_hash{'obj'} = HashObj->new();
ok($created[$ID], 'Created hash object in normal hash');
ok($destroyed[$ID-1], 'Replaced hash object in normal hash');
%normal_hash = ();
ok($destroyed[$ID], 'Hash object removed from cleared normal hash');
$normal_hash{'obj'} = HashObj->new();
ok($created[$ID], 'Created hash object in normal hash');
undef(%normal_hash);
ok($destroyed[$ID], 'Hash object removed from undef normal hash');
# Testing with array object
$normal_hash{'obj'} = AryObj->new();
ok($created[$ID], 'Created array object in normal hash');
delete($normal_hash{'obj'});
ok($destroyed[$ID], 'Deleted array object in normal hash');
$normal_hash{'obj'} = AryObj->new();
ok($created[$ID], 'Created array object in normal hash');
$normal_hash{'obj'} = undef;
ok($destroyed[$ID], 'Undef array object in normal hash');
$normal_hash{'obj'} = AryObj->new();
ok($created[$ID], 'Created array object in normal hash');
$normal_hash{'obj'} = AryObj->new();
ok($created[$ID], 'Created array object in normal hash');
ok($destroyed[$ID-1], 'Replaced array object in normal hash');
%normal_hash = ();
ok($destroyed[$ID], 'Array object removed from cleared normal hash');
$normal_hash{'obj'} = AryObj->new();
ok($created[$ID], 'Created array object in normal hash');
undef(%normal_hash);
ok($destroyed[$ID], 'Array object removed from undef normal hash');
# Testing with scalar object
$normal_hash{'obj'} = SclrObj->new();
ok($created[$ID], 'Created scalar object in normal hash');
delete($normal_hash{'obj'});
ok($destroyed[$ID], 'Deleted scalar object in normal hash');
$normal_hash{'obj'} = SclrObj->new();
ok($created[$ID], 'Created scalar object in normal hash');
$normal_hash{'obj'} = undef;
ok($destroyed[$ID], 'Undef scalar object in normal hash');
$normal_hash{'obj'} = SclrObj->new();
ok($created[$ID], 'Created scalar object in normal hash');
$normal_hash{'obj'} = SclrObj->new();
ok($created[$ID], 'Created scalar object in normal hash');
ok($destroyed[$ID-1], 'Replaced scalar object in normal hash');
%normal_hash = ();
ok($destroyed[$ID], 'Scalar object removed from cleared normal hash');
$normal_hash{'obj'} = SclrObj->new();
ok($created[$ID], 'Created scalar object in normal hash');
undef(%normal_hash);
ok($destroyed[$ID], 'Scalar object removed from undef normal hash');
# Testing with shared array
my @shared_ary :shared;
# Testing with hash object
$shared_ary[0] = HashObj->new();
ok($created[$ID], 'Created hash object in shared array');
delete($shared_ary[0]);
ok($destroyed[$ID], 'Deleted hash object in shared array');
$shared_ary[0] = HashObj->new();
ok($created[$ID], 'Created hash object in shared array');
$shared_ary[0] = undef;
ok($destroyed[$ID], 'Undef hash object in shared array');
$shared_ary[0] = HashObj->new();
ok($created[$ID], 'Created hash object in shared array');
$shared_ary[0] = HashObj->new();
ok($created[$ID], 'Created hash object in shared array');
ok($destroyed[$ID-1], 'Replaced hash object in shared array');
@shared_ary = ();
ok($destroyed[$ID], 'Hash object removed from cleared shared array');
$shared_ary[0] = HashObj->new();
ok($created[$ID], 'Created hash object in shared array');
undef(@shared_ary);
ok($destroyed[$ID], 'Hash object removed from undef shared array');
# Testing with array object
$shared_ary[0] = AryObj->new();
ok($created[$ID], 'Created array object in shared array');
delete($shared_ary[0]);
ok($destroyed[$ID], 'Deleted array object in shared array');
$shared_ary[0] = AryObj->new();
ok($created[$ID], 'Created array object in shared array');
$shared_ary[0] = undef;
ok($destroyed[$ID], 'Undef array object in shared array');
$shared_ary[0] = AryObj->new();
ok($created[$ID], 'Created array object in shared array');
$shared_ary[0] = AryObj->new();
ok($created[$ID], 'Created array object in shared array');
ok($destroyed[$ID-1], 'Replaced array object in shared array');
@shared_ary = ();
ok($destroyed[$ID], 'Array object removed from cleared shared array');
$shared_ary[0] = AryObj->new();
ok($created[$ID], 'Created array object in shared array');
undef(@shared_ary);
ok($destroyed[$ID], 'Array object removed from undef shared array');
# Testing with scalar object
$shared_ary[0] = SclrObj->new();
ok($created[$ID], 'Created scalar object in shared array');
delete($shared_ary[0]);
ok($destroyed[$ID], 'Deleted scalar object in shared array');
$shared_ary[0] = SclrObj->new();
ok($created[$ID], 'Created scalar object in shared array');
$shared_ary[0] = undef;
ok($destroyed[$ID], 'Undef scalar object in shared array');
$shared_ary[0] = SclrObj->new();
ok($created[$ID], 'Created scalar object in shared array');
$shared_ary[0] = SclrObj->new();
ok($created[$ID], 'Created scalar object in shared array');
ok($destroyed[$ID-1], 'Replaced scalar object in shared array');
@shared_ary = ();
ok($destroyed[$ID], 'Scalar object removed from cleared shared array');
$shared_ary[0] = SclrObj->new();
ok($created[$ID], 'Created scalar object in shared array');
undef(@shared_ary);
ok($destroyed[$ID], 'Scalar object removed from undef shared array');
# Testing with shared hash
my %shared_hash :shared;
# Testing with hash object
$shared_hash{'obj'} = HashObj->new();
ok($created[$ID], 'Created hash object in shared hash');
delete($shared_hash{'obj'});
ok($destroyed[$ID], 'Deleted hash object in shared hash');
$shared_hash{'obj'} = HashObj->new();
ok($created[$ID], 'Created hash object in shared hash');
$shared_hash{'obj'} = undef;
ok($destroyed[$ID], 'Undef hash object in shared hash');
$shared_hash{'obj'} = HashObj->new();
ok($created[$ID], 'Created hash object in shared hash');
$shared_hash{'obj'} = HashObj->new();
ok($created[$ID], 'Created hash object in shared hash');
ok($destroyed[$ID-1], 'Replaced hash object in shared hash');
%shared_hash = ();
ok($destroyed[$ID], 'Hash object removed from cleared shared hash');
$shared_hash{'obj'} = HashObj->new();
ok($created[$ID], 'Created hash object in shared hash');
undef(%shared_hash);
ok($destroyed[$ID], 'Hash object removed from undef shared hash');
# Testing with array object
$shared_hash{'obj'} = AryObj->new();
ok($created[$ID], 'Created array object in shared hash');
delete($shared_hash{'obj'});
ok($destroyed[$ID], 'Deleted array object in shared hash');
$shared_hash{'obj'} = AryObj->new();
ok($created[$ID], 'Created array object in shared hash');
$shared_hash{'obj'} = undef;
ok($destroyed[$ID], 'Undef array object in shared hash');
$shared_hash{'obj'} = AryObj->new();
ok($created[$ID], 'Created array object in shared hash');
$shared_hash{'obj'} = AryObj->new();
ok($created[$ID], 'Created array object in shared hash');
ok($destroyed[$ID-1], 'Replaced array object in shared hash');
%shared_hash = ();
ok($destroyed[$ID], 'Array object removed from cleared shared hash');
$shared_hash{'obj'} = AryObj->new();
ok($created[$ID], 'Created array object in shared hash');
undef(%shared_hash);
ok($destroyed[$ID], 'Array object removed from undef shared hash');
# Testing with scalar object
$shared_hash{'obj'} = SclrObj->new();
ok($created[$ID], 'Created scalar object in shared hash');
delete($shared_hash{'obj'});
ok($destroyed[$ID], 'Deleted scalar object in shared hash');
$shared_hash{'obj'} = SclrObj->new();
ok($created[$ID], 'Created scalar object in shared hash');
$shared_hash{'obj'} = undef;
ok($destroyed[$ID], 'Undef scalar object in shared hash');
$shared_hash{'obj'} = SclrObj->new();
ok($created[$ID], 'Created scalar object in shared hash');
$shared_hash{'obj'} = SclrObj->new();
ok($created[$ID], 'Created scalar object in shared hash');
ok($destroyed[$ID-1], 'Replaced scalar object in shared hash');
%shared_hash = ();
ok($destroyed[$ID], 'Scalar object removed from cleared shared hash');
$shared_hash{'obj'} = SclrObj->new();
ok($created[$ID], 'Created scalar object in shared hash');
undef(%shared_hash);
ok($destroyed[$ID], 'Scalar object removed from undef shared hash');
# Testing with shared scalar
{
my $shared_scalar : shared;
# Use a separate thread to make sure we have no private SV
async { $shared_scalar = SclrObj->new(); }->join();
}
ok($destroyed[$ID], 'Scalar object removed from shared scalar');
# EOF