Commit | Line | Data |
72b16652 |
1 | #!./perl |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
7369a524 |
5 | if ($^O eq 'MacOS') { |
6 | @INC = qw(: ::lib ::macos:lib); |
7 | } else { |
8 | @INC = '.'; |
9 | push @INC, '../lib'; |
10 | } |
d2a01882 |
11 | require Config; import Config; |
12 | if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) { |
13 | print "1..0\n"; |
14 | exit 0; |
15 | } |
72b16652 |
16 | } |
06494c4c |
17 | use strict; |
18 | use Test::More tests => 14; |
19 | BEGIN {use_ok('File::Glob', ':glob')}; |
a4cf958a |
20 | use Cwd (); |
72b16652 |
21 | |
6a164b5b |
22 | my $vms_unix_rpt = 0; |
23 | my $vms_efs = 0; |
24 | my $vms_mode = 0; |
25 | if ($^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 | |
72b16652 |
39 | # look for the contents of the current directory |
40 | $ENV{PATH} = "/bin"; |
06494c4c |
41 | delete @ENV{qw(BASH_ENV CDPATH ENV IFS)}; |
42 | my @correct = (); |
7369a524 |
43 | if (opendir(D, $^O eq "MacOS" ? ":" : ".")) { |
94a371ee |
44 | @correct = grep { !/^\./ } sort readdir(D); |
72b16652 |
45 | closedir D; |
46 | } |
06494c4c |
47 | my @a = File::Glob::glob("*", 0); |
72b16652 |
48 | @a = sort @a; |
06494c4c |
49 | if (GLOB_ERROR) { |
50 | fail(GLOB_ERROR); |
51 | } else { |
52 | is_deeply(\@a, \@correct); |
72b16652 |
53 | } |
72b16652 |
54 | |
55 | # look up the user's home directory |
56 | # should return a list with one item, and not set ERROR |
06494c4c |
57 | SKIP: { |
58 | my ($name, $home); |
c491a205 |
59 | skip $^O, 1 if $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS' |
06494c4c |
60 | || $^O eq 'os2' || $^O eq 'beos'; |
c491a205 |
61 | skip "Can't find user for $>: $@", 1 unless eval { |
06494c4c |
62 | ($name, $home) = (getpwuid($>))[0,7]; |
63 | 1; |
64 | }; |
c491a205 |
65 | skip "$> has no home directory", 1 |
06494c4c |
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]); |
72b16652 |
74 | } |
75 | } |
72b16652 |
76 | |
77 | # check backslashing |
78 | # should return a list with one item, and not set ERROR |
00c80938 |
79 | @a = bsd_glob('TEST', GLOB_QUOTE); |
06494c4c |
80 | if (GLOB_ERROR) { |
81 | fail(GLOB_ERROR); |
82 | } else { |
83 | is_deeply(\@a, ['TEST']); |
72b16652 |
84 | } |
72b16652 |
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 |
00c80938 |
89 | @a = bsd_glob("asdfasdf", 0); |
06494c4c |
90 | SKIP: { |
c491a205 |
91 | skip $^O, 1 if $^O eq 'MSWin32' || $^O eq 'NetWare'; |
06494c4c |
92 | is_deeply(\@a, []); |
72b16652 |
93 | } |
72b16652 |
94 | |
95 | # check bad protections |
96 | # should return an empty list, and set ERROR |
06494c4c |
97 | SKIP: { |
c491a205 |
98 | skip $^O, 2 if $^O eq 'mpeix' or $^O eq 'MSWin32' or $^O eq 'NetWare' |
06494c4c |
99 | or $^O eq 'os2' or $^O eq 'VMS' or $^O eq 'cygwin'; |
c491a205 |
100 | skip "AFS", 2 if Cwd::cwd() =~ m#^$Config{'afsroot'}#s; |
101 | skip "running as root", 2 if not $>; |
06494c4c |
102 | |
103 | my $dir = "pteerslo"; |
1cf742e9 |
104 | mkdir $dir, 0; |
00c80938 |
105 | @a = bsd_glob("$dir/*", GLOB_ERR); |
1cf742e9 |
106 | rmdir $dir; |
06494c4c |
107 | local $TODO = 'hit VOS bug posix-956' if $^O eq 'vos'; |
108 | |
109 | isnt(GLOB_ERROR, 0); |
110 | is_deeply(\@a, []); |
72b16652 |
111 | } |
72b16652 |
112 | |
113 | # check for csh style globbing |
00c80938 |
114 | @a = bsd_glob('{a,b}', GLOB_BRACE | GLOB_NOMAGIC); |
06494c4c |
115 | is_deeply(\@a, ['a', 'b']); |
72b16652 |
116 | |
00c80938 |
117 | @a = bsd_glob( |
72b16652 |
118 | '{TES*,doesntexist*,a,b}', |
3eba041e |
119 | GLOB_BRACE | GLOB_NOMAGIC | ($^O eq 'VMS' ? GLOB_NOCASE : 0) |
72b16652 |
120 | ); |
5d9a6404 |
121 | |
8ac1de08 |
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; |
c065ed18 |
125 | @a = (grep !/test.pl/, @a) if $^O eq 'VMS'; |
8ac1de08 |
126 | |
127 | print "# @a\n"; |
5d9a6404 |
128 | |
6a164b5b |
129 | is_deeply(\@a, [($vms_mode ? 'test.' : 'TEST'), 'a', 'b']); |
72b16652 |
130 | |
131 | # "~" should expand to $ENV{HOME} |
132 | $ENV{HOME} = "sweet home"; |
00c80938 |
133 | @a = bsd_glob('~', GLOB_TILDE | GLOB_NOMAGIC); |
06494c4c |
134 | SKIP: { |
c491a205 |
135 | skip $^O, 1 if $^O eq "MacOS"; |
06494c4c |
136 | is_deeply(\@a, [$ENV{HOME}]); |
72b16652 |
137 | } |
ab3ed403 |
138 | |
139 | # GLOB_ALPHASORT (default) should sort alphabetically regardless of case |
8f562d3a |
140 | mkdir "pteerslo", 0777; |
141 | chdir "pteerslo"; |
93782ce2 |
142 | |
06494c4c |
143 | my @f_names = qw(Ax.pl Bx.pl Cx.pl aY.pl bY.pl cY.pl); |
144 | my @f_alpha = qw(Ax.pl aY.pl Bx.pl bY.pl Cx.pl cY.pl); |
93782ce2 |
145 | if ('a' lt 'A') { # EBCDIC char sets sort lower case before UPPER |
146 | @f_names = sort(@f_names); |
d2f5bb60 |
147 | } |
89f4ed55 |
148 | if ($^O eq 'VMS') { # VMS is happily caseignorant |
16421035 |
149 | @f_alpha = qw(ax.pl ay.pl bx.pl by.pl cx.pl cy.pl); |
150 | @f_names = @f_alpha; |
151 | } |
93782ce2 |
152 | |
153 | for (@f_names) { |
ab3ed403 |
154 | open T, "> $_"; |
155 | close T; |
156 | } |
93782ce2 |
157 | |
06494c4c |
158 | my $pat = "*.pl"; |
93782ce2 |
159 | |
06494c4c |
160 | my @g_names = bsd_glob($pat, 0); |
93782ce2 |
161 | print "# f_names = @f_names\n"; |
162 | print "# g_names = @g_names\n"; |
06494c4c |
163 | is_deeply(\@g_names, \@f_names); |
93782ce2 |
164 | |
06494c4c |
165 | my @g_alpha = bsd_glob($pat); |
584c1423 |
166 | print "# f_alpha = @f_alpha\n"; |
167 | print "# g_alpha = @g_alpha\n"; |
06494c4c |
168 | is_deeply(\@g_alpha, \@f_alpha); |
93782ce2 |
169 | |
170 | unlink @f_names; |
ab3ed403 |
171 | chdir ".."; |
8f562d3a |
172 | rmdir "pteerslo"; |
e0e8a4dc |
173 | |
174 | # this can panic if PL_glob_index gets passed as flags to bsd_glob |
175 | <*>; <*>; |
06494c4c |
176 | pass("Don't panic"); |
77348331 |
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"); |
77348331 |
193 | chdir $cwd |
194 | or die "Could not chdir back to $cwd: $!"; |
946b2ae5 |
195 | local $TODO = "home-made glob doesn't do regexes" if $^O eq 'VMS'; |
196 | is_deeply(\@glob_files, ['a_dej']); |
77348331 |
197 | } |