143003dfeSmillert#!./perl 243003dfeSmillert 343003dfeSmillertBEGIN { 443003dfeSmillert chdir 't' if -d 't'; 5898184e3Ssthen @INC = '../lib'; 643003dfeSmillert require Config; import Config; 743003dfeSmillert if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) { 843003dfeSmillert print "1..0\n"; 943003dfeSmillert exit 0; 1043003dfeSmillert } 1143003dfeSmillert} 1243003dfeSmillertuse strict; 13898184e3Ssthenuse Test::More tests => 49; 1443003dfeSmillertBEGIN {use_ok('File::Glob', ':glob')}; 1543003dfeSmillertuse Cwd (); 1643003dfeSmillert 1743003dfeSmillertmy $vms_unix_rpt = 0; 1843003dfeSmillertmy $vms_efs = 0; 1943003dfeSmillertmy $vms_mode = 0; 2043003dfeSmillertif ($^O eq 'VMS') { 2143003dfeSmillert if (eval 'require VMS::Feature') { 2243003dfeSmillert $vms_unix_rpt = VMS::Feature::current("filename_unix_report"); 2343003dfeSmillert $vms_efs = VMS::Feature::current("efs_charset"); 2443003dfeSmillert } else { 2543003dfeSmillert my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || ''; 2643003dfeSmillert my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || ''; 2743003dfeSmillert $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i; 2843003dfeSmillert $vms_efs = $efs_charset =~ /^[ET1]/i; 2943003dfeSmillert } 3043003dfeSmillert $vms_mode = 1 unless ($vms_unix_rpt); 3143003dfeSmillert} 3243003dfeSmillert 3343003dfeSmillert 3443003dfeSmillert# look for the contents of the current directory 356fb12b70Safresh1# try it in a directory that doesn't get modified during testing, 366fb12b70Safresh1# so parallel testing won't give us race conditions. t/base/ seems 376fb12b70Safresh1# fairly static 386fb12b70Safresh1 396fb12b70Safresh1chdir 'base' or die "chdir base: $!"; 4043003dfeSmillert$ENV{PATH} = "/bin"; 4143003dfeSmillertdelete @ENV{qw(BASH_ENV CDPATH ENV IFS)}; 4243003dfeSmillertmy @correct = (); 43898184e3Ssthenif (opendir(D, ".")) { 4443003dfeSmillert @correct = grep { !/^\./ } sort readdir(D); 4543003dfeSmillert closedir D; 4643003dfeSmillert} 47de8cc8edSafresh1 48de8cc8edSafresh1is( 49de8cc8edSafresh1 File::Glob->can('glob'), 50de8cc8edSafresh1 undef, 51de8cc8edSafresh1 'Did not find glob() function in File::Glob', 52de8cc8edSafresh1); 53de8cc8edSafresh1 546fb12b70Safresh1chdir '..' or die "chdir .. $!"; 5543003dfeSmillert 5643003dfeSmillert# look up the user's home directory 5743003dfeSmillert# should return a list with one item, and not set ERROR 58f3efcd01Safresh1my @a; 59f3efcd01Safresh1 6043003dfeSmillertSKIP: { 6143003dfeSmillert my ($name, $home); 62*256a93a4Safresh1 skip $^O, 1 if $^O eq 'MSWin32' || $^O eq 'VMS' 6391f110e0Safresh1 || $^O eq 'os2'; 6443003dfeSmillert skip "Can't find user for $>: $@", 1 unless eval { 6543003dfeSmillert ($name, $home) = (getpwuid($>))[0,7]; 6643003dfeSmillert 1; 6743003dfeSmillert }; 6843003dfeSmillert skip "$> has no home directory", 1 6943003dfeSmillert unless defined $home && defined $name && -d $home; 7043003dfeSmillert 7143003dfeSmillert @a = bsd_glob("~$name", GLOB_TILDE); 7243003dfeSmillert 7343003dfeSmillert if (GLOB_ERROR) { 7443003dfeSmillert fail(GLOB_ERROR); 7543003dfeSmillert } else { 76f3efcd01Safresh1 is_deeply (\@a, [$home], 77f3efcd01Safresh1 "GLOB_TILDE expands patterns that start with '~' to user name home directories" 78f3efcd01Safresh1 ); 7943003dfeSmillert } 8043003dfeSmillert} 81898184e3Ssthen# check plain tilde expansion 82898184e3Ssthen{ 83898184e3Ssthen my $tilde_check = sub { 84898184e3Ssthen my @a = bsd_glob('~'); 85898184e3Ssthen 86898184e3Ssthen if (GLOB_ERROR) { 87898184e3Ssthen fail(GLOB_ERROR); 88898184e3Ssthen } else { 89898184e3Ssthen is_deeply (\@a, [$_[0]], join ' - ', 'tilde expansion', @_ > 1 ? $_[1] : ()); 90898184e3Ssthen } 91898184e3Ssthen }; 92898184e3Ssthen my $passwd_home = eval { (getpwuid($>))[7] }; 93898184e3Ssthen 94898184e3Ssthen TODO: { 95898184e3Ssthen local $TODO = 'directory brackets look like pattern brackets to glob' if $^O eq 'VMS'; 96898184e3Ssthen local $ENV{HOME}; 97898184e3Ssthen delete $ENV{HOME}; 98898184e3Ssthen local $ENV{USERPROFILE}; 99898184e3Ssthen delete $ENV{USERPROFILE}; 100898184e3Ssthen $tilde_check->(defined $passwd_home ? $passwd_home : q{~}, 'no environment'); 101898184e3Ssthen } 102898184e3Ssthen 103898184e3Ssthen SKIP: { 104898184e3Ssthen skip 'MSWin32 only', 1 if $^O ne 'MSWin32'; 105898184e3Ssthen local $ENV{HOME}; 106898184e3Ssthen delete $ENV{HOME}; 107898184e3Ssthen local $ENV{USERPROFILE}; 108898184e3Ssthen $ENV{USERPROFILE} = 'sweet win32 home'; 109898184e3Ssthen $tilde_check->(defined $passwd_home ? $passwd_home : $ENV{USERPROFILE}, 'USERPROFILE'); 110898184e3Ssthen } 111898184e3Ssthen 112898184e3Ssthen TODO: { 113898184e3Ssthen local $TODO = 'directory brackets look like pattern brackets to glob' if $^O eq 'VMS'; 114898184e3Ssthen my $home = exists $ENV{HOME} ? $ENV{HOME} 115898184e3Ssthen : eval { getpwuid($>); 1 } ? (getpwuid($>))[7] 116898184e3Ssthen : $^O eq 'MSWin32' && exists $ENV{USERPROFILE} ? $ENV{USERPROFILE} 117898184e3Ssthen : q{~}; 118898184e3Ssthen $tilde_check->($home); 119898184e3Ssthen } 120898184e3Ssthen} 12143003dfeSmillert 12243003dfeSmillert# check backslashing 12343003dfeSmillert# should return a list with one item, and not set ERROR 12443003dfeSmillert@a = bsd_glob('TEST', GLOB_QUOTE); 12543003dfeSmillertif (GLOB_ERROR) { 12643003dfeSmillert fail(GLOB_ERROR); 12743003dfeSmillert} else { 128f3efcd01Safresh1 is_deeply(\@a, ['TEST'], "GLOB_QUOTE works as expected"); 12943003dfeSmillert} 13043003dfeSmillert 13143003dfeSmillert# check nonexistent checks 13243003dfeSmillert# should return an empty list 13343003dfeSmillert# XXX since errfunc is NULL on win32, this test is not valid there 13443003dfeSmillert@a = bsd_glob("asdfasdf", 0); 13543003dfeSmillertSKIP: { 136*256a93a4Safresh1 skip $^O, 1 if $^O eq 'MSWin32'; 137f3efcd01Safresh1 is_deeply(\@a, [], "bsd_glob() works as expected for unmatched pattern and 0 flag"); 13843003dfeSmillert} 13943003dfeSmillert 14043003dfeSmillert# check bad protections 14143003dfeSmillert# should return an empty list, and set ERROR 14243003dfeSmillertSKIP: { 143*256a93a4Safresh1 skip $^O, 2 if $^O eq 'MSWin32' 14443003dfeSmillert or $^O eq 'os2' or $^O eq 'VMS' or $^O eq 'cygwin'; 14543003dfeSmillert skip "AFS", 2 if Cwd::cwd() =~ m#^$Config{'afsroot'}#s; 14643003dfeSmillert skip "running as root", 2 if not $>; 14743003dfeSmillert 14843003dfeSmillert my $dir = "pteerslo"; 14943003dfeSmillert mkdir $dir, 0; 15043003dfeSmillert @a = bsd_glob("$dir/*", GLOB_ERR); 15143003dfeSmillert rmdir $dir; 15243003dfeSmillert local $TODO = 'hit VOS bug posix-956' if $^O eq 'vos'; 15343003dfeSmillert 154f3efcd01Safresh1 isnt(GLOB_ERROR, 0, "GLOB_ERROR is not 0"); 155f3efcd01Safresh1 is_deeply(\@a, [], "Got empty list as expected"); 15643003dfeSmillert} 15743003dfeSmillert 15843003dfeSmillert# check for csh style globbing 15943003dfeSmillert@a = bsd_glob('{a,b}', GLOB_BRACE | GLOB_NOMAGIC); 160f3efcd01Safresh1is_deeply(\@a, ['a', 'b'], "Check for csh-style globbing"); 16143003dfeSmillert 16243003dfeSmillert@a = bsd_glob( 16343003dfeSmillert '{TES*,doesntexist*,a,b}', 16443003dfeSmillert GLOB_BRACE | GLOB_NOMAGIC | ($^O eq 'VMS' ? GLOB_NOCASE : 0) 16543003dfeSmillert); 16643003dfeSmillert 16743003dfeSmillert# Working on t/TEST often causes this test to fail because it sees Emacs temp 16843003dfeSmillert# and RCS files. Filter them out, and .pm files too, and patch temp files. 16943003dfeSmillert@a = grep !/(,v$|~$|\.(pm|ori?g|rej)$)/, @a; 17043003dfeSmillert@a = (grep !/test.pl/, @a) if $^O eq 'VMS'; 17143003dfeSmillert 17291f110e0Safresh1map { $_ =~ s/test\.?/TEST/i } @a if $^O eq 'VMS'; 17343003dfeSmillertprint "# @a\n"; 17443003dfeSmillert 175f3efcd01Safresh1is_deeply(\@a, ['TEST', 'a', 'b'], "Got list of 3 elements, including 'TEST'"); 17643003dfeSmillert 17743003dfeSmillert# "~" should expand to $ENV{HOME} 178898184e3Ssthen{ 179898184e3Ssthen local $ENV{HOME} = "sweet home"; 18043003dfeSmillert @a = bsd_glob('~', GLOB_TILDE | GLOB_NOMAGIC); 181f3efcd01Safresh1 is_deeply(\@a, [$ENV{HOME}], "~ expands to envvar \$HOME"); 18243003dfeSmillert} 18343003dfeSmillert 18443003dfeSmillert# GLOB_ALPHASORT (default) should sort alphabetically regardless of case 185*256a93a4Safresh1mkdir "pteerslo", 0777 or die "mkdir 'pteerslo', 0777: $!"; 186*256a93a4Safresh1chdir "pteerslo" or die "chdir 'pteerslo' $!"; 18743003dfeSmillert 18843003dfeSmillertmy @f_names = qw(Ax.pl Bx.pl Cx.pl aY.pl bY.pl cY.pl); 18943003dfeSmillertmy @f_alpha = qw(Ax.pl aY.pl Bx.pl bY.pl Cx.pl cY.pl); 19043003dfeSmillertif ('a' lt 'A') { # EBCDIC char sets sort lower case before UPPER 19143003dfeSmillert @f_names = sort(@f_names); 19243003dfeSmillert} 19343003dfeSmillertif ($^O eq 'VMS') { # VMS is happily caseignorant 19443003dfeSmillert @f_alpha = qw(ax.pl ay.pl bx.pl by.pl cx.pl cy.pl); 19543003dfeSmillert @f_names = @f_alpha; 19643003dfeSmillert} 19743003dfeSmillert 19843003dfeSmillertfor (@f_names) { 199*256a93a4Safresh1 open T, '>', $_ or die "Couldn't write to '$_': $!"; 200*256a93a4Safresh1 close T or die "Couldn't close '$_': $!"; 20143003dfeSmillert} 20243003dfeSmillert 20343003dfeSmillertmy $pat = "*.pl"; 20443003dfeSmillert 20543003dfeSmillertmy @g_names = bsd_glob($pat, 0); 20643003dfeSmillertprint "# f_names = @f_names\n"; 20743003dfeSmillertprint "# g_names = @g_names\n"; 208f3efcd01Safresh1is_deeply(\@g_names, \@f_names, "Got expected case-sensitive list of filenames"); 20943003dfeSmillert 21043003dfeSmillertmy @g_alpha = bsd_glob($pat); 21143003dfeSmillertprint "# f_alpha = @f_alpha\n"; 21243003dfeSmillertprint "# g_alpha = @g_alpha\n"; 213f3efcd01Safresh1is_deeply(\@g_alpha, \@f_alpha, "Got expected case-insensitive list of filenames"); 21443003dfeSmillert 21543003dfeSmillertunlink @f_names; 21643003dfeSmillertchdir ".."; 21743003dfeSmillertrmdir "pteerslo"; 21843003dfeSmillert 21943003dfeSmillert# this can panic if PL_glob_index gets passed as flags to bsd_glob 22043003dfeSmillert<*>; <*>; 22143003dfeSmillertpass("Don't panic"); 22243003dfeSmillert 22343003dfeSmillert{ 22443003dfeSmillert use File::Temp qw(tempdir); 22543003dfeSmillert use File::Spec qw(); 22643003dfeSmillert 22743003dfeSmillert my($dir) = tempdir(CLEANUP => 1) 22843003dfeSmillert or die "Could not create temporary directory"; 22943003dfeSmillert for my $file (qw(a_dej a_ghj a_qej)) { 23043003dfeSmillert open my $fh, ">", File::Spec->catfile($dir, $file) 23143003dfeSmillert or die "Could not create file $dir/$file: $!"; 23243003dfeSmillert close $fh; 23343003dfeSmillert } 23443003dfeSmillert my $cwd = Cwd::cwd(); 23543003dfeSmillert chdir $dir 23643003dfeSmillert or die "Could not chdir to $dir: $!"; 23743003dfeSmillert my(@glob_files) = glob("a*{d[e]}j"); 23843003dfeSmillert chdir $cwd 23943003dfeSmillert or die "Could not chdir back to $cwd: $!"; 24043003dfeSmillert local $TODO = "home-made glob doesn't do regexes" if $^O eq 'VMS'; 241f3efcd01Safresh1 is_deeply(\@glob_files, ['a_dej'], 242f3efcd01Safresh1 "Got expected list: metacharacters and character class in pattern"); 24343003dfeSmillert} 244898184e3Ssthen 245898184e3Ssthen# This used to segfault. 246898184e3Ssthenmy $i = bsd_glob('*', GLOB_ALTDIRFUNC); 247898184e3Ssthenis(&File::Glob::GLOB_ERROR, 0, "Successfuly ignored unsupported flag"); 248898184e3Ssthen 249898184e3Ssthenpackage frimpy; # get away from the glob override, so we can test csh_glob, 250898184e3Ssthenuse Test::More; # which is perl's default 251898184e3Ssthen 252898184e3Ssthen# In case of PERL_EXTERNAL_GLOB: 253898184e3Ssthenuse subs 'glob'; 254898184e3SsthenBEGIN { *glob = \&File::Glob::csh_glob } 255898184e3Ssthen 256898184e3Ssthenis +(glob "a'b'")[0], (<a'b' c>)[0], "a'b' with and without spaces"; 257898184e3Ssthenis <a"b">, 'ab', 'a"b" without spaces'; 258898184e3Ssthenis_deeply [<a"b" c>], [qw<ab c>], 'a"b" without spaces'; 259898184e3Ssthenis_deeply [<\\* .\\*>], [<\\*>,<.\\*>], 'backslashes with(out) spaces'; 260898184e3Ssthenlike <\\ >, qr/^\\? \z/, 'final escaped space'; 261898184e3Ssthenis <a"b>, 'a"b', 'unmatched quote'; 262898184e3Ssthenis < a"b >, 'a"b', 'unmatched quote with surrounding spaces'; 263898184e3Ssthenis glob('a\"b'), 'a"b', '\ before quote *only* escapes quote'; 264898184e3Ssthenis glob(q"a\'b"), "a'b", '\ before single quote *only* escapes quote'; 265898184e3Ssthenis glob('"a\"b c\"d"'), 'a"b c"d', 'before \" within "..."'; 266898184e3Ssthenis glob(q"'a\'b c\'d'"), "a'b c'd", q"before \' within '...'"; 267898184e3Ssthen 268898184e3Ssthen 269898184e3Ssthenpackage bsdglob; # for testing the :bsd_glob export tag 270898184e3Ssthen 271898184e3Ssthenuse File::Glob ':bsd_glob'; 272898184e3Ssthenuse Test::More; 273898184e3Ssthenfor (qw[ 274898184e3Ssthen GLOB_ABEND 275898184e3Ssthen GLOB_ALPHASORT 276898184e3Ssthen GLOB_ALTDIRFUNC 277898184e3Ssthen GLOB_BRACE 278898184e3Ssthen GLOB_CSH 279898184e3Ssthen GLOB_ERR 280898184e3Ssthen GLOB_ERROR 281898184e3Ssthen GLOB_LIMIT 282898184e3Ssthen GLOB_MARK 283898184e3Ssthen GLOB_NOCASE 284898184e3Ssthen GLOB_NOCHECK 285898184e3Ssthen GLOB_NOMAGIC 286898184e3Ssthen GLOB_NOSORT 287898184e3Ssthen GLOB_NOSPACE 288898184e3Ssthen GLOB_QUOTE 289898184e3Ssthen GLOB_TILDE 290898184e3Ssthen bsd_glob 291898184e3Ssthen ]) { 292898184e3Ssthen ok (exists &$_, qq':bsd_glob exports $_'); 293898184e3Ssthen} 294898184e3Ssthenis <a b>, 'a b', '<a b> under :bsd_glob'; 295898184e3Ssthenis <"a" "b">, '"a" "b"', '<"a" "b"> under :bsd_glob'; 296898184e3Ssthenis_deeply [<a b>], [q<a b>], '<> in list context under :bsd_glob'; 297