1# tests for RT 131211 2# 3# non-matching glob("a*a*a*...") went exponential time on number of a*'s 4 5 6use strict; 7use warnings; 8use v5.16.0; 9use File::Temp 'tempdir'; 10use File::Spec::Functions; 11use Test::More; 12use Time::HiRes qw(time); 13use Config; 14 15plan skip_all => 'This platform doesn\'t use File::Glob' 16 if $Config{ccflags} =~ /\b{wb}-DPERL_EXTERNAL_GLOB\b{wb}/; 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 36# VMS needs a real extension. 37map { $_ .= '.tmp' } @files if $^O eq 'VMS'; 38 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; 57 last if $elapsed_fail > ($elapsed_match < 0.2 ? 0.2 : $elapsed_match) * 100; 58} 59 60is $count,10, 61 "tried all the patterns without bailing out" 62 or diag("elapsed_match=$elapsed_match elapsed_fail=$elapsed_fail"); 63 64ok $elapsed_fail < 1 || $elapsed_fail <= 10 * $elapsed_match, 65 "time to fail should be less than 10x the time to match" 66 or diag("elapsed_match=$elapsed_match elapsed_fail=$elapsed_fail"); 67 68is "@got_files", catfile($path, $files[0]), 69 "only got the expected file for xa*..b"; 70is "@no_files", "", "shouldnt have files for xa*..c"; 71 72 73@got_files= glob catfile $path, "a*b*b*b*bc"; 74is "@got_files", catfile($path, $files[1]), 75 "only got the expected file for a*b*b*b*bc"; 76 77@got_files= sort glob catfile $path, "a*b*b*bc"; 78is "@got_files", catfile($path, $files[3])." ".catfile($path,$files[1]), 79 "got the expected two files for a*b*b*bc"; 80 81@got_files= sort glob catfile $path, "p*"; 82is "@got_files", catfile($path, $files[4]), 83 "p* matches pq"; 84 85@got_files= sort glob catfile $path, "r*???????"; 86is "@got_files", catfile($path, $files[6]), 87 "r*??????? works as expected"; 88 89@got_files= sort glob catfile $path, "w*e*w??e"; 90is "@got_files", join(" ", sort map { catfile($path, $files[$_]) } (7,8)), 91 "w*e*w??e works as expected"; 92 93@got_files= sort glob catfile $path, "w*e*we??"; 94is "@got_files", join(" ", sort map { catfile($path, $files[$_]) } (7,8,9,10)), 95 "w*e*we?? works as expected"; 96 97@got_files= sort glob catfile $path, "w**e**w"; 98is "@got_files", join(" ", sort map { catfile($path, $files[$_]) } (9)), 99 "w**e**w works as expected"; 100 101@got_files= sort glob catfile $path, "*wee*"; 102is "@got_files", join(" ", sort map { catfile($path, $files[$_]) } (8,9)), 103 "*wee* works as expected"; 104 105@got_files= sort glob catfile $path, "we*"; 106is "@got_files", join(" ", sort map { catfile($path, $files[$_]) } (7,8,9,10)), 107 "we* works as expected"; 108 109