This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
ext/File-Glob/t/rt131211.t: fix timing issues #2
[perl5.git] / ext / File-Glob / t / rt131211.t
CommitLineData
f548aeca
DM
1# tests for RT 131211
2#
3# non-matching glob("a*a*a*...") went exponential time on number of a*'s
4
5
0db967b2
YO
6use strict;
7use warnings;
8use v5.16.0;
9use File::Temp 'tempdir';
10use File::Spec::Functions;
11use Test::More;
12use Time::HiRes qw(time);
5a993d81 13use Config;
0db967b2 14
5a993d81 15plan skip_all => 'This platform doesn\'t use File::Glob'
d37c508e 16 if $Config{ccflags} =~ /\b{wb}-DPERL_EXTERNAL_GLOB\b{wb}/;
0db967b2
YO
17plan tests => 13;
18
19my $path = tempdir uc cleanup => 1;
20my @files= (
21 "x".("a" x 50)."b", # 0
22 "abbbbbbbbbbbbc", # 1
23 "abbbbbbbbbbbbd", # 2
24 "aaabaaaabaaaabc", # 3
25 "pq", # 4
26 "r", # 5
27 "rttiiiiiii", # 6
28 "wewewewewewe", # 7
29 "weeeweeeweee", # 8
30 "weewweewweew", # 9
31 "wewewewewewewewewewewewewewewewewq", # 10
32 "wtttttttetttttttwr", # 11
33);
34
35
85957ede
CB
36# VMS needs a real extension.
37map { $_ .= '.tmp' } @files if $^O eq 'VMS';
38
0db967b2
YO
39foreach (@files) {
40 open(my $f, ">", catfile $path, $_);
41}
42
43my $elapsed_fail= 0;
44my $elapsed_match= 0;
45my @got_files;
46my @no_files;
47my $count = 0;
48
49while (++$count < 10) {
50 $elapsed_match -= time;
51 @got_files= glob catfile $path, "x".("a*" x $count) . "b";
52 $elapsed_match += time;
53
54 $elapsed_fail -= time;
55 @no_files= glob catfile $path, "x".("a*" x $count) . "c";
56 $elapsed_fail += time;
f548aeca 57 last if $elapsed_fail > ($elapsed_match < 0.2 ? 0.2 : $elapsed_match) * 100;
0db967b2
YO
58}
59
60is $count,10,
f548aeca
DM
61 "tried all the patterns without bailing out"
62 or diag("elapsed_match=$elapsed_match elapsed_fail=$elapsed_fail");
0db967b2 63
b4d257e2 64SKIP: {
f548aeca 65 skip "unstable or too small timing", 1 unless
9770e07b 66 $elapsed_match >= 0.01 && $elapsed_fail >= 0.01;
b4d257e2
YO
67 ok $elapsed_fail <= 10 * $elapsed_match,
68 "time to fail less than 10x the time to match"
69 or diag("elapsed_match=$elapsed_match elapsed_fail=$elapsed_fail");
70}
71
0db967b2
YO
72is "@got_files", catfile($path, $files[0]),
73 "only got the expected file for xa*..b";
74is "@no_files", "", "shouldnt have files for xa*..c";
75
76
77@got_files= glob catfile $path, "a*b*b*b*bc";
78is "@got_files", catfile($path, $files[1]),
79 "only got the expected file for a*b*b*b*bc";
80
81@got_files= sort glob catfile $path, "a*b*b*bc";
82is "@got_files", catfile($path, $files[3])." ".catfile($path,$files[1]),
83 "got the expected two files for a*b*b*bc";
84
85@got_files= sort glob catfile $path, "p*";
86is "@got_files", catfile($path, $files[4]),
87 "p* matches pq";
88
89@got_files= sort glob catfile $path, "r*???????";
90is "@got_files", catfile($path, $files[6]),
91 "r*??????? works as expected";
92
93@got_files= sort glob catfile $path, "w*e*w??e";
94is "@got_files", join(" ", sort map { catfile($path, $files[$_]) } (7,8)),
95 "w*e*w??e works as expected";
96
97@got_files= sort glob catfile $path, "w*e*we??";
98is "@got_files", join(" ", sort map { catfile($path, $files[$_]) } (7,8,9,10)),
99 "w*e*we?? works as expected";
100
101@got_files= sort glob catfile $path, "w**e**w";
102is "@got_files", join(" ", sort map { catfile($path, $files[$_]) } (9)),
103 "w**e**w works as expected";
104
105@got_files= sort glob catfile $path, "*wee*";
106is "@got_files", join(" ", sort map { catfile($path, $files[$_]) } (8,9)),
107 "*wee* works as expected";
108
109@got_files= sort glob catfile $path, "we*";
110is "@got_files", join(" ", sort map { catfile($path, $files[$_]) } (7,8,9,10)),
111 "we* works as expected";
112