ext/threads/t/end.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..6\n");   ### Number of tests that will be run ###
  28 };
  29
  30 my $TEST;
  31 BEGIN {
  32     share($TEST);
  33     $TEST = 1;
  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     }
  51
  52     return ($ok);
  53 }
  54
  55
  56 ### Start of Testing ###
  57
  58 # Test that END blocks are run in the thread that created them,
  59 # and not in any child threads.
  60
  61 END {
  62     ok(1, 'Main END block')
  63 }
  64
  65 threads->create(sub { eval "END { ok(1, '1st thread END block') }"})->join();
  66 threads->create(sub { eval "END { ok(1, '2nd thread END block') }"})->join();
  67
  68 sub thread {
  69     eval "END { ok(1, '4th thread END block') }";
  70     threads->create(sub { eval "END { ok(1, '5th thread END block') }"})->join();
  71 }
  72 threads->create(\&thread)->join();
  73
  74 exit(0);
  75
  76 # EOF