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     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..5\n");   ### Number of tests that will be run ###
  28 };
  29
  30 my ($TEST, $COUNT, $TOTAL);
  31
  32 BEGIN {
  33     share($TEST);
  34     $TEST = 1;
  35     share($COUNT);
  36     $COUNT = 0;
  37     $TOTAL = 0;
  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         print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
  55     }
  56
  57     return ($ok);
  58 }
  59
  60
  61 ### Start of Testing ###
  62
  63 $SIG{'__WARN__'} = sub { ok(0, "Warning: $_[0]"); };
  64
  65 sub foo { lock($COUNT); $COUNT++; }
  66 sub baz { 42 }
  67
  68 my $bthr;
  69 BEGIN {
  70     $SIG{'__WARN__'} = sub { ok(0, "BEGIN: $_[0]"); };
  71
  72     $TOTAL++;
  73     threads->create('foo')->join();
  74     $TOTAL++;
  75     threads->create(\&foo)->join();
  76     $TOTAL++;
  77     threads->create(sub { lock($COUNT); $COUNT++; })->join();
  78
  79     $TOTAL++;
  80     threads->create('foo')->detach();
  81     $TOTAL++;
  82     threads->create(\&foo)->detach();
  83     $TOTAL++;
  84     threads->create(sub { lock($COUNT); $COUNT++; })->detach();
  85
  86     $bthr = threads->create('baz');
  87 }
  88
  89 my $mthr;
  90 MAIN: {
  91     $TOTAL++;
  92     threads->create('foo')->join();
  93     $TOTAL++;
  94     threads->create(\&foo)->join();
  95     $TOTAL++;
  96     threads->create(sub { lock($COUNT); $COUNT++; })->join();
  97
  98     $TOTAL++;
  99     threads->create('foo')->detach();
 100     $TOTAL++;
 101     threads->create(\&foo)->detach();
 102     $TOTAL++;
 103     threads->create(sub { lock($COUNT); $COUNT++; })->detach();
 104
 105     $mthr = threads->create('baz');
 106 }
 107
 108 ok($mthr, 'Main thread');
 109 ok($bthr, 'BEGIN thread');
 110
 111 ok($mthr->join() == 42, 'Main join');
 112 ok($bthr->join() == 42, 'BEGIN join');
 113
 114 # Wait for detached threads to finish
 115 {
 116     threads->yield();
 117     sleep(1);
 118     lock($COUNT);
 119     redo if ($COUNT < $TOTAL);
 120 }
 121
 122 exit(0);
 123
 124 # EOF