This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fixing t/pod/find.t, running t/pod
[perl5.git] / t / lib / glob-basic.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6     require Config; import Config;
7     if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
8         print "1..0\n";
9         exit 0;
10     }
11     print "1..9\n";
12 }
13 END {
14     print "not ok 1\n" unless $loaded;
15 }
16 use File::Glob ':glob';
17 use Cwd ();
18 $loaded = 1;
19 print "ok 1\n";
20
21 sub array {
22     return '(', join(", ", map {defined $_ ? "\"$_\"" : "undef"} @a), ")\n";
23 }
24
25 # look for the contents of the current directory
26 $ENV{PATH} = "/bin";
27 delete @ENV{BASH_ENV, CDPATH, ENV, IFS};
28 @correct = ();
29 if (opendir(D, ".")) {
30    @correct = grep { !/^\./ } sort readdir(D);
31    closedir D;
32 }
33 @a = File::Glob::glob("*", 0);
34 @a = sort @a;
35 if ("@a" ne "@correct" || GLOB_ERROR) {
36     print "# |@a| ne |@correct|\nnot ";
37 }
38 print "ok 2\n";
39
40 # look up the user's home directory
41 # should return a list with one item, and not set ERROR
42 if ($^O ne 'MSWin32' && $^O ne 'VMS') {
43   eval {
44     ($name, $home) = (getpwuid($>))[0,7];
45     1;
46   } and do {
47     @a = bsd_glob("~$name", GLOB_TILDE);
48     if (scalar(@a) != 1 || $a[0] ne $home || GLOB_ERROR) {
49         print "not ";
50     }
51   };
52 }
53 print "ok 3\n";
54
55 # check backslashing
56 # should return a list with one item, and not set ERROR
57 @a = bsd_glob('TEST', GLOB_QUOTE);
58 if (scalar @a != 1 || $a[0] ne 'TEST' || GLOB_ERROR) {
59     local $/ = "][";
60     print "# [@a]\n";
61     print "not ";
62 }
63 print "ok 4\n";
64
65 # check nonexistent checks
66 # should return an empty list
67 # XXX since errfunc is NULL on win32, this test is not valid there
68 @a = bsd_glob("asdfasdf", 0);
69 if ($^O ne 'MSWin32' and scalar @a != 0) {
70     print "# |@a|\nnot ";
71 }
72 print "ok 5\n";
73
74 # check bad protections
75 # should return an empty list, and set ERROR
76 if ($^O eq 'mpeix' or $^O eq 'MSWin32' or $^O eq 'os2' or $^O eq 'VMS'
77     or $^O eq 'cygwin' or Cwd::cwd() =~ m#^/afs#s or not $>)
78 {
79     print "ok 6 # skipped\n";
80 }
81 else {
82     $dir = "PtEeRsLt.dir";
83     mkdir $dir, 0;
84     @a = bsd_glob("$dir/*", GLOB_ERR);
85     #print "\@a = ", array(@a);
86     rmdir $dir;
87     if (scalar(@a) != 0 || GLOB_ERROR == 0) {
88         print "not ";
89     }
90     print "ok 6\n";
91 }
92
93 # check for csh style globbing
94 @a = bsd_glob('{a,b}', GLOB_BRACE | GLOB_NOMAGIC);
95 unless (@a == 2 and $a[0] eq 'a' and $a[1] eq 'b') {
96     print "not ";
97 }
98 print "ok 7\n";
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
109 print "# @a\n";
110
111 unless (@a == 3
112         and $a[0] eq ($^O eq 'VMS'? 'test.' : 'TEST')
113         and $a[1] eq 'a'
114         and $a[2] eq 'b')
115 {
116     print "not ";
117 }
118 print "ok 8\n";
119
120 # "~" should expand to $ENV{HOME}
121 $ENV{HOME} = "sweet home";
122 @a = bsd_glob('~', GLOB_TILDE | GLOB_NOMAGIC);
123 unless (@a == 1 and $a[0] eq $ENV{HOME}) {
124     print "not ";
125 }
126 print "ok 9\n";