]> git.vpit.fr Git - perl/modules/indirect.git/blob - t/41-threads-teardown.t
Harden t/40-threads.t and t/42-threads-global.t against stray exits
[perl/modules/indirect.git] / t / 41-threads-teardown.t
1 #!perl
2
3 use strict;
4 use warnings;
5
6 use lib 't/lib';
7 use VPIT::TestHelpers (
8  threads => [ 'indirect' => 'indirect::I_THREADSAFE()' ],
9  'run_perl',
10 );
11
12 use Test::Leaner tests => 3;
13
14 SKIP: {
15  skip 'Fails on 5.8.2 and lower' => 1 if "$]" <= 5.008_002;
16
17  my $status = run_perl <<' RUN';
18   my ($code, @expected);
19   BEGIN {
20    $code = 2;
21    @expected = qw<X Z>;
22   }
23   sub cb { --$code if $_[0] eq shift(@expected) || q{DUMMY} }
24   use threads;
25   $code = threads->create(sub {
26    eval q{return; no indirect hook => \&cb; new X;};
27    return $code;
28   })->join;
29   eval q{new Y;};
30   eval q{return; no indirect hook => \&cb; new Z;};
31   exit $code;
32  RUN
33  skip RUN_PERL_FAILED() => 1 unless defined $status;
34  is $status, 0,
35         'loading the pragma in a thread and using it outside doesn\'t segfault';
36 }
37
38 SKIP: {
39  my $status = run_perl <<' RUN';
40   use threads;
41   BEGIN { require indirect; }
42   sub X2::DESTROY { eval 'no indirect; 1'; exit 1 if $@ }
43   threads->create(sub {
44    my $x = bless { }, 'X2';
45    $x->{self} = $x;
46    return;
47   })->join;
48   exit $code;
49  RUN
50  skip RUN_PERL_FAILED() => 1 unless defined $status;
51  is $status, 0, 'indirect can be loaded in eval STRING during global destruction at the end of a thread';
52 }
53
54 SKIP: {
55  my $status = run_perl <<' RUN';
56   use threads;
57   use threads::shared;
58   my $code : shared;
59   $code = 0;
60   no indirect hook => sub { lock $code; ++$code };
61   sub X3::DESTROY { eval $_[0]->{code} }
62   threads->create(sub {
63    my $x = bless { code => 'new Z3' }, 'X3';
64    $x->{self} = $x;
65    return;
66   })->join;
67   exit $code;
68  RUN
69  skip RUN_PERL_FAILED() => 1 unless defined $status;
70  my $code = $status >> 8;
71  is $code, 1, 'indirect checks eval STRING during global destruction at the end of a cloned thread';
72 }