t/21-ctl.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use lib 't/lib';
   7 use Thread::Cleanup::TestThreads;
   8
   9 use Test::More;
  10
  11 use Thread::Cleanup;
  12
  13 my @stack : shared;
  14
  15 sub msg { lock @stack; push @stack, join ':', @_ }
  16
  17 Thread::Cleanup::register {
  18  msg 'cleanup';
  19  die 'cleanup';
  20  msg 'not reached 1';
  21 };
  22
  23 {
  24  local $SIG{__DIE__} = sub { msg 'sig', @_ };
  25  no warnings 'threads';
  26  my $thr = spawn(sub {
  27   msg 'spawn';
  28   die 'thread';
  29   msg 'not reached 2';
  30  });
  31  if ($thr) {
  32   plan tests    => 5 + 1;
  33  } else {
  34   plan skip_all => 'Could not spawn the testing thread';
  35  }
  36  $thr->join;
  37 }
  38
  39 msg 'done';
  40
  41 {
  42  lock @stack;
  43  is   shift(@stack), 'spawn';
  44  like shift(@stack), qr/sig:thread at \Q$0\E line \d+/;
  45  is   shift(@stack), 'cleanup';
  46  like shift(@stack), qr/sig:cleanup at \Q$0\E line \d+/;
  47  is   shift(@stack), 'done';
  48  is_deeply \@stack,  [ ], 'nothing more';
  49 }