]> git.vpit.fr Git - perl/modules/Thread-Cleanup.git/blob - t/21-ctl.t
Remove obsolete kwalitee workarounds
[perl/modules/Thread-Cleanup.git] / 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 }