xref: /openbsd/gnu/usr.bin/perl/ext/File-Glob/t/basic.t (revision 256a93a4) 
1#!./perl
2
3BEGIN {
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}
12use strict;
13use Test::More tests => 49;
14BEGIN {use_ok('File::Glob', ':glob')};
15use Cwd ();
16
17my $vms_unix_rpt = 0;
18my $vms_efs = 0;
19my $vms_mode = 0;
20if ($^O eq 'VMS') {
21    if (eval 'require VMS::Feature') {
22        $vms_unix_rpt = VMS::Feature::current("filename_unix_report");
23        $vms_efs = VMS::Feature::current("efs_charset");
24    } else {
25        my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
26        my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || '';
27        $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i;
28        $vms_efs = $efs_charset =~ /^[ET1]/i;
29    }
30    $vms_mode = 1 unless ($vms_unix_rpt);
31}
32
33
34# look for the contents of the current directory
35# try it in a directory that doesn't get modified during testing,
36# so parallel testing won't give us race conditions. t/base/ seems
37# fairly static
38
39chdir 'base' or die "chdir base: $!";
40$ENV{PATH} = "/bin";
41delete @ENV{qw(BASH_ENV CDPATH ENV IFS)};
42my @correct = ();
43if (opendir(D, ".")) {
44   @correct = grep { !/^\./ } sort readdir(D);
45   closedir D;
46}
47
48is(
49    File::Glob->can('glob'),
50    undef,
51    'Did not find glob() function in File::Glob',
52);
53
54chdir '..' or die "chdir .. $!";
55
56# look up the user's home directory
57# should return a list with one item, and not set ERROR
58my @a;
59
60SKIP: {
61    my ($name, $home);
62    skip $^O, 1 if $^O eq 'MSWin32' || $^O eq 'VMS'
63	|| $^O eq 'os2';
64    skip "Can't find user for $>: $@", 1 unless eval {
65	($name, $home) = (getpwuid($>))[0,7];
66	1;
67    };
68    skip "$> has no home directory", 1
69	unless defined $home && defined $name && -d $home;
70
71    @a = bsd_glob("~$name", GLOB_TILDE);
72
73    if (GLOB_ERROR) {
74        fail(GLOB_ERROR);
75    } else {
76        is_deeply (\@a, [$home],
77            "GLOB_TILDE expands patterns that start with '~' to user name home directories"
78        );
79    }
80}
81# check plain tilde expansion
82{
83    my $tilde_check = sub {
84        my @a = bsd_glob('~');
85
86        if (GLOB_ERROR) {
87            fail(GLOB_ERROR);
88        } else {
89            is_deeply (\@a, [$_[0]], join ' - ', 'tilde expansion', @_ > 1 ? $_[1] : ());
90        }
91    };
92    my $passwd_home = eval { (getpwuid($>))[7] };
93
94    TODO: {
95        local $TODO = 'directory brackets look like pattern brackets to glob' if $^O eq 'VMS';
96        local $ENV{HOME};
97        delete $ENV{HOME};
98        local $ENV{USERPROFILE};
99        delete $ENV{USERPROFILE};
100        $tilde_check->(defined $passwd_home ? $passwd_home : q{~}, 'no environment');
101    }
102
103    SKIP: {
104        skip 'MSWin32 only', 1 if $^O ne 'MSWin32';
105        local $ENV{HOME};
106        delete $ENV{HOME};
107        local $ENV{USERPROFILE};
108        $ENV{USERPROFILE} = 'sweet win32 home';
109        $tilde_check->(defined $passwd_home ? $passwd_home : $ENV{USERPROFILE}, 'USERPROFILE');
110    }
111
112    TODO: {
113        local $TODO = 'directory brackets look like pattern brackets to glob' if $^O eq 'VMS';
114        my $home = exists $ENV{HOME} ? $ENV{HOME}
115        : eval { getpwuid($>); 1 } ? (getpwuid($>))[7]
116        : $^O eq 'MSWin32' && exists $ENV{USERPROFILE} ? $ENV{USERPROFILE}
117        : q{~};
118        $tilde_check->($home);
119    }
120}
121
122# check backslashing
123# should return a list with one item, and not set ERROR
124@a = bsd_glob('TEST', GLOB_QUOTE);
125if (GLOB_ERROR) {
126    fail(GLOB_ERROR);
127} else {
128    is_deeply(\@a, ['TEST'], "GLOB_QUOTE works as expected");
129}
130
131# check nonexistent checks
132# should return an empty list
133# XXX since errfunc is NULL on win32, this test is not valid there
134@a = bsd_glob("asdfasdf", 0);
135SKIP: {
136    skip $^O, 1 if $^O eq 'MSWin32';
137    is_deeply(\@a, [], "bsd_glob() works as expected for unmatched pattern and 0 flag");
138}
139
140# check bad protections
141# should return an empty list, and set ERROR
142SKIP: {
143    skip $^O, 2 if $^O eq 'MSWin32'
144        or $^O eq 'os2' or $^O eq 'VMS' or $^O eq 'cygwin';
145    skip "AFS", 2 if Cwd::cwd() =~ m#^$Config{'afsroot'}#s;
146    skip "running as root", 2 if not $>;
147
148    my $dir = "pteerslo";
149    mkdir $dir, 0;
150    @a = bsd_glob("$dir/*", GLOB_ERR);
151    rmdir $dir;
152    local $TODO = 'hit VOS bug posix-956' if $^O eq 'vos';
153
154    isnt(GLOB_ERROR, 0, "GLOB_ERROR is not 0");
155    is_deeply(\@a, [], "Got empty list as expected");
156}
157
158# check for csh style globbing
159@a = bsd_glob('{a,b}', GLOB_BRACE | GLOB_NOMAGIC);
160is_deeply(\@a, ['a', 'b'], "Check for csh-style globbing");
161
162@a = bsd_glob(
163    '{TES*,doesntexist*,a,b}',
164    GLOB_BRACE | GLOB_NOMAGIC | ($^O eq 'VMS' ? GLOB_NOCASE : 0)
165);
166
167# Working on t/TEST often causes this test to fail because it sees Emacs temp
168# and RCS files.  Filter them out, and .pm files too, and patch temp files.
169@a = grep !/(,v$|~$|\.(pm|ori?g|rej)$)/, @a;
170@a = (grep !/test.pl/, @a) if $^O eq 'VMS';
171
172map { $_  =~ s/test\.?/TEST/i } @a if $^O eq 'VMS';
173print "# @a\n";
174
175is_deeply(\@a, ['TEST', 'a', 'b'], "Got list of 3 elements, including 'TEST'");
176
177# "~" should expand to $ENV{HOME}
178{
179    local $ENV{HOME} = "sweet home";
180    @a = bsd_glob('~', GLOB_TILDE | GLOB_NOMAGIC);
181    is_deeply(\@a, [$ENV{HOME}], "~ expands to envvar \$HOME");
182}
183
184# GLOB_ALPHASORT (default) should sort alphabetically regardless of case
185mkdir "pteerslo", 0777 or die "mkdir 'pteerslo', 0777:  $!";
186chdir "pteerslo" or die "chdir 'pteerslo' $!";
187
188my @f_names = qw(Ax.pl Bx.pl Cx.pl aY.pl bY.pl cY.pl);
189my @f_alpha = qw(Ax.pl aY.pl Bx.pl bY.pl Cx.pl cY.pl);
190if ('a' lt 'A') { # EBCDIC char sets sort lower case before UPPER
191    @f_names = sort(@f_names);
192}
193if ($^O eq 'VMS') { # VMS is happily caseignorant
194    @f_alpha = qw(ax.pl ay.pl bx.pl by.pl cx.pl cy.pl);
195    @f_names = @f_alpha;
196}
197
198for (@f_names) {
199    open T, '>', $_ or die "Couldn't write to '$_': $!";
200    close T or die "Couldn't close '$_': $!";
201}
202
203my $pat = "*.pl";
204
205my @g_names = bsd_glob($pat, 0);
206print "# f_names = @f_names\n";
207print "# g_names = @g_names\n";
208is_deeply(\@g_names, \@f_names, "Got expected case-sensitive list of filenames");
209
210my @g_alpha = bsd_glob($pat);
211print "# f_alpha = @f_alpha\n";
212print "# g_alpha = @g_alpha\n";
213is_deeply(\@g_alpha, \@f_alpha, "Got expected case-insensitive list of filenames");
214
215unlink @f_names;
216chdir "..";
217rmdir "pteerslo";
218
219# this can panic if PL_glob_index gets passed as flags to bsd_glob
220<*>; <*>;
221pass("Don't panic");
222
223{
224    use File::Temp qw(tempdir);
225    use File::Spec qw();
226
227    my($dir) = tempdir(CLEANUP => 1)
228        or die "Could not create temporary directory";
229    for my $file (qw(a_dej a_ghj a_qej)) {
230        open my $fh, ">", File::Spec->catfile($dir, $file)
231            or die "Could not create file $dir/$file: $!";
232        close $fh;
233    }
234    my $cwd = Cwd::cwd();
235    chdir $dir
236        or die "Could not chdir to $dir: $!";
237    my(@glob_files) = glob("a*{d[e]}j");
238    chdir $cwd
239        or die "Could not chdir back to $cwd: $!";
240    local $TODO = "home-made glob doesn't do regexes" if $^O eq 'VMS';
241    is_deeply(\@glob_files, ['a_dej'],
242        "Got expected list: metacharacters and character class in pattern");
243}
244
245# This used to segfault.
246my $i = bsd_glob('*', GLOB_ALTDIRFUNC);
247is(&File::Glob::GLOB_ERROR, 0, "Successfuly ignored unsupported flag");
248
249package frimpy; # get away from the glob override, so we can test csh_glob,
250use Test::More;  # which is perl's default
251
252# In case of PERL_EXTERNAL_GLOB:
253use subs 'glob';
254BEGIN { *glob = \&File::Glob::csh_glob }
255
256is +(glob "a'b'")[0], (<a'b' c>)[0], "a'b' with and without spaces";
257is <a"b">, 'ab', 'a"b" without spaces';
258is_deeply [<a"b" c>], [qw<ab c>], 'a"b" without spaces';
259is_deeply [<\\* .\\*>], [<\\*>,<.\\*>], 'backslashes with(out) spaces';
260like <\\ >, qr/^\\? \z/, 'final escaped space';
261is <a"b>, 'a"b', 'unmatched quote';
262is < a"b >, 'a"b', 'unmatched quote with surrounding spaces';
263is glob('a\"b'), 'a"b', '\ before quote *only* escapes quote';
264is glob(q"a\'b"), "a'b", '\ before single quote *only* escapes quote';
265is glob('"a\"b c\"d"'), 'a"b c"d', 'before \" within "..."';
266is glob(q"'a\'b c\'d'"), "a'b c'd", q"before \' within '...'";
267
268
269package bsdglob;  # for testing the :bsd_glob export tag
270
271use File::Glob ':bsd_glob';
272use Test::More;
273for (qw[
274        GLOB_ABEND
275	GLOB_ALPHASORT
276        GLOB_ALTDIRFUNC
277        GLOB_BRACE
278        GLOB_CSH
279        GLOB_ERR
280        GLOB_ERROR
281        GLOB_LIMIT
282        GLOB_MARK
283        GLOB_NOCASE
284        GLOB_NOCHECK
285        GLOB_NOMAGIC
286        GLOB_NOSORT
287        GLOB_NOSPACE
288        GLOB_QUOTE
289        GLOB_TILDE
290        bsd_glob
291    ]) {
292    ok (exists &$_, qq':bsd_glob exports $_');
293}
294is <a b>, 'a b', '<a b> under :bsd_glob';
295is <"a" "b">, '"a" "b"', '<"a" "b"> under :bsd_glob';
296is_deeply [<a b>], [q<a b>], '<> in list context under :bsd_glob';
297