ext/File-Glob/t/rt131211.t

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