view release on metacpan or  search on metacpan

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

  # Examine the match variable contents; on broken perls this fails
    return $3 eq $string_end;
}


{ 
    curr_test(15);

    my $thr1 = omnithreads->create(\&testsprintf, 15);
    my $thr2 = omnithreads->create(\&testsprintf, 16);
    
    my $short = "This is a long string that goes on and on.";
    my $shorte = " a long string that goes on and on.";
    my $long  = "This is short.";
    my $longe  = " short.";
    my $foo = "This is bar bar bar.";
    my $fooe = " bar bar bar.";
    my $thr3 = new omnithreads \&threaded, $short, $shorte;
    my $thr4 = new omnithreads \&threaded, $long, $longe;
    my $thr5 = new omnithreads \&testsprintf, 19;
    my $thr6 = new omnithreads \&testsprintf, 20;
    my $thr7 = new omnithreads \&threaded, $foo, $fooe;

    ok($thr1->join());
    ok($thr2->join());
    ok($thr3->join());
    ok($thr4->join());
    ok($thr5->join());
    ok($thr6->join());
    ok($thr7->join());
}

# test that 'yield' is importable

package Test1;

use omnithreads 'yield';
yield;
main::ok(1);

package main;


# test async

{
    my $th = async {return 1 };
    ok($th);
    ok($th->join());
}
{
    # There is a miniscule chance this test case may falsely fail
    # since it tests using rand()
    my %rand : shared;
    rand(10);
    omnithreads->create( sub { $rand{int(rand(10000000000))}++ } ) foreach 1..25;
    $_->join foreach omnithreads->list;
    ok((keys %rand >= 23), "Check that rand() is randomized in new threads");
}

# bugid #24165

run_perl(prog => 'use omnithreads;' .
                 'sub a{omnithreads->create(shift)} $t = a sub{};' .
                 '$t->tid; $t->join; $t->tid',
         nolib => ($ENV{PERL_CORE}) ? 0 : 1,
         switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]);
is($?, 0, 'coredump in global destruction');

# test CLONE_SKIP() functionality
if ($] >= 5.008007) {
    my %c : shared;
    my %d : shared;

    # ---

    package A;
    sub CLONE_SKIP { $c{"A-$_[0]"}++; 1; }
    sub DESTROY    { $d{"A-". ref $_[0]}++ }

    package A1;
    our @ISA = qw(A);
    sub CLONE_SKIP { $c{"A1-$_[0]"}++; 1; }
    sub DESTROY    { $d{"A1-". ref $_[0]}++ }

    package A2;
    our @ISA = qw(A1);

    # ---

    package B;
    sub CLONE_SKIP { $c{"B-$_[0]"}++; 0; }
    sub DESTROY    { $d{"B-" . ref $_[0]}++ }

    package B1;
    our @ISA = qw(B);
    sub CLONE_SKIP { $c{"B1-$_[0]"}++; 1; }
    sub DESTROY    { $d{"B1-" . ref $_[0]}++ }

    package B2;
    our @ISA = qw(B1);

    # ---

    package C;
    sub CLONE_SKIP { $c{"C-$_[0]"}++; 1; }
    sub DESTROY    { $d{"C-" . ref $_[0]}++ }

    package C1;
    our @ISA = qw(C);
    sub CLONE_SKIP { $c{"C1-$_[0]"}++; 0; }
    sub DESTROY    { $d{"C1-" . ref $_[0]}++ }

    package C2;
    our @ISA = qw(C1);

    # ---

    package D;
    sub DESTROY    { $d{"D-" . ref $_[0]}++ }