fix for ext/threads/t/problems.t failures

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

diff --git a/ext/threads/t/join.t b/ext/threads/t/join.t
index 892f48d..7f8f1c8 100644 (file)
--- a/ext/threads/t/join.t
+++ b/ext/threads/t/join.t
@@ -1,7 +1,6 @@
-
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    push @INC, '../lib';
     require Config; import Config;
     unless ($Config{'useithreads'}) {
         print "1..0 # Skip: no useithreads\n";
@@ -11,7 +10,7 @@ BEGIN {
 
 use ExtUtils::testlib;
 use strict;
-BEGIN { print "1..11\n" };
+BEGIN { print "1..12\n" };
 use threads;
 use threads::shared;
 
@@ -30,6 +29,10 @@ sub ok {
     return $ok;
 }
 
+sub skip {
+    ok(1, "# Skipped: @_");
+}
+
 ok(1,"");
 
 
@@ -40,11 +43,11 @@ ok(1,"");
 {
     my ($thread) = threads->create(sub { return (1,2,3) });
     my @retval = $thread->join();
-    ok($retval[0] == 1 && $retval[1] == 2 && $retval[2] == 3);
+    ok($retval[0] == 1 && $retval[1] == 2 && $retval[2] == 3,'');
 }
 {
     my $retval = threads->create(sub { return [1] })->join();
-    ok($retval->[0] == 1,"Check that a array ref works");
+    ok($retval->[0] == 1,"Check that a array ref works",);
 }
 {
     my $retval = threads->create(sub { return { foo => "bar" }})->join();
@@ -66,15 +69,15 @@ ok(1,"");
 {
     my $test = "hi";
     my $retval = threads->create(sub { return $_[0]}, \$test)->join();
-    ok($$retval eq 'hi');
+    ok($$retval eq 'hi','');
 }
 {
     my $test = "hi";
     share($test);
     my $retval = threads->create(sub { return $_[0]}, \$test)->join();
-    ok($$retval eq 'hi');
+    ok($$retval eq 'hi','');
     $test = "foo";
-    ok($$retval eq 'foo');
+    ok($$retval eq 'foo','');
 }
 {
     my %foo;
@@ -88,29 +91,51 @@ ok(1,"");
     ok(1,"");
 }
 
-if ($^O eq 'linux') { # We parse ps output so this is OS-dependent.
-
+# We parse ps output so this is OS-dependent.
+if ($^O eq 'linux') {
   # First modify $0 in a subthread.
-  print "# 1a: \$0 = $0\n";
-  join( threads->new( sub {
-       print "# 2a: \$0 = $0\n";
-       $0 = "foobar";
-       print "# 2b: \$0 = $0\n" } ) );
-  print "# 1b: \$0 = $0\n";
-  if (open PS, "ps -f |") {
-    my $ok;
+  print "# mainthread: \$0 = $0\n";
+  threads->new( sub {
+                 print "# subthread: \$0 = $0\n";
+                 $0 = "foobar";
+                 print "# subthread: \$0 = $0\n" } )->join;
+  print "# mainthread: \$0 = $0\n";
+  print "# pid = $$\n";
+  if (open PS, "ps -f |") { # Note: must work in (all) systems.
+    my ($sawpid, $sawexe);
     while (<PS>) {
-      print "# $_";
-      if (/^\S+\s+$$\s.+\sfoobar\s*$/) {
-       $ok++;
+      chomp;
+      print "# [$_]\n";
+      if (/^\S+\s+$$\s/) {
+       $sawpid++;
+       if (/\sfoobar\s*$/) { # Linux 2.2 leaves extra trailing spaces.
+         $sawexe++;
+        }
        last;
       }
     }
-    close PS;
-    ok($ok, 'altering $0 is effective');
+    close PS or die;
+    if ($sawpid) {
+      ok($sawpid && $sawexe, 'altering $0 is effective');
+    } else {
+      skip("\$0 check: did not see pid $$ in 'ps -f |'");
+    }
   } else {
     skip("\$0 check: opening 'ps -f |' failed: $!");
   }
 } else {
   skip("\$0 check: only on Linux");
 }
+
+{
+    my $t = threads->new(sub {});
+    $t->join;
+    my $x = threads->new(sub {});
+    $x->join;
+    eval {
+      $t->join;
+    };
+    my $ok = 0;
+    $ok++ if($@ =~/Thread already joined/);
+    ok($ok, "Double join works");
+}