4 require Config; import Config;
5 unless ($Config{'useithreads'}) {
6 print "1..0 # Skip: no useithreads\n";
11 use ExtUtils::testlib;
13 BEGIN { print "1..11\n" };
19 use Devel::Peek qw(Dump);
24 # You have to do it this way or VMS will get confused.
25 print $ok ? "ok $test_id - $name\n" : "not ok $test_id - $name\n";
27 printf "# Failed test at line %d\n", (caller)[2] unless $ok;
33 ok(1, "# Skipped: @_");
40 my $retval = threads->create(sub { return ("hi") })->join();
41 ok($retval eq 'hi', "Check basic returnvalue");
44 my ($thread) = threads->create(sub { return (1,2,3) });
45 my @retval = $thread->join();
46 ok($retval[0] == 1 && $retval[1] == 2 && $retval[2] == 3);
49 my $retval = threads->create(sub { return [1] })->join();
50 ok($retval->[0] == 1,"Check that a array ref works");
53 my $retval = threads->create(sub { return { foo => "bar" }})->join();
54 ok($retval->{foo} eq 'bar',"Check that hash refs work");
57 my $retval = threads->create( sub {
58 open(my $fh, "+>threadtest") || die $!;
62 ok(ref($retval) eq 'GLOB', "Check that we can return FH $retval");
63 print $retval "test2\n";
65 # ok(<$retval> eq "test\n");
71 my $retval = threads->create(sub { return $_[0]}, \$test)->join();
77 my $retval = threads->create(sub { return $_[0]}, \$test)->join();
80 ok($$retval eq 'foo');
89 return $foo{bar} = \$foo;
94 if ($^O eq 'linux') { # We parse ps output so this is OS-dependent.
95 # First modify $0 in a subthread.
96 print "# 1a: \$0 = $0\n";
97 join( threads->new( sub {
98 print "# 2a: \$0 = $0\n";
100 print "# 2b: \$0 = $0\n" } ) );
101 print "# 1b: \$0 = $0\n";
102 if (open PS, "ps -f |") {
106 if (/^\S+\s+$$\s.+\sfoobar\s*$/) {
112 ok($ok, 'altering $0 is effective');
114 skip("\$0 check: opening 'ps -f |' failed: $!");
117 skip("\$0 check: only on Linux");