t/02_thread.t

   1 use Config;
   2 BEGIN {
   3   unless ($Config{useithreads}) {
   4     print "1..0 # SKIP your perl does not support ithreads\n";
   5     exit 0;
   6   }
   7 }
   8
   9 BEGIN {
  10   unless (eval { require threads }) {
  11     print "1..0 # SKIP threads.pm not installed\n";
  12     exit 0;
  13   }
  14 }
  15
  16 use threads;
  17 use threads::shared;
  18
  19 our $had_error :shared;
  20 END { $? = $had_error||0 }
  21
  22 use strict;
  23 use warnings;
  24
  25 BEGIN {
  26   if ($ENV{DEVEL_GLOBALDESTRUCTION_PP_TEST}) {
  27     no strict 'refs';
  28     no warnings 'redefine';
  29
  30     for my $f (qw(DynaLoader::bootstrap XSLoader::load)) {
  31       my ($mod) = $f =~ /^ (.+) \:\: [^:]+ $/x;
  32       eval "require $mod" or die $@;
  33
  34       my $orig = \&$f;
  35       *$f = sub {
  36         die 'no XS' if ($_[0]||'') eq 'Devel::GlobalDestruction';
  37         goto $orig;
  38       };
  39     }
  40   }
  41 }
  42
  43 # load it before spawning a thread, that's the whole point
  44 require Devel::GlobalDestruction;
  45
  46 sub do_test {
  47
  48   # just die so we don't need to deal with testcount skew
  49   unless ( ($_[0]||'') eq 'arg' ) {
  50     $had_error++;
  51     die "Argument passing failed!";
  52   }
  53
  54   delete $INC{'t/01_basic.t'};
  55   do 't/01_basic.t';
  56
  57   1;
  58 }
  59
  60 threads->create('do_test', 'arg')->join
  61   or $had_error++;