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";
use ExtUtils::testlib;
use strict;
-BEGIN { print "1..11\n" };
+BEGIN { print "1..12\n" };
use threads;
use threads::shared;
{
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();
{
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;
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");
+}