Upgrade to threads 1.72

[p5sagit/p5-mst-13.2.git] / ext / threads / t / free.t

diff --git a/ext/threads/t/free.t b/ext/threads/t/free.t
index 0e8bd86..87fdae9 100644 (file)
--- a/ext/threads/t/free.t
+++ b/ext/threads/t/free.t
@@ -6,10 +6,16 @@ BEGIN {
         chdir 't';
         unshift @INC, '../lib';
     }
+
+    # Import test.pl into its own package
+    {
+        package Test;
+        require($ENV{PERL_CORE} ? './test.pl' : './t/test.pl');
+    }
+
     use Config;
     if (! $Config{'useithreads'}) {
-        print("1..0 # Skip: Perl not compiled with 'useithreads'\n");
-        exit(0);
+        Test::skip_all(q/Perl not compiled with 'useithreads'/);
     }
 }
 
@@ -18,71 +24,72 @@ use ExtUtils::testlib;
 use threads;
 
 BEGIN {
-    eval {
-        require threads::shared;
-        import threads::shared;
-    };
-    if ($@ || ! $threads::shared::threads_shared) {
-        print("1..0 # Skip: threads::shared not available\n");
-        exit(0);
+    if (! eval 'use threads::shared; 1') {
+        Test::skip_all(q/threads::shared not available/);
     }
 
+    require Thread::Queue;
+
     $| = 1;
     print("1..29\n");   ### Number of tests that will be run ###
-};
-
-my $TEST;
-BEGIN {
-    share($TEST);
-    $TEST = 1;
 }
 
-ok(1, 'Loaded');
-
-sub ok {
-    my ($ok, $name) = @_;
+Test::watchdog(120);   # In case we get stuck
 
-    lock($TEST);
-    my $id = $TEST++;
+my $q = Thread::Queue->new();
+my $TEST = 1;
 
-    # You have to do it this way or VMS will get confused.
-    if ($ok) {
-        print("ok $id - $name\n");
-    } else {
-        print("not ok $id - $name\n");
-        printf("# Failed test at line %d\n", (caller)[2]);
+sub ok
+{
+    $q->enqueue(@_);
+
+    while ($q->pending()) {
+        my $ok   = $q->dequeue();
+        my $name = $q->dequeue();
+        my $id   = $TEST++;
+
+        if ($ok) {
+            print("ok $id - $name\n");
+        } else {
+            print("not ok $id - $name\n");
+            printf("# Failed test at line %d\n", (caller)[2]);
+        }
     }
-
-    return ($ok);
 }
 
 
 ### Start of Testing ###
+ok(1, 'Loaded');
 
 # Tests freeing the Perl interperter for each thread
 # See http://www.nntp.perl.org/group/perl.perl5.porters/110772 for details
 
-my $COUNT;
-share($COUNT);
+my ($COUNT, $STARTED) :shared;
 
 sub threading_1 {
+    my $q = shift;
+
     my $tid = threads->tid();
-    ok($tid, "Thread $tid started");
+    $q->enqueue($tid, "Thread $tid started");
 
-    if ($tid < 5) {
+    my $id;
+    {
+        lock($STARTED);
+        $STARTED++;
+        $id = $STARTED;
+    }
+    if ($STARTED < 5) {
         sleep(1);
-        threads->create('threading_1')->detach();
+        threads->create('threading_1', $q)->detach();
     }
 
-    threads->yield();
-
-    if ($tid == 1) {
+    if ($id == 1) {
         sleep(2);
-    } elsif ($tid == 2) {
+    } elsif ($id == 2) {
         sleep(6);
-    } elsif ($tid == 3) {
+    } elsif ($id == 3) {
         sleep(3);
-    } elsif ($tid == 4) {
+    } elsif ($id == 4) {
         sleep(1);
     } else {
         sleep(2);
@@ -91,59 +98,66 @@ sub threading_1 {
     lock($COUNT);
     $COUNT++;
     cond_signal($COUNT);
-    ok($tid, "Thread $tid done");
+    $q->enqueue($tid, "Thread $tid done");
 }
 
 {
+    $STARTED = 0;
     $COUNT = 0;
-    threads->create('threading_1')->detach();
+    threads->create('threading_1', $q)->detach();
     {
-        lock($COUNT);
-        while ($COUNT < 3) {
-            cond_wait($COUNT);
-        }
-    }
-}
-{
-    {
-        lock($COUNT);
-        while ($COUNT < 5) {
-            cond_wait($COUNT);
+        my $cnt = 0;
+        while ($cnt < 5) {
+            {
+                lock($COUNT);
+                cond_wait($COUNT) if ($COUNT < 5);
+                $cnt = $COUNT;
+            }
+            threads->create(sub {
+                threads->create(sub { })->join();
+            })->join();
         }
     }
-    threads->yield();
     sleep(1);
 }
 ok($COUNT == 5, "Done - $COUNT threads");
 
 
 sub threading_2 {
+    my $q = shift;
+
     my $tid = threads->tid();
-    ok($tid, "Thread $tid started");
+    $q->enqueue($tid, "Thread $tid started");
 
-    if ($tid < 10) {
-        threads->create('threading_2')->detach();
+    {
+        lock($STARTED);
+        $STARTED++;
+    }
+    if ($STARTED < 5) {
+        threads->create('threading_2', $q)->detach();
     }
-
     threads->yield();
 
     lock($COUNT);
     $COUNT++;
     cond_signal($COUNT);
 
-    ok($tid, "Thread $tid done");
+    $q->enqueue($tid, "Thread $tid done");
 }
 
 {
+    $STARTED = 0;
     $COUNT = 0;
-    threads->create('threading_2')->detach();
+    threads->create('threading_2', $q)->detach();
+    threads->create(sub {
+        threads->create(sub { })->join();
+    })->join();
     {
         lock($COUNT);
-        while ($COUNT < 3) {
+        while ($COUNT < 5) {
             cond_wait($COUNT);
         }
     }
-    threads->yield();
     sleep(1);
 }
 ok($COUNT == 5, "Done - $COUNT threads");
@@ -156,36 +170,39 @@ ok(1, 'Join');
 
 
 sub threading_3 {
+    my $q = shift;
+
     my $tid = threads->tid();
-    ok($tid, "Thread $tid started");
+    $q->enqueue($tid, "Thread $tid started");
 
     {
         threads->create(sub {
+            my $q = shift;
+
             my $tid = threads->tid();
-            ok($tid, "Thread $tid started");
+            $q->enqueue($tid, "Thread $tid started");
 
-            threads->yield();
             sleep(1);
 
             lock($COUNT);
             $COUNT++;
             cond_signal($COUNT);
 
-            ok($tid, "Thread $tid done");
-        })->join();
+            $q->enqueue($tid, "Thread $tid done");
+        }, $q)->detach();
     }
 
     lock($COUNT);
     $COUNT++;
     cond_signal($COUNT);
 
-    ok($tid, "Thread $tid done");
+    $q->enqueue($tid, "Thread $tid done");
 }
 
 {
     $COUNT = 0;
     threads->create(sub {
-        threads->create('threading_3')->detach();
+        threads->create('threading_3', $q)->detach();
         {
             lock($COUNT);
             while ($COUNT < 2) {
@@ -193,9 +210,10 @@ sub threading_3 {
             }
         }
     })->join();
-    threads->yield();
     sleep(1);
 }
 ok($COUNT == 2, "Done - $COUNT threads");
 
+exit(0);
+
 # EOF