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