This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Write tests for RT #77934.
[perl5.git] / dist / threads / t / kill3.t
1 use strict;
2 use warnings;
3
4 BEGIN {
5     require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl');
6
7     use Config;
8     if (! $Config{'useithreads'}) {
9         skip_all(q/Perl not compiled with 'useithreads'/);
10     }
11 }
12
13 use ExtUtils::testlib;
14 use Cwd;
15 my $cwd = cwd();
16
17 use threads;
18
19 BEGIN {
20     if (! eval 'use threads::shared; 1') {
21         skip_all('threads::shared not available');
22     }
23
24     local $SIG{'HUP'} = sub {};
25     my $thr = threads->create(sub {});
26     eval { $thr->kill('HUP') };
27     $thr->join();
28     if ($@ && $@ =~ /safe signals/) {
29         skip_all('Not using safe signals');
30     }
31
32     plan(2);
33 };
34
35 {
36     $SIG{'KILL'} = undef;
37     chdir '/tmp';
38     mkdir "toberead$$";
39     chdir "toberead$$";
40     for ('a'..'e') {
41         open my $THING, ">$_";
42         close $THING or die "$_: $!";
43     }
44     chdir $cwd;
45
46     local $ARGV[0] = undef;
47     fresh_perl_is(<<'EOI', 'ok', { }, 'RT #77934: Case: Perl-false $ARGV[0]');
48     local $@;
49     my $DIRH;
50     my $thr;
51     $thr = async {
52         # Thread 'cancellation' signal handler
53         $SIG{'KILL'} = sub { threads->exit(); };
54
55         opendir $DIRH, ".";
56         my $start = telldir $DIRH;
57         while (1) {
58             readdir $DIRH or seekdir $DIRH, 0;
59         }
60     } if $ARGV[0];
61
62     opendir $DIRH, ".";
63     for(1..5) {
64         select undef, undef, undef, .25;
65     }
66
67     if ($ARGV[0]) {
68         $thr->kill('KILL')->detach();
69     }
70     print($@ ? 'not ok' : 'ok');
71 EOI
72 }
73
74 {
75     $SIG{'KILL'} = undef;
76     chdir '/tmp';
77     mkdir "shouldberead$$";
78     chdir "shouldberead$$";
79     for ('a'..'e') {
80         open my $THING, ">$_";
81         close $THING or die "$_: $!";
82     }
83     chdir $cwd;
84
85     local $ARGV[0] = 1;
86     fresh_perl_is(<<'EOI', 'ok', { }, 'RT #77934: Case: Perl-true  $ARGV[0]');
87     local $@;
88     my $DIRH;
89     my $thr;
90     $thr = async {
91         # Thread 'cancellation' signal handler
92         $SIG{'KILL'} = sub { threads->exit(); };
93
94         opendir $DIRH, ".";
95         my $start = telldir $DIRH;
96         while (1) {
97             readdir $DIRH or seekdir $DIRH, 0;
98         }
99     } if $ARGV[0];
100
101     opendir $DIRH, ".";
102     for(1..5) {
103         select undef, undef, undef, .25;
104     }
105
106     if ($ARGV[0]) {
107         $thr->kill('KILL')->detach();
108     }
109     print($@ ? 'not ok' : 'ok');
110 EOI
111 }
112
113 exit(0);