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..13\n");   ### Number of tests that will be run ###
  32 };
  33
  34 my $TEST = 1;
  35 share($TEST);
  36
  37 ok(1, 'Loaded');
  38
  39 sub ok {
  40     my ($ok, $name) = @_;
  41
  42     lock($TEST);
  43     my $id = $TEST++;
  44
  45     # You have to do it this way or VMS will get confused.
  46     if ($ok) {
  47         print("ok $id - $name\n");
  48     } else {
  49         print("not ok $id - $name\n");
  50         printf("# Failed test at line %d\n", (caller)[2]);
  51     }
  52
  53     return ($ok);
  54 }
  55
  56
  57 ### Start of Testing ###
  58
  59 sub foo
  60 {
  61     my $context = shift;
  62     my $wantarray = wantarray();
  63
  64     if ($wantarray) {
  65         ok($context eq 'array', 'Array context');
  66         return ('array');
  67     } elsif (defined($wantarray)) {
  68         ok($context eq 'scalar', 'Scalar context');
  69         return 'scalar';
  70     } else {
  71         ok($context eq 'void', 'Void context');
  72         return;
  73     }
  74 }
  75
  76 my ($thr) = threads->create('foo', 'array');
  77 my ($res) = $thr->join();
  78 ok($res eq 'array', 'Implicit array context');
  79
  80 $thr = threads->create('foo', 'scalar');
  81 $res = $thr->join();
  82 ok($res eq 'scalar', 'Implicit scalar context');
  83
  84 threads->create('foo', 'void');
  85 ($thr) = threads->list();
  86 $res = $thr->join();
  87 ok(! defined($res), 'Implicit void context');
  88
  89 $thr = threads->create({'context' => 'array'}, 'foo', 'array');
  90 ($res) = $thr->join();
  91 ok($res eq 'array', 'Explicit array context');
  92
  93 ($thr) = threads->create({'scalar' => 'scalar'}, 'foo', 'scalar');
  94 $res = $thr->join();
  95 ok($res eq 'scalar', 'Explicit scalar context');
  96
  97 $thr = threads->create({'void' => 1}, 'foo', 'void');
  98 $res = $thr->join();
  99 ok(! defined($res), 'Explicit void context');
 100
 101 # EOF