ext/File/Glob/t/basic.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     if ($^O eq 'MacOS') {
   6         @INC = qw(: ::lib ::macos:lib);
   7     } else {
   8         @INC = '.';
   9         push @INC, '../lib';
  10     }
  11     require Config; import Config;
  12     if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
  13         print "1..0\n";
  14         exit 0;
  15     }
  16 }
  17 use strict;
  18 use Test::More tests => 14;
  19 BEGIN {use_ok('File::Glob', ':glob')};
  20 use Cwd ();
  21
  22 # look for the contents of the current directory
  23 $ENV{PATH} = "/bin";
  24 delete @ENV{qw(BASH_ENV CDPATH ENV IFS)};
  25 my @correct = ();
  26 if (opendir(D, $^O eq "MacOS" ? ":" : ".")) {
  27    @correct = grep { !/^\./ } sort readdir(D);
  28    closedir D;
  29 }
  30 my @a = File::Glob::glob("*", 0);
  31 @a = sort @a;
  32 if (GLOB_ERROR) {
  33     fail(GLOB_ERROR);
  34 } else {
  35     is_deeply(\@a, \@correct);
  36 }
  37
  38 # look up the user's home directory
  39 # should return a list with one item, and not set ERROR
  40 SKIP: {
  41     my ($name, $home);
  42     skip $^O, 1 if $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS'
  43         || $^O eq 'os2' || $^O eq 'beos';
  44     skip "Can't find user for $>: $@", 1 unless eval {
  45         ($name, $home) = (getpwuid($>))[0,7];
  46         1;
  47     };
  48     skip "$> has no home directory", 1
  49         unless defined $home && defined $name && -d $home;
  50
  51     @a = bsd_glob("~$name", GLOB_TILDE);
  52
  53     if (GLOB_ERROR) {
  54         fail(GLOB_ERROR);
  55     } else {
  56         is_deeply (\@a, [$home]);
  57     }
  58 }
  59
  60 # check backslashing
  61 # should return a list with one item, and not set ERROR
  62 @a = bsd_glob('TEST', GLOB_QUOTE);
  63 if (GLOB_ERROR) {
  64     fail(GLOB_ERROR);
  65 } else {
  66     is_deeply(\@a, ['TEST']);
  67 }
  68
  69 # check nonexistent checks
  70 # should return an empty list
  71 # XXX since errfunc is NULL on win32, this test is not valid there
  72 @a = bsd_glob("asdfasdf", 0);
  73 SKIP: {
  74     skip $^O, 1 if $^O eq 'MSWin32' || $^O eq 'NetWare';
  75     is_deeply(\@a, []);
  76 }
  77
  78 # check bad protections
  79 # should return an empty list, and set ERROR
  80 SKIP: {
  81     skip $^O, 2 if $^O eq 'mpeix' or $^O eq 'MSWin32' or $^O eq 'NetWare'
  82         or $^O eq 'os2' or $^O eq 'VMS' or $^O eq 'cygwin';
  83     skip "AFS", 2 if Cwd::cwd() =~ m#^$Config{'afsroot'}#s;
  84     skip "running as root", 2 if not $>;
  85
  86     my $dir = "pteerslo";
  87     mkdir $dir, 0;
  88     @a = bsd_glob("$dir/*", GLOB_ERR);
  89     rmdir $dir;
  90     local $TODO = 'hit VOS bug posix-956' if $^O eq 'vos';
  91
  92     isnt(GLOB_ERROR, 0);
  93     is_deeply(\@a, []);
  94 }
  95
  96 # check for csh style globbing
  97 @a = bsd_glob('{a,b}', GLOB_BRACE | GLOB_NOMAGIC);
  98 is_deeply(\@a, ['a', 'b']);
  99
 100 @a = bsd_glob(
 101     '{TES*,doesntexist*,a,b}',
 102     GLOB_BRACE | GLOB_NOMAGIC | ($^O eq 'VMS' ? GLOB_NOCASE : 0)
 103 );
 104
 105 # Working on t/TEST often causes this test to fail because it sees Emacs temp
 106 # and RCS files.  Filter them out, and .pm files too, and patch temp files.
 107 @a = grep !/(,v$|~$|\.(pm|ori?g|rej)$)/, @a;
 108 @a = (grep !/test.pl/, @a) if $^O eq 'VMS';
 109
 110 print "# @a\n";
 111
 112 is_deeply(\@a, [($^O eq 'VMS'? 'test.' : 'TEST'), 'a', 'b']);
 113
 114 # "~" should expand to $ENV{HOME}
 115 $ENV{HOME} = "sweet home";
 116 @a = bsd_glob('~', GLOB_TILDE | GLOB_NOMAGIC);
 117 SKIP: {
 118     skip $^O, 1 if $^O eq "MacOS";
 119     is_deeply(\@a, [$ENV{HOME}]);
 120 }
 121
 122 # GLOB_ALPHASORT (default) should sort alphabetically regardless of case
 123 mkdir "pteerslo", 0777;
 124 chdir "pteerslo";
 125
 126 my @f_names = qw(Ax.pl Bx.pl Cx.pl aY.pl bY.pl cY.pl);
 127 my @f_alpha = qw(Ax.pl aY.pl Bx.pl bY.pl Cx.pl cY.pl);
 128 if ('a' lt 'A') { # EBCDIC char sets sort lower case before UPPER
 129     @f_names = sort(@f_names);
 130 }
 131 if ($^O eq 'VMS') { # VMS is happily caseignorant
 132     @f_alpha = qw(ax.pl ay.pl bx.pl by.pl cx.pl cy.pl);
 133     @f_names = @f_alpha;
 134 }
 135
 136 for (@f_names) {
 137     open T, "> $_";
 138     close T;
 139 }
 140
 141 my $pat = "*.pl";
 142
 143 my @g_names = bsd_glob($pat, 0);
 144 print "# f_names = @f_names\n";
 145 print "# g_names = @g_names\n";
 146 is_deeply(\@g_names, \@f_names);
 147
 148 my @g_alpha = bsd_glob($pat);
 149 print "# f_alpha = @f_alpha\n";
 150 print "# g_alpha = @g_alpha\n";
 151 is_deeply(\@g_alpha, \@f_alpha);
 152
 153 unlink @f_names;
 154 chdir "..";
 155 rmdir "pteerslo";
 156
 157 # this can panic if PL_glob_index gets passed as flags to bsd_glob
 158 <*>; <*>;
 159 pass("Don't panic");
 160
 161 {
 162     use File::Temp qw(tempdir);
 163     use File::Spec qw();
 164
 165     my($dir) = tempdir(CLEANUP => 1)
 166         or die "Could not create temporary directory";
 167     for my $file (qw(a_dej a_ghj a_qej)) {
 168         open my $fh, ">", File::Spec->catfile($dir, $file)
 169             or die "Could not create file $dir/$file: $!";
 170         close $fh;
 171     }
 172     my $cwd = Cwd::cwd();
 173     chdir $dir
 174         or die "Could not chdir to $dir: $!";
 175     my(@glob_files) = glob("a*{d[e]}j");
 176     chdir $cwd
 177         or die "Could not chdir back to $cwd: $!";
 178     local $TODO = "home-made glob doesn't do regexes" if $^O eq 'VMS';
 179     is_deeply(\@glob_files, ['a_dej']);
 180 }