(retracted by #16258)

Fix thread tests not to depend on sleep() as
a scheduling aid.  In two tests (basic and list)
I had to change from sleep() hack to another hack...
basically, using the filesystem as a semaphore.
The assumption made is that rmdir() is atomic.
(The sleep() scheduling assumption broke with the
GNU pth in NetBSD.)

(the cond.t part retracted by #16250)

p4raw-id: //depot/perl@16249

diff --git a/ext/threads/shared/t/cond.t b/ext/threads/shared/t/cond.t
index c143c02..083af42 100644 (file)
--- a/ext/threads/shared/t/cond.t
+++ b/ext/threads/shared/t/cond.t
@@ -1,16 +1,16 @@
 BEGIN {
     chdir 't' if -d 't';
-    push @INC ,'../lib';
+    @INC = qw(../lib .);
     require Config; import Config;
     unless ($Config{'useithreads'}) {
         print "1..0 # Skip: no threads\n";
         exit 0;
     }
+    require "test.pl";
 }
-print "1..5\n";
+print "1..4\n";
 use strict;
 
-
 use threads;
 
 use threads::shared;
@@ -18,23 +18,30 @@ use threads::shared;
 my $lock : shared;
 
 sub foo {
+    my $ret = 0;       
     lock($lock);
-    print "ok 1\n";
-    sleep 2;
-    print "ok 2\n";
+    $ret += 1;
     cond_wait($lock);
-    print "ok 5\n";
+    $ret += 2;
+    return $ret;
 }
 
 sub bar {
+    my $ret = 0;       
     lock($lock);
-    print "ok 3\n";
+    $ret += 1;
     cond_signal($lock);
-    print "ok 4\n";
+    $ret += 2;
+    return $ret;
 }
 
-my $tr  = threads->create(\&foo);
+my $tr1  = threads->create(\&foo);
 my $tr2 = threads->create(\&bar);
-$tr->join();
-$tr2->join();
+my $rt1 = $tr1->join();
+my $rt2 = $tr2->join();
+ok($rt1 & 1);
+ok($rt1 & 2);
+ok($rt2 & 1);
+ok($rt2 & 2);
+
 

diff --git a/ext/threads/t/basic.t b/ext/threads/t/basic.t
index eca5c97..893c30b 100755 (executable)
--- a/ext/threads/t/basic.t
+++ b/ext/threads/t/basic.t
@@ -73,12 +73,20 @@ ok(5, 1 == $threads::threads,"Check that threads::threads is true");
 
 #test trying to detach thread
 
-sub test4 { ok(6,1,"Detach test") }
+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;
 
 my $thread1 = threads->create('test4');
 
 $thread1->detach();
-sleep 2;
+sleep 1 while -d "thrsem";
 ok(7,1,"Detach test");
 
 
@@ -115,11 +123,8 @@ 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");
 
-1;
-
-
-
-
-
-
+END {
+    1 while rmdir "thrsem";
+}
 
+1;

diff --git a/ext/threads/t/list.t b/ext/threads/t/list.t
index e5929ed..0adaa23 100644 (file)
--- a/ext/threads/t/list.t
+++ b/ext/threads/t/list.t
@@ -1,12 +1,13 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    @INC = qw(../lib .);
     require Config; import Config;
     unless ($Config{'useithreads'}) {
         print "1..0 # Skip: no useithreads\n";
         exit 0;
     }
+    require "test.pl";
 }
 
 use ExtUtils::testlib;
@@ -15,39 +16,40 @@ 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);
 
-#########################
-sub ok {       
-    my ($id, $ok, $name) = @_;
-
-    # You have to do it this way or VMS will get confused.
-    print $ok ? "ok $id - $name\n" : "not ok $id - $name\n";
+my $thread = threads->create(sub {});
+ok(scalar @{[threads->list]} == 2);
+$thread->join();
+ok(scalar @{[threads->list]} == 1);
 
-    printf "# Failed test at line %d\n", (caller)[2] unless $ok;
+curr_test(6);
 
-    return $ok;
-}
+# 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;
 
-ok(2, threads->self == (threads->list)[0]);
+$thread = threads->create(sub { my $ret = threads->self == (threads->list)[1];
+                               rmdir "thrsem";
+                               return $ret });
 
+sleep 1 while -d "thrsem";
 
-threads->create(sub {})->join();
-ok(3, scalar @{[threads->list]} == 1);
+ok($thread == (threads->list)[1]);
+ok($thread->join());
+ok(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);
+END {
+    1 while rmdir "thrsem";
+}

diff --git a/ext/threads/t/thread.t b/ext/threads/t/thread.t
index 85bf2cd..d474514 100644 (file)
--- 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..21\n" };
+BEGIN { $| = 1; print "1..17\n" };
 use threads;
 use threads::shared;
 
@@ -40,23 +40,27 @@ sub content {
 sub dorecurse {
     my $val = shift;
     my $ret;
-    print $val;
     if(@_) {
        $ret = threads->new(\&dorecurse, @_);
-       $ret->join;
+       $ret &= $ret->join;
     }
+    $val;
 }
 {
-    my $t = threads->new(\&dorecurse, map { "ok $_\n" } 6..10);
-    $t->join();
+    curr_test(6);
+       
+    my $t = threads->new(\&dorecurse, 6..10);
+    ok($t->join());
 }
 
 {
+    curr_test(7);
+
     # test that sleep lets other thread run
-    my $t = threads->new(\&dorecurse, "ok 11\n");
+    my $t = threads->new(\&dorecurse, 1);
     sleep 1;
-    print "ok 12\n";
-    $t->join();
+    ok(1);
+    ok($t->join());
 }
 {
     my $lock : shared;
@@ -70,7 +74,7 @@ sub dorecurse {
        }
        return $ret;
     }
-my $t = threads->new(\&islocked, "ok 13\n", "ok 14\n");
+my $t = threads->new(\&islocked, "ok 9\n", "ok 10\n");
 $t->join->join;
 }
 
@@ -95,10 +99,10 @@ sub threaded {
 
 
 { 
-    curr_test(15);
+    curr_test(11);
 
-    my $thr1 = threads->new(\&testsprintf, 15);
-    my $thr2 = threads->new(\&testsprintf, 16);
+    my $thr1 = threads->new(\&testsprintf, 11);
+    my $thr2 = threads->new(\&testsprintf, 12);
     
     my $short = "This is a long string that goes on and on.";
     my $shorte = " a long string that goes on and on.";
@@ -108,8 +112,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, 19;
-    my $thr6 = new threads \&testsprintf, 20;
+    my $thr5 = new threads \&testsprintf, 15;
+    my $thr6 = new threads \&testsprintf, 16;
     my $thr7 = new threads \&threaded, $foo, $fooe;
 
     ok($thr1->join());