view release on metacpan or  search on metacpan

omnithreads/t/problems.t  view on Meta::CPAN

use strict;
use warnings;

BEGIN {
    if ($ENV{'PERL_CORE'}){
        chdir 't';
        unshift @INC, '../lib';
    }
    use Config;
    if (! $Config{'useithreads'}) {
        print("1..0 # Skip: Perl not compiled with 'useithreads'\n");
        exit(0);
    }
}

use ExtUtils::testlib;

use omnithreads;

BEGIN {
    eval {
        require omnithreads::shared;
        import omnithreads::shared;
    };
    if ($@ || ! $omnithreads::shared::threads_shared) {
        print("1..0 # Skip: omnithreads::shared not available\n");
        exit(0);
    }

    $| = 1;
    if ($] == 5.008) {
        print("1..11\n");   ### Number of tests that will be run ###
    } else {
        print("1..15\n");   ### Number of tests that will be run ###
    }
};

print("ok 1 - Loaded\n");

### Start of Testing ###

no warnings 'deprecated';       # Suppress warnings related to :unique

use Hash::Util 'lock_keys';

my $test :shared = 2;

# Note that we can't use Test::More here, as we would need to call is()
# from within the DESTROY() function at global destruction time, and
# parts of Test::* may have already been freed by then
sub is($$$)
{
    my ($got, $want, $desc) = @_;
    lock($test);
    if ($got ne $want) {
        print("# EXPECTED: $want\n");
        print("# GOT:      $got\n");
        print("not ");
    }
    print("ok $test - $desc\n");
    $test++;
}


# This tests for too much destruction which was caused by cloning stashes
# on join which led to double the dataspace under 5.8.0
if ($] != 5.008)
{
    sub Foo::DESTROY
    {
        my $self = shift;
        my ($package, $file, $line) = caller;
        is(omnithreads->tid(), $self->{tid}, "In destroy[$self->{tid}] it should be correct too" );
    }

    my $foo = bless {tid => 0}, 'Foo';
    my $bar = omnithreads->create(sub {
        is(omnithreads->tid(), 1, "And tid be 1 here");
        $foo->{tid} = 1;
        return ($foo);
    })->join();
    $bar->{tid} = 0;
}


# This tests whether we can call Config::myconfig after threads have been
# started (interpreter cloned).  5.8.1 and 5.8.2 contained a bug that would
# disallow that to be done because an attempt was made to change a variable
# with the :unique attribute.

{
    lock($test);
    if ($] == 5.008 || $] >= 5.008003) {
        omnithreads->create( sub {1} )->join;
        my $not = eval { Config::myconfig() } ? '' : 'not ';
        print "${not}ok $test - Are we able to call Config::myconfig after clone\n";
    } else {
        print "ok $test # Skip Are we able to call Config::myconfig after clone\n";
    }
    $test++;
}


# bugid 24383 - :unique hashes weren't being made readonly on interpreter
# clone; check that they are.

our $unique_scalar : unique;
our @unique_array : unique;
our %unique_hash : unique;
omnithreads->create(sub {
        lock($test);