the basic and list tests started hanging).
p4raw-id: //depot/perl@16258
#test trying to detach thread
-sub test4 { ok(6,1,"Detach test"); rmdir "thrsem" }
-
-# Just a sleep() would not guarantee that we sleep and will not
-# wake up before the just created thread finishes. Instead, let's
-# use the filesystem as a semaphore. Creating a directory and removing
-# it should be a reasonably atomic operation even over NFS.
-# Also, we do not want to depend here on shared variables.
-
-mkdir "thrsem", 0700;
+sub test4 { ok(6,1,"Detach test") }
my $thread1 = threads->create('test4');
$thread1->detach();
-sleep 1 while -d "thrsem";
+sleep 2;
ok(7,1,"Detach test");
ok(14, 0 == threads->self->tid(),"Check so that tid for threads work for main thread");
ok(15, 0 == threads->tid(),"Check so that tid for threads work for main thread");
-END {
- 1 while rmdir "thrsem";
-}
-
1;
+
+
+
+
+
+
+
BEGIN {
chdir 't' if -d 't';
- @INC = qw(../lib .);
+ @INC = '../lib';
require Config; import Config;
unless ($Config{'useithreads'}) {
print "1..0 # Skip: no useithreads\n";
exit 0;
}
- require "test.pl";
}
use ExtUtils::testlib;
BEGIN { $| = 1; print "1..8\n" };
+use threads;
-use_ok('threads');
-ok(threads->self == (threads->list)[0]);
+print "ok 1\n";
-threads->create(sub {})->join();
-ok(scalar @{[threads->list]} == 1);
-my $thread = threads->create(sub {});
-ok(scalar @{[threads->list]} == 2);
-$thread->join();
-ok(scalar @{[threads->list]} == 1);
+#########################
+sub ok {
+ my ($id, $ok, $name) = @_;
-curr_test(6);
+ # You have to do it this way or VMS will get confused.
+ print $ok ? "ok $id - $name\n" : "not ok $id - $name\n";
-# Just a sleep() would not guarantee that we sleep and will not
-# wake up before the just created thread finishes. Instead, let's
-# use the filesystem as a semaphore. Creating a directory and removing
-# it should be a reasonably atomic operation even over NFS.
-# Also, we do not want to depend here on shared variables.
+ printf "# Failed test at line %d\n", (caller)[2] unless $ok;
-mkdir "thrsem", 0700;
+ return $ok;
+}
-$thread = threads->create(sub { my $ret = threads->self == (threads->list)[1];
- rmdir "thrsem";
- return $ret });
-sleep 1 while -d "thrsem";
+ok(2, threads->self == (threads->list)[0]);
-ok($thread == (threads->list)[1]);
-ok($thread->join());
-ok(scalar @{[threads->list]} == 1);
-END {
- 1 while rmdir "thrsem";
-}
+threads->create(sub {})->join();
+ok(3, scalar @{[threads->list]} == 1);
+
+my $thread = threads->create(sub {});
+ok(4, scalar @{[threads->list]} == 2);
+$thread->join();
+ok(5, scalar @{[threads->list]} == 1);
+
+$thread = threads->create(sub { ok(6, threads->self == (threads->list)[1])});
+sleep 1;
+ok(7, $thread == (threads->list)[1]);
+$thread->join();
+ok(8, scalar @{[threads->list]} == 1);
use ExtUtils::testlib;
use strict;
-BEGIN { $| = 1; print "1..17\n" };
+BEGIN { $| = 1; print "1..21\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");
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());