xref: /openbsd/gnu/usr.bin/perl/dist/threads/t/kill3.t (revision 73471bf0) 
1use strict;
2use warnings;
3
4BEGIN {
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
13use ExtUtils::testlib;
14use File::Path ();
15use File::Spec;
16use Cwd;
17my $cwd = cwd();
18
19use threads;
20
21BEGIN {
22    if (! eval 'use threads::shared; 1') {
23        skip_all('threads::shared not available');
24    }
25
26    local $SIG{'HUP'} = sub {};
27    my $thr = threads->create(sub {});
28    eval { $thr->kill('HUP') };
29    $thr->join();
30    if ($@ && $@ =~ /safe signals/) {
31        skip_all('Not using safe signals');
32    }
33
34    plan(2);
35};
36
37{
38    $SIG{'KILL'} = undef;
39    my $tmp = File::Spec->tmpdir();
40    chdir $tmp;
41    my $dir = File::Spec->catdir( $tmp, "toberead$$" );
42    mkdir $dir;
43    chdir $dir;
44    for ('a'..'e') {
45        open my $THING, ">$_";
46        close $THING or die "$_: $!";
47    }
48    chdir $cwd;
49
50    local $ARGV[0] = undef;
51    fresh_perl_is(<<'EOI', 'ok', { }, 'RT #77934: Case: Perl-false $ARGV[0]');
52    local $@;
53    my $DIRH;
54    my $thr;
55    $thr = async {
56        # Thread 'cancellation' signal handler
57        $SIG{'KILL'} = sub { threads->exit(); };
58
59        opendir $DIRH, ".";
60        my $start = telldir $DIRH;
61        while (1) {
62            readdir $DIRH or seekdir $DIRH, 0;
63        }
64    } if $ARGV[0];
65
66    opendir $DIRH, ".";
67    for(1..5) {
68        select undef, undef, undef, .25;
69    }
70
71    if ($ARGV[0]) {
72        $thr->kill('KILL')->detach();
73    }
74    print($@ ? 'not ok' : 'ok');
75EOI
76    File::Path::rmtree($dir);
77}
78
79{
80    $SIG{'KILL'} = undef;
81    my $tmp = File::Spec->tmpdir();
82    chdir $tmp;
83    my $dir = File::Spec->catdir( $tmp, "shouldberead$$" );
84    mkdir $dir;
85    chdir $dir;
86    for ('a'..'e') {
87        open my $THING, ">$_";
88        close $THING or die "$_: $!";
89    }
90    chdir $cwd;
91
92    local $ARGV[0] = 1;
93    fresh_perl_is(<<'EOI', 'ok', { }, 'RT #77934: Case: Perl-true  $ARGV[0]');
94    local $@;
95    my $DIRH;
96    my $thr;
97    $thr = async {
98        # Thread 'cancellation' signal handler
99        $SIG{'KILL'} = sub { threads->exit(); };
100
101        opendir $DIRH, ".";
102        my $start = telldir $DIRH;
103        while (1) {
104            readdir $DIRH or seekdir $DIRH, 0;
105        }
106    } if $ARGV[0];
107
108    opendir $DIRH, ".";
109    for(1..5) {
110        select undef, undef, undef, .25;
111    }
112
113    if ($ARGV[0]) {
114        $thr->kill('KILL')->detach();
115    }
116    print($@ ? 'not ok' : 'ok');
117EOI
118    File::Path::rmtree($dir);
119}
120
121exit(0);
122