ext/threads/t/join.t

   1
   2 BEGIN {
   3     chdir 't' if -d 't';
   4     @INC = '../lib';
   5     require Config; import Config;
   6     unless ($Config{'useithreads'}) {
   7         print "1..0 # Skip: no useithreads\n";
   8         exit 0;
   9     }
  10 }
  11
  12 use ExtUtils::testlib;
  13 use strict;
  14 BEGIN { print "1..10\n" };
  15 use threads;
  16 use threads::shared;
  17
  18 my $test_id = 1;
  19 share($test_id);
  20 use Devel::Peek qw(Dump);
  21
  22 sub ok {
  23     my ($ok, $name) = @_;
  24
  25     # You have to do it this way or VMS will get confused.
  26     print $ok ? "ok $test_id - $name\n" : "not ok $test_id - $name\n";
  27
  28     printf "# Failed test at line %d\n", (caller)[2] unless $ok;
  29     $test_id++;
  30     return $ok;
  31 }
  32
  33 ok(1,"");
  34
  35
  36 {
  37     my $retval = threads->create(sub { return ("hi") })->join();
  38     ok($retval eq 'hi', "Check basic returnvalue");
  39 }
  40 {
  41     my ($thread) = threads->create(sub { return (1,2,3) });
  42     my @retval = $thread->join();
  43     ok($retval[0] == 1 && $retval[1] == 2 && $retval[2] == 3);
  44 }
  45 {
  46     my $retval = threads->create(sub { return [1] })->join();
  47     ok($retval->[0] == 1,"Check that a array ref works");
  48 }
  49 {
  50     my $retval = threads->create(sub { return { foo => "bar" }})->join();
  51     ok($retval->{foo} eq 'bar',"Check that hash refs work");
  52 }
  53 {
  54     my $retval = threads->create( sub {
  55         open(my $fh, "+>threadtest") || die $!;
  56         print $fh "test\n";
  57         return $fh;
  58     })->join();
  59     ok(ref($retval) eq 'GLOB', "Check that we can return FH $retval");
  60     print $retval "test2\n";
  61 #    seek($retval,0,0);
  62 #    ok(<$retval> eq "test\n");
  63     close($retval);
  64     unlink("threadtest");
  65 }
  66 {
  67     my $test = "hi";
  68     my $retval = threads->create(sub { return $_[0]}, \$test)->join();
  69     ok($$retval eq 'hi');
  70 }
  71 {
  72     my $test = "hi";
  73     share($test);
  74     my $retval = threads->create(sub { return $_[0]}, \$test)->join();
  75     ok($$retval eq 'hi');
  76     $test = "foo";
  77     ok($$retval eq 'foo');
  78 }
  79 {
  80     my %foo;
  81     share(%foo);
  82     threads->create(sub {
  83         my $foo;
  84         share($foo);
  85         $foo = "thread1";
  86         return $foo{bar} = \$foo;
  87     })->join();
  88     ok(1,"");
  89 }