Skip to content

Commit c4c8ed7

Browse files
committed
Remove dubious thread dirhandle cloning test
1 parent ab79bb2 commit c4c8ed7

File tree

1 file changed

+1
-103
lines changed

1 file changed

+1
-103
lines changed

t/op/threads-dirh.t

Lines changed: 1 addition & 103 deletions
Original file line numberDiff line numberDiff line change
@@ -13,16 +13,12 @@ BEGIN {
1313
skip_all_if_miniperl("no dynamic loading on miniperl, no threads");
1414
skip_all("runs out of memory on some EBCDIC") if $ENV{PERL_SKIP_BIG_MEM_TESTS};
1515

16-
plan(6);
16+
plan(1);
1717
}
1818

1919
use strict;
2020
use warnings;
2121
use threads;
22-
use threads::shared;
23-
use File::Path;
24-
use File::Spec::Functions qw 'updir catdir';
25-
use Cwd 'getcwd';
2622

2723
# Basic sanity check: make sure this does not crash
2824
fresh_perl_is <<'# this is no comment', 'ok', {}, 'crash when duping dirh';
@@ -31,101 +27,3 @@ fresh_perl_is <<'# this is no comment', 'ok', {}, 'crash when duping dirh';
3127
async{}->join for 1..2;
3228
print "ok";
3329
# this is no comment
34-
35-
my $dir;
36-
SKIP: {
37-
skip "telldir or seekdir not defined on this platform", 5
38-
if !$Config::Config{d_telldir} || !$Config::Config{d_seekdir};
39-
my $skip = sub {
40-
chdir($dir);
41-
chdir updir;
42-
skip $_[0], 5
43-
};
44-
45-
if(!$Config::Config{d_fchdir} && $^O ne "MSWin32") {
46-
$::TODO = 'dir handle cloning currently requires fchdir on non-Windows platforms';
47-
}
48-
49-
my @w :shared; # warnings accumulator
50-
local $SIG{__WARN__} = sub { push @w, $_[0] };
51-
52-
$dir = catdir getcwd(), "thrext$$" . int rand() * 100000;
53-
54-
rmtree($dir) if -d $dir;
55-
mkdir($dir);
56-
57-
# Create a dir structure like this:
58-
# $dir
59-
# |
60-
# `- toberead
61-
# |
62-
# +---- thrit
63-
# |
64-
# +---- rile
65-
# |
66-
# `---- zor
67-
68-
chdir($dir);
69-
mkdir 'toberead';
70-
chdir 'toberead';
71-
{open my $fh, ">thrit" or &$skip("Cannot create file thrit")}
72-
{open my $fh, ">rile" or &$skip("Cannot create file rile")}
73-
{open my $fh, ">zor" or &$skip("Cannot create file zor")}
74-
chdir updir;
75-
76-
# Then test that dir iterators are cloned correctly.
77-
78-
opendir my $toberead, 'toberead';
79-
my $start_pos = telldir $toberead;
80-
my @first_2 = (scalar readdir $toberead, scalar readdir $toberead);
81-
my @from_thread = @{; async { [readdir $toberead ] } ->join };
82-
my @from_main = readdir $toberead;
83-
is join('-', sort @from_thread), join('-', sort @from_main),
84-
'dir iterator is copied from one thread to another';
85-
like
86-
join('-', "", sort(@first_2, @from_thread), ""),
87-
qr/(?<!-rile)-rile-thrit-zor-(?!zor-)/i,
88-
'cloned iterator iterates exactly once over everything not already seen';
89-
90-
seekdir $toberead, $start_pos;
91-
readdir $toberead for 1 .. @first_2+@from_thread;
92-
{
93-
local $::TODO; # This always passes when dir handles are not cloned.
94-
is
95-
async { readdir $toberead // 'undef' } ->join, 'undef',
96-
'cloned dir iterator that points to the end of the directory'
97-
;
98-
}
99-
100-
# Make sure the cloning code can handle file names longer than 255 chars
101-
SKIP: {
102-
chdir 'toberead';
103-
open my $fh,
104-
">floccipaucinihilopilification-"
105-
. "pneumonoultramicroscopicsilicovolcanoconiosis-"
106-
. "lopadotemachoselachogaleokranioleipsanodrimypotrimmatosilphiokarabo"
107-
. "melitokatakechymenokichlepikossyphophattoperisteralektryonoptokephal"
108-
. "liokinklopeleiolagoiosiraiobaphetraganopterygon"
109-
or
110-
chdir updir,
111-
skip("OS does not support long file names (and I mean *long*)", 1);
112-
chdir updir;
113-
opendir my $dirh, "toberead";
114-
my $test_name
115-
= "dir iterators can be cloned when the next fn > 255 chars";
116-
while() {
117-
my $pos = telldir $dirh;
118-
my $fn = readdir($dirh);
119-
if(!defined $fn) { fail($test_name); last SKIP; }
120-
if($fn =~ 'lagoio') {
121-
seekdir $dirh, $pos;
122-
last;
123-
}
124-
}
125-
is length async { scalar readdir $dirh } ->join, 258, $test_name;
126-
}
127-
128-
is scalar @w, 0, 'no warnings during all that' or diag @w;
129-
chdir updir;
130-
}
131-
rmtree($dir);

0 commit comments

Comments
 (0)