view release on metacpan or  search on metacpan

t/clone.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..40\n");   ### Number of tests that will be run ###
};

my $test = 1;

use threads;
use threads::shared;
ok($test++, 1, 'Loaded');

### Start of Testing ###

{
    my $x = shared_clone(14);
    ok($test++, $x == 14, 'number');

    $x = shared_clone('test');
    ok($test++, $x eq 'test', 'string');
}

{
    my %hsh = ('foo' => 2);
    eval {
        my $x = shared_clone(%hsh);
    };
    ok($test++, $@ =~ /Usage:/, '1 arg');

    threads->create(sub {})->join();  # Hide leaks, etc.
}

{
    my $x = 'test';
    my $foo :shared = shared_clone($x);
    ok($test++, $foo eq 'test', 'cloned string');

    $foo = shared_clone(\$x);
    ok($test++, $$foo eq 'test', 'cloned scalar ref');

    threads->create(sub {
        ok($test++, $$foo eq 'test', 'cloned scalar ref in thread');
    })->join();

    $test++;
}

{
    my $foo :shared;
    $foo = shared_clone(\$foo);
    ok($test++, ref($foo) eq 'REF', 'Circular ref typ');
    ok($test++, threads::shared::_id($foo) == threads::shared::_id($$foo), 'Circular ref');

    threads->create(sub {
        ok($test++, threads::shared::_id($foo) == threads::shared::_id($$foo), 'Circular ref in thread');