ext/File-Glob/t/rt131211.t

   1 # tests for RT 131211
   2 #
   3 # non-matching glob("a*a*a*...") went exponential time on number of a*'s
   4
   5
   6 use strict;
   7 use warnings;
   8 use v5.16.0;
   9 use File::Temp 'tempdir';
  10 use File::Spec::Functions;
  11 use Test::More;
  12 use Time::HiRes qw(time);
  13 use Config;
  14
  15 plan skip_all => 'This platform doesn\'t use File::Glob'
  16                     if $Config{ccflags} =~ /\b{wb}-DPERL_EXTERNAL_GLOB\b{wb}/;
  17 plan tests => 13;
  18
  19 my $path = tempdir uc cleanup => 1;
  20 my @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.
  37 map { $_ .= '.tmp' } @files if $^O eq 'VMS';
  38
  39 foreach (@files) {
  40     open(my $f, ">", catfile $path, $_);
  41 }
  42
  43 my $elapsed_fail= 0;
  44 my $elapsed_match= 0;
  45 my @got_files;
  46 my @no_files;
  47 my $count = 0;
  48
  49 while (++$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
  60 is $count,10,
  61     "tried all the patterns without bailing out"
  62     or diag("elapsed_match=$elapsed_match elapsed_fail=$elapsed_fail");
  63
  64 SKIP: {
  65     skip "unstable  or too small timing", 1 unless
  66             $elapsed_match >= 0.01 && $elapsed_fail >= 0.01;
  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
  72 is "@got_files", catfile($path, $files[0]),
  73     "only got the expected file for xa*..b";
  74 is "@no_files", "", "shouldnt have files for xa*..c";
  75
  76
  77 @got_files= glob catfile $path, "a*b*b*b*bc";
  78 is "@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";
  82 is "@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*";
  86 is "@got_files", catfile($path, $files[4]),
  87     "p* matches pq";
  88
  89 @got_files= sort glob catfile $path, "r*???????";
  90 is "@got_files", catfile($path, $files[6]),
  91     "r*??????? works as expected";
  92
  93 @got_files= sort glob catfile $path, "w*e*w??e";
  94 is "@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??";
  98 is "@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";
 102 is "@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*";
 106 is "@got_files", join(" ", sort map { catfile($path, $files[$_]) } (8,9)),
 107     "*wee* works as expected";
 108
 109 @got_files= sort glob catfile $path, "we*";
 110 is "@got_files", join(" ", sort map { catfile($path, $files[$_]) } (7,8,9,10)),
 111     "we* works as expected";
 112