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