ext/threads/t/context.t

   1 use strict;
   2 use warnings;
   3
   4 BEGIN {
   5     if ($ENV{'PERL_CORE'}){
   6         chdir 't';
   7         unshift @INC, '../lib';
   8     }
   9     use Config;
  10     if (! $Config{'useithreads'}) {
  11         print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
  12         exit(0);
  13     }
  14 }
  15
  16 use ExtUtils::testlib;
  17
  18 use threads;
  19
  20 BEGIN {
  21     if (! eval 'use threads::shared; 1') {
  22         print("1..0 # SKIP threads::shared not available\n");
  23         exit(0);
  24     }
  25
  26     $| = 1;
  27     print("1..31\n");   ### Number of tests that will be run ###
  28 };
  29
  30 my $TEST;
  31 BEGIN {
  32     share($TEST);
  33     $TEST = 1;
  34 }
  35
  36 ok(1, 'Loaded');
  37
  38 sub ok {
  39     my ($ok, $name) = @_;
  40
  41     lock($TEST);
  42     my $id = $TEST++;
  43
  44     # You have to do it this way or VMS will get confused.
  45     if ($ok) {
  46         print("ok $id - $name\n");
  47     } else {
  48         print("not ok $id - $name\n");
  49         printf("# Failed test at line %d\n", (caller)[2]);
  50     }
  51
  52     return ($ok);
  53 }
  54
  55
  56 ### Start of Testing ###
  57
  58 sub foo
  59 {
  60     my $context = shift;
  61     my $wantarray = wantarray();
  62
  63     if ($wantarray) {
  64         ok($context eq 'array', 'Array/list context');
  65         return ('array');
  66     } elsif (defined($wantarray)) {
  67         ok($context eq 'scalar', 'Scalar context');
  68         return 'scalar';
  69     } else {
  70         ok($context eq 'void', 'Void context');
  71         return;
  72     }
  73 }
  74
  75 my ($thr) = threads->create('foo', 'array');
  76 my ($res) = $thr->join();
  77 ok($res eq 'array', 'Implicit array context');
  78
  79 $thr = threads->create('foo', 'scalar');
  80 $res = $thr->join();
  81 ok($res eq 'scalar', 'Implicit scalar context');
  82
  83 threads->create('foo', 'void');
  84 ($thr) = threads->list();
  85 $res = $thr->join();
  86 ok(! defined($res), 'Implicit void context');
  87
  88 $thr = threads->create({'context' => 'array'}, 'foo', 'array');
  89 ($res) = $thr->join();
  90 ok($res eq 'array', 'Explicit array context');
  91
  92 ($thr) = threads->create({'scalar' => 'scalar'}, 'foo', 'scalar');
  93 $res = $thr->join();
  94 ok($res eq 'scalar', 'Explicit scalar context');
  95
  96 $thr = threads->create({'void' => 1}, 'foo', 'void');
  97 $res = $thr->join();
  98 ok(! defined($res), 'Explicit void context');
  99
 100
 101 sub bar
 102 {
 103     my $context = shift;
 104     my $wantarray = threads->wantarray();
 105
 106     if ($wantarray) {
 107         ok($context eq 'list', 'Array/list context');
 108         return ('list');
 109     } elsif (defined($wantarray)) {
 110         ok($context eq 'scalar', 'Scalar context');
 111         return 'scalar';
 112     } else {
 113         ok($context eq 'void', 'Void context');
 114         return;
 115     }
 116 }
 117
 118 ($thr) = threads->create('bar', 'list');
 119 my $ctx = $thr->wantarray();
 120 ok($ctx, 'Implicit array context');
 121 ($res) = $thr->join();
 122 ok($res eq 'list', 'Implicit array context');
 123
 124 $thr = threads->create('bar', 'scalar');
 125 $ctx = $thr->wantarray();
 126 ok(defined($ctx) && !$ctx, 'Implicit scalar context');
 127 $res = $thr->join();
 128 ok($res eq 'scalar', 'Implicit scalar context');
 129
 130 threads->create('bar', 'void');
 131 ($thr) = threads->list();
 132 $ctx = $thr->wantarray();
 133 ok(! defined($ctx), 'Implicit void context');
 134 $res = $thr->join();
 135 ok(! defined($res), 'Implicit void context');
 136
 137 $thr = threads->create({'context' => 'list'}, 'bar', 'list');
 138 $ctx = $thr->wantarray();
 139 ok($ctx, 'Explicit array context');
 140 ($res) = $thr->join();
 141 ok($res eq 'list', 'Explicit array context');
 142
 143 ($thr) = threads->create({'scalar' => 'scalar'}, 'bar', 'scalar');
 144 $ctx = $thr->wantarray();
 145 ok(defined($ctx) && !$ctx, 'Explicit scalar context');
 146 $res = $thr->join();
 147 ok($res eq 'scalar', 'Explicit scalar context');
 148
 149 $thr = threads->create({'void' => 1}, 'bar', 'void');
 150 $ctx = $thr->wantarray();
 151 ok(! defined($ctx), 'Explicit void context');
 152 $res = $thr->join();
 153 ok(! defined($res), 'Explicit void context');
 154
 155 exit(0);
 156
 157 # EOF