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 use threads::shared;
  20
  21 BEGIN {
  22     $| = 1;
  23     print("1..6\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 # Test that END blocks are run in the thread that created them,
  52 # and not in any child threads.
  53
  54 END {
  55     ok(1, 'Main END block')
  56 }
  57
  58 threads->create(sub { eval "END { ok(1, '1st thread END block') }"})->join();
  59 threads->create(sub { eval "END { ok(1, '2nd thread END block') }"})->join();
  60
  61 sub thread {
  62     eval "END { ok(1, '4th thread END block') }";
  63     threads->create(sub { eval "END { ok(1, '5th thread END block') }"})->join();
  64 }
  65 threads->create(\&thread)->join();
  66
  67 # EOF