This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Only show the message if the locale settings look risky.
[perl5.git] / ext / File / Glob / t / basic.t
CommitLineData
72b16652
GS
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
7369a524
CN
5 if ($^O eq 'MacOS') {
6 @INC = qw(: ::lib ::macos:lib);
7 } else {
8 @INC = '.';
9 push @INC, '../lib';
10 }
d2a01882
GS
11 require Config; import Config;
12 if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
13 print "1..0\n";
14 exit 0;
15 }
ab3ed403 16 print "1..11\n";
72b16652
GS
17}
18END {
19 print "not ok 1\n" unless $loaded;
20}
21use File::Glob ':glob';
a4cf958a 22use Cwd ();
72b16652
GS
23$loaded = 1;
24print "ok 1\n";
25
26sub array {
27 return '(', join(", ", map {defined $_ ? "\"$_\"" : "undef"} @a), ")\n";
28}
29
30# look for the contents of the current directory
31$ENV{PATH} = "/bin";
32delete @ENV{BASH_ENV, CDPATH, ENV, IFS};
33@correct = ();
7369a524 34if (opendir(D, $^O eq "MacOS" ? ":" : ".")) {
94a371ee 35 @correct = grep { !/^\./ } sort readdir(D);
72b16652
GS
36 closedir D;
37}
38@a = File::Glob::glob("*", 0);
39@a = sort @a;
40if ("@a" ne "@correct" || GLOB_ERROR) {
41 print "# |@a| ne |@correct|\nnot ";
42}
43print "ok 2\n";
44
45# look up the user's home directory
46# should return a list with one item, and not set ERROR
f72c975a 47if ($^O ne 'MSWin32' && $^O ne 'NetWare' && $^O ne 'VMS' && $^O ne 'os2') {
0eb4ebd7 48 eval {
72b16652 49 ($name, $home) = (getpwuid($>))[0,7];
0eb4ebd7
GS
50 1;
51 } and do {
7bb5bfba
JH
52 if (defined $home && defined $name && -d $home) {
53 @a = bsd_glob("~$name", GLOB_TILDE);
54 if ((scalar(@a) != 1 || $a[0] ne $home || GLOB_ERROR)) {
55 print "not ";
56 }
72b16652 57 }
0eb4ebd7 58 };
72b16652
GS
59}
60print "ok 3\n";
61
62# check backslashing
63# should return a list with one item, and not set ERROR
00c80938 64@a = bsd_glob('TEST', GLOB_QUOTE);
72b16652
GS
65if (scalar @a != 1 || $a[0] ne 'TEST' || GLOB_ERROR) {
66 local $/ = "][";
67 print "# [@a]\n";
68 print "not ";
69}
70print "ok 4\n";
71
72# check nonexistent checks
73# should return an empty list
74# XXX since errfunc is NULL on win32, this test is not valid there
00c80938 75@a = bsd_glob("asdfasdf", 0);
2986a63f 76if (($^O ne 'MSWin32' && $^O ne 'NetWare') and scalar @a != 0) {
72b16652
GS
77 print "# |@a|\nnot ";
78}
79print "ok 5\n";
80
81# check bad protections
82# should return an empty list, and set ERROR
2986a63f 83if ($^O eq 'mpeix' or $^O eq 'MSWin32' or $^O eq 'NetWare' or $^O eq 'os2' or $^O eq 'VMS'
eca1c073 84 or $^O eq 'cygwin' or Cwd::cwd() =~ m#^$Config{'afsroot'}#s or not $>)
a4cf958a 85{
1cf742e9
GS
86 print "ok 6 # skipped\n";
87}
88else {
8f562d3a 89 $dir = "pteerslo";
1cf742e9 90 mkdir $dir, 0;
00c80938 91 @a = bsd_glob("$dir/*", GLOB_ERR);
1cf742e9
GS
92 #print "\@a = ", array(@a);
93 rmdir $dir;
94 if (scalar(@a) != 0 || GLOB_ERROR == 0) {
29d78b18 95 if ($^O eq 'vos') {
8ffed148 96 print "not ok 6 # TODO hit VOS bug posix-956\n";
29d78b18
PG
97 } else {
98 print "not ok 6\n";
99 }
100 }
101 else {
102 print "ok 6\n";
1cf742e9 103 }
72b16652 104}
72b16652
GS
105
106# check for csh style globbing
00c80938 107@a = bsd_glob('{a,b}', GLOB_BRACE | GLOB_NOMAGIC);
72b16652
GS
108unless (@a == 2 and $a[0] eq 'a' and $a[1] eq 'b') {
109 print "not ";
110}
111print "ok 7\n";
112
00c80938 113@a = bsd_glob(
72b16652 114 '{TES*,doesntexist*,a,b}',
3eba041e 115 GLOB_BRACE | GLOB_NOMAGIC | ($^O eq 'VMS' ? GLOB_NOCASE : 0)
72b16652 116);
5d9a6404 117
8ac1de08
MS
118# Working on t/TEST often causes this test to fail because it sees Emacs temp
119# and RCS files. Filter them out, and .pm files too, and patch temp files.
120@a = grep !/(,v$|~$|\.(pm|ori?g|rej)$)/, @a;
c065ed18 121@a = (grep !/test.pl/, @a) if $^O eq 'VMS';
8ac1de08
MS
122
123print "# @a\n";
5d9a6404 124
72b16652 125unless (@a == 3
f0963acb 126 and $a[0] eq ($^O eq 'VMS'? 'test.' : 'TEST')
72b16652
GS
127 and $a[1] eq 'a'
128 and $a[2] eq 'b')
129{
c065ed18 130 print "not ok 8 # @a\n";
36bad43a
JH
131} else {
132 print "ok 8\n";
72b16652 133}
72b16652
GS
134
135# "~" should expand to $ENV{HOME}
136$ENV{HOME} = "sweet home";
00c80938 137@a = bsd_glob('~', GLOB_TILDE | GLOB_NOMAGIC);
7369a524 138unless ($^O eq "MacOS" || (@a == 1 and $a[0] eq $ENV{HOME})) {
72b16652
GS
139 print "not ";
140}
141print "ok 9\n";
ab3ed403
BS
142
143# GLOB_ALPHASORT (default) should sort alphabetically regardless of case
8f562d3a
NA
144mkdir "pteerslo", 0777;
145chdir "pteerslo";
93782ce2
BS
146
147@f_names = qw(Ax.pl Bx.pl Cx.pl aY.pl bY.pl cY.pl);
148@f_alpha = qw(Ax.pl aY.pl Bx.pl bY.pl Cx.pl cY.pl);
149if ('a' lt 'A') { # EBCDIC char sets sort lower case before UPPER
150 @f_names = sort(@f_names);
d2f5bb60 151}
89f4ed55 152if ($^O eq 'VMS') { # VMS is happily caseignorant
16421035
PP
153 @f_alpha = qw(ax.pl ay.pl bx.pl by.pl cx.pl cy.pl);
154 @f_names = @f_alpha;
155}
93782ce2
BS
156
157for (@f_names) {
ab3ed403
BS
158 open T, "> $_";
159 close T;
160}
93782ce2
BS
161
162$pat = "*.pl";
163
ab3ed403 164$ok = 1;
93782ce2
BS
165@g_names = bsd_glob($pat, 0);
166print "# f_names = @f_names\n";
167print "# g_names = @g_names\n";
168for (@f_names) {
169 $ok = 0 unless $_ eq shift @g_names;
ab3ed403
BS
170}
171print $ok ? "ok 10\n" : "not ok 10\n";
93782ce2 172
ab3ed403
BS
173$ok = 1;
174@g_alpha = bsd_glob($pat);
584c1423
JH
175print "# f_alpha = @f_alpha\n";
176print "# g_alpha = @g_alpha\n";
93782ce2
BS
177for (@f_alpha) {
178 $ok = 0 unless $_ eq shift @g_alpha;
ab3ed403
BS
179}
180print $ok ? "ok 11\n" : "not ok 11\n";
93782ce2
BS
181
182unlink @f_names;
ab3ed403 183chdir "..";
8f562d3a 184rmdir "pteerslo";