Sigh. #16249 didn't help NetBSD (made it worse,
Jarkko Hietaniemi [Sun, 28 Apr 2002 20:34:12 +0000 (20:34 +0000)]
the basic and list tests started hanging).

p4raw-id: //depot/perl@16258

ext/threads/t/basic.t
ext/threads/t/list.t
ext/threads/t/thread.t

index 893c30b..eca5c97 100755 (executable)
@@ -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;
+
+
+
+
+
+
+
index 0adaa23..e5929ed 100644 (file)
@@ -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);
index d474514..85bf2cd 100644 (file)
@@ -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());