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