dist/threads/t/blocks.t

   1 use strict;
   2 use warnings;
   3
   4 BEGIN {
   5     use Config;
   6     if (! $Config{'useithreads'}) {
   7         print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
   8         exit(0);
   9     }
  10 }
  11
  12 use ExtUtils::testlib;
  13
  14 use threads;
  15
  16 BEGIN {
  17     if (! eval 'use threads::shared; 1') {
  18         print("1..0 # SKIP threads::shared not available\n");
  19         exit(0);
  20     }
  21
  22     $| = 1;
  23     print("1..5\n");   ### Number of tests that will be run ###
  24 };
  25
  26 my ($TEST, $COUNT, $TOTAL);
  27
  28 BEGIN {
  29     share($TEST);
  30     $TEST = 1;
  31     share($COUNT);
  32     $COUNT = 0;
  33     $TOTAL = 0;
  34 }
  35
  36 ok(1, 'Loaded');
  37
  38 sub ok {
  39     my ($ok, $name) = @_;
  40
  41     lock($TEST);
  42     my $id = $TEST++;
  43
  44     # You have to do it this way or VMS will get confused.
  45     if ($ok) {
  46         print("ok $id - $name\n");
  47     } else {
  48         print("not ok $id - $name\n");
  49         printf("# Failed test at line %d\n", (caller)[2]);
  50         print(STDERR "# FAIL: $name\n") if (! $ENV{'PERL_CORE'});
  51     }
  52
  53     return ($ok);
  54 }
  55
  56
  57 ### Start of Testing ###
  58
  59 $SIG{'__WARN__'} = sub { ok(0, "Warning: $_[0]"); };
  60
  61 sub foo { lock($COUNT); $COUNT++; }
  62 sub baz { 42 }
  63
  64 my $bthr;
  65 BEGIN {
  66     $SIG{'__WARN__'} = sub { ok(0, "BEGIN: $_[0]"); };
  67
  68     $TOTAL++;
  69     threads->create('foo')->join();
  70     $TOTAL++;
  71     threads->create(\&foo)->join();
  72     $TOTAL++;
  73     threads->create(sub { lock($COUNT); $COUNT++; })->join();
  74
  75     $TOTAL++;
  76     threads->create('foo')->detach();
  77     $TOTAL++;
  78     threads->create(\&foo)->detach();
  79     $TOTAL++;
  80     threads->create(sub { lock($COUNT); $COUNT++; })->detach();
  81
  82     $bthr = threads->create('baz');
  83 }
  84
  85 my $mthr;
  86 MAIN: {
  87     $TOTAL++;
  88     threads->create('foo')->join();
  89     $TOTAL++;
  90     threads->create(\&foo)->join();
  91     $TOTAL++;
  92     threads->create(sub { lock($COUNT); $COUNT++; })->join();
  93
  94     $TOTAL++;
  95     threads->create('foo')->detach();
  96     $TOTAL++;
  97     threads->create(\&foo)->detach();
  98     $TOTAL++;
  99     threads->create(sub { lock($COUNT); $COUNT++; })->detach();
 100
 101     $mthr = threads->create('baz');
 102 }
 103
 104 ok($mthr, 'Main thread');
 105 ok($bthr, 'BEGIN thread');
 106
 107 ok($mthr->join() == 42, 'Main join');
 108 ok($bthr->join() == 42, 'BEGIN join');
 109
 110 # Wait for detached threads to finish
 111 {
 112     threads->yield();
 113     sleep(1);
 114     lock($COUNT);
 115     redo if ($COUNT < $TOTAL);
 116 }
 117
 118 exit(0);
 119
 120 # EOF