ext/threads/t/end.t

   1 use strict;
   2 use warnings;
   3
   4 # test that END blocks are run in the thread that created them and
   5 # not in any child threads
   6
   7 BEGIN {
   8     if ($ENV{'PERL_CORE'}){
   9         chdir 't';
  10         unshift @INC, '../lib';
  11     }
  12     use Config;
  13     unless ($Config{'useithreads'}) {
  14         print "1..0 # Skip: no useithreads\n";
  15         exit 0;
  16     }
  17 }
  18
  19 use ExtUtils::testlib;
  20
  21 BEGIN { print "1..6\n" };
  22 use threads;
  23 use threads::shared;
  24
  25 my $test_id = 1;
  26 share($test_id);
  27
  28 sub ok {
  29     my ($ok, $name) = @_;
  30
  31     # You have to do it this way or VMS will get confused.
  32     print $ok ? "ok $test_id - $name\n" : "not ok $test_id - $name\n";
  33
  34     printf "# Failed test at line %d\n", (caller)[2] unless $ok;
  35     $test_id++;
  36     return $ok;
  37 }
  38 ok(1,'Loaded');
  39 END { ok(1,"End block run once") }
  40 threads->create(sub { eval "END { ok(1,'') }"})->join();
  41 threads->create(sub { eval "END { ok(1,'') }"})->join();
  42 threads->create(\&thread)->join();
  43
  44 sub thread {
  45         eval "END { ok(1,'') }";
  46         threads->create(sub { eval "END { ok(1,'') }"})->join();
  47 }