t/41-threads-teardown.t

   1 #!perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Config qw/%Config/;
   7
   8 BEGIN {
   9  if (!$Config{useithreads}) {
  10   require Test::More;
  11   Test::More->import;
  12   plan(skip_all => 'This perl wasn\'t built to support threads');
  13  }
  14 }
  15
  16 use threads;
  17
  18 use Test::More;
  19
  20 BEGIN {
  21  delete $ENV{PERL_INDIRECT_PM_DISABLE};
  22  require indirect;
  23  if (indirect::I_THREADSAFE()) {
  24   plan tests => 1;
  25   defined and diag "Using threads $_" for $threads::VERSION;
  26  } else {
  27   plan skip_all => 'This indirect isn\'t thread safe';
  28  }
  29 }
  30
  31 sub run_perl {
  32  my $code = shift;
  33
  34  local %ENV;
  35  system { $^X } $^X, '-T', map("-I$_", @INC), '-e', $code;
  36 }
  37
  38 SKIP:
  39 {
  40  skip 'Fails on 5.8.2 and lower' => 1 if $] <= 5.008002;
  41
  42  my $status = run_perl <<' RUN';
  43   my ($code, @expected);
  44   BEGIN {
  45    $code = 2;
  46    @expected = qw/X Z/;
  47   }
  48   sub cb { --$code if $_[0] eq shift(@expected) || q{DUMMY} }
  49   use threads;
  50   $code = threads->create(sub {
  51    eval q{return; no indirect hook => \&cb; new X;};
  52    return $code;
  53   })->join;
  54   eval q{new Y;};
  55   eval q{return; no indirect hook => \&cb; new Z;};
  56   exit $code;
  57  RUN
  58  is $status, 0, 'loading the pragma in a thread and using it outside doesn\'t segfault';
  59 }