From: Jarkko Hietaniemi Date: Sun, 28 Apr 2002 20:34:12 +0000 (+0000) Subject: Sigh. #16249 didn't help NetBSD (made it worse, X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=74bf223e92f56072ce9b2b6c5e9d88a92504d0fd;p=p5sagit%2Fp5-mst-13.2.git Sigh. #16249 didn't help NetBSD (made it worse, the basic and list tests started hanging). p4raw-id: //depot/perl@16258 --- diff --git a/ext/threads/t/basic.t b/ext/threads/t/basic.t index 893c30b..eca5c97 100755 --- a/ext/threads/t/basic.t +++ b/ext/threads/t/basic.t @@ -73,20 +73,12 @@ ok(5, 1 == $threads::threads,"Check that threads::threads is true"); #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"); @@ -123,8 +115,11 @@ threads->create('test8')->join; 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; + + + + + + + diff --git a/ext/threads/t/list.t b/ext/threads/t/list.t index 0adaa23..e5929ed 100644 --- a/ext/threads/t/list.t +++ b/ext/threads/t/list.t @@ -1,13 +1,12 @@ 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; @@ -16,40 +15,39 @@ use strict; 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); diff --git a/ext/threads/t/thread.t b/ext/threads/t/thread.t index d474514..85bf2cd 100644 --- a/ext/threads/t/thread.t +++ b/ext/threads/t/thread.t @@ -12,7 +12,7 @@ BEGIN { use ExtUtils::testlib; use strict; -BEGIN { $| = 1; print "1..17\n" }; +BEGIN { $| = 1; print "1..21\n" }; use threads; use threads::shared; @@ -40,27 +40,23 @@ sub content { 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; @@ -74,7 +70,7 @@ sub dorecurse { } 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; } @@ -99,10 +95,10 @@ sub threaded { { - 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."; @@ -112,8 +108,8 @@ sub threaded { 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());