]> git.vpit.fr Git - perl/modules/Thread-Cleanup.git/blob - t/21-ctl.t
This is 0.05
[perl/modules/Thread-Cleanup.git] / 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 }