BEGIN {
chdir 't' if -d 't';
- @INC = qw(../lib .);
+ push @INC, '../lib','.';
require Config; import Config;
unless ($Config{'useithreads'}) {
print "1..0 # Skip: no useithreads\n";
use ExtUtils::testlib;
use strict;
-BEGIN { $| = 1; print "1..17\n" };
+BEGIN { $| = 1; print "1..25\n" };
use threads;
use threads::shared;
sub dorecurse {
my $val = shift;
my $ret;
+ print $val;
if(@_) {
$ret = threads->new(\&dorecurse, @_);
- $ret &= $ret->join;
+ $ret->join;
}
- $val;
}
{
- curr_test(6);
-
- my $t = threads->new(\&dorecurse, 6..10);
- ok($t->join());
+ my $t = threads->new(\&dorecurse, map { "ok $_\n" } 6..10);
+ $t->join();
}
{
- curr_test(7);
-
# test that sleep lets other thread run
- my $t = threads->new(\&dorecurse, 1);
+ my $t = threads->new(\&dorecurse, "ok 11\n");
+ threads->yield; # help out non-preemptive thread implementations
sleep 1;
- ok(1);
- ok($t->join());
+ print "ok 12\n";
+ $t->join();
}
{
my $lock : shared;
}
return $ret;
}
-my $t = threads->new(\&islocked, "ok 9\n", "ok 10\n");
+my $t = threads->new(\&islocked, "ok 13\n", "ok 14\n");
$t->join->join;
}
{
- curr_test(11);
+ curr_test(15);
- my $thr1 = threads->new(\&testsprintf, 11);
- my $thr2 = threads->new(\&testsprintf, 12);
+ my $thr1 = threads->new(\&testsprintf, 15);
+ my $thr2 = threads->new(\&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 $fooe = " bar bar bar.";
my $thr3 = new threads \&threaded, $short, $shorte;
my $thr4 = new threads \&threaded, $long, $longe;
- my $thr5 = new threads \&testsprintf, 15;
- my $thr6 = new threads \&testsprintf, 16;
+ my $thr5 = new threads \&testsprintf, 19;
+ my $thr6 = new threads \&testsprintf, 20;
my $thr7 = new threads \&threaded, $foo, $fooe;
ok($thr1->join());
ok($thr6->join());
ok($thr7->join());
}
+
+# test that 'yield' is importable
+
+package Test1;
+
+use threads 'yield';
+yield;
+main::ok(1);
+
+package main;
+
+
+# test async
+
+{
+ my $th = async {return 1 };
+ ok($th);
+ ok($th->join());
+}
+{
+ # there is a little chance this test case will falsly fail
+ # since it tests rand
+ my %rand : shared;
+ rand(10);
+ threads->new( sub { $rand{int(rand(10000000000))}++ } ) foreach 1..25;
+ $_->join foreach threads->list;
+# use Data::Dumper qw(Dumper);
+# print Dumper(\%rand);
+ #$val = rand();
+ ok((keys %rand == 25), "Check that rand works after a new thread");
+}
+
+
+