view release on metacpan or  search on metacpan

t/object2.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);
    }
    if ($] < 5.010) {
        print("1..0 # SKIP Needs Perl 5.10.0 or later\n");
        exit(0);
    }
}

use ExtUtils::testlib;

BEGIN {
    $| = 1;
    print("1..133\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;