view release on metacpan or  search on metacpan

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

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

    $| = 1;
    print("1..31\n");   ### Number of tests that will be run ###
};

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

### Start of Testing ###

sub content {
    print shift;
    return shift;
}
{
    my $t = omnithreads->create(\&content, "ok 2\n", "ok 3\n", 1..1000);
    print $t->join();
}
{
    my $lock : shared;
    my $t;
    {
        lock($lock);
        $t = omnithreads->create(sub { lock($lock); print "ok 5\n"});
        print "ok 4\n";
    }
    $t->join();
}

sub dorecurse {
    my $val = shift;
    my $ret;
    print $val;
    if(@_) {
        $ret = omnithreads->create(\&dorecurse, @_);
        $ret->join;
    }
}
{
    my $t = omnithreads->create(\&dorecurse, map { "ok $_\n" } 6..10);
    $t->join();
}

{
    # test that sleep lets other thread run
    my $t = omnithreads->create(\&dorecurse, "ok 11\n");
    omnithreads->yield; # help out non-preemptive thread implementations
    sleep 1;
    print "ok 12\n";
    $t->join();
}
{
    my $lock : shared;
    sub islocked {
        lock($lock);
        my $val = shift;
        my $ret;
        print $val;
        if (@_) {
            $ret = omnithreads->create(\&islocked, shift);
        }
        return $ret;
    }
my $t = omnithreads->create(\&islocked, "ok 13\n", "ok 14\n");
$t->join->join;
}



sub testsprintf {
    my $testno = shift;
    my $same = sprintf( "%0.f", $testno);
    return $testno eq $same;
}

sub threaded {
    my ($string, $string_end) = @_;

  # Do the match, saving the output in appropriate variables
    $string =~ /(.*)(is)(.*)/;
  # Yield control, allowing the other thread to fill in the match variables
    omnithreads->yield();
  # 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;