Skip to content

Commit c057bd3

Browse files
committed
Remove dubious thread dirhandle cloning test
This tests makes assumptions that are only true for the current fchdir based implementation of dirhandle cloning. In particular that the cloned dirhandle is entirely separate from the original. This is not appropriate for the upcoming fdopendir based implementation.
1 parent ab79bb2 commit c057bd3

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)