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