t/21-ctl.t

   1 #!perl -T
   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 use threads::shared;
  18
  19 use Test::More tests => 5 + 1;
  20
  21 BEGIN {
  22  defined and diag "Using threads $_"         for $threads::VERSION;
  23  defined and diag "Using threads::shared $_" for $threads::shared::VERSION;
  24 }
  25
  26 use Thread::Cleanup;
  27
  28 my @stack : shared;
  29
  30 sub msg { lock @stack; push @stack, join ':', @_ }
  31
  32 Thread::Cleanup::register {
  33  msg 'cleanup';
  34  die 'cleanup';
  35  msg 'not reached 1';
  36 };
  37
  38 {
  39  local $SIG{__DIE__} = sub { msg 'sig', @_ };
  40  no warnings 'threads';
  41  threads->create(sub {
  42   msg 'spawn';
  43   die 'thread';
  44   msg 'not reached 2';
  45  })->join;
  46 }
  47
  48 msg 'done';
  49
  50 {
  51  lock @stack;
  52  is   shift(@stack), 'spawn';
  53  like shift(@stack), qr/sig:thread at \Q$0\E line \d+/;
  54  is   shift(@stack), 'cleanup';
  55  like shift(@stack), qr/sig:cleanup at \Q$0\E line \d+/;
  56  is   shift(@stack), 'done';
  57  is_deeply \@stack,  [ ], 'nothing more';
  58 }