ext/threads/t/blocks.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         threads::shared->import();
  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..5\n");   ### Number of tests that will be run ###
  32 };
  33
  34 my ($TEST, $COUNT, $TOTAL);
  35
  36 BEGIN {
  37     share($TEST);
  38     $TEST = 1;
  39     share($COUNT);
  40     $COUNT = 0;
  41     $TOTAL = 0;
  42 }
  43
  44 ok(1, 'Loaded');
  45
  46 sub ok {
  47     my ($ok, $name) = @_;
  48
  49     lock($TEST);
  50     my $id = $TEST++;
  51
  52     # You have to do it this way or VMS will get confused.
  53     if ($ok) {
  54         print("ok $id - $name\n");
  55     } else {
  56         print("not ok $id - $name\n");
  57         printf("# Failed test at line %d\n", (caller)[2]);
  58         print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
  59     }
  60
  61     return ($ok);
  62 }
  63
  64
  65 ### Start of Testing ###
  66
  67 $SIG{'__WARN__'} = sub { ok(0, "Warning: $_[0]"); };
  68
  69 sub foo { lock($COUNT); $COUNT++; }
  70 sub baz { 42 }
  71
  72 my $bthr;
  73 BEGIN {
  74     $SIG{'__WARN__'} = sub { ok(0, "BEGIN: $_[0]"); };
  75
  76     $TOTAL++;
  77     threads->create('foo')->join();
  78     $TOTAL++;
  79     threads->create(\&foo)->join();
  80     $TOTAL++;
  81     threads->create(sub { lock($COUNT); $COUNT++; })->join();
  82
  83     $TOTAL++;
  84     threads->create('foo')->detach();
  85     $TOTAL++;
  86     threads->create(\&foo)->detach();
  87     $TOTAL++;
  88     threads->create(sub { lock($COUNT); $COUNT++; })->detach();
  89
  90     $bthr = threads->create('baz');
  91 }
  92
  93 my $mthr;
  94 MAIN: {
  95     $TOTAL++;
  96     threads->create('foo')->join();
  97     $TOTAL++;
  98     threads->create(\&foo)->join();
  99     $TOTAL++;
 100     threads->create(sub { lock($COUNT); $COUNT++; })->join();
 101
 102     $TOTAL++;
 103     threads->create('foo')->detach();
 104     $TOTAL++;
 105     threads->create(\&foo)->detach();
 106     $TOTAL++;
 107     threads->create(sub { lock($COUNT); $COUNT++; })->detach();
 108
 109     $mthr = threads->create('baz');
 110 }
 111
 112 ok($mthr, 'Main thread');
 113 ok($bthr, 'BEGIN thread');
 114
 115 ok($mthr->join() == 42, 'Main join');
 116 ok($bthr->join() == 42, 'BEGIN join');
 117
 118 # Wait for detached threads to finish
 119 {
 120     threads->yield();
 121     sleep(1);
 122     lock($COUNT);
 123     redo if ($COUNT < $TOTAL);
 124 }
 125
 126 # EOF