This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Determine nv_overflows_integers_at on VMS.
[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 }
77348331 16 print "1..13\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
dbc1d986
IW
47if ($^O ne 'MSWin32' && $^O ne 'NetWare' && $^O ne 'VMS' && $^O ne 'os2'
48 && $^O ne 'beos') {
0eb4ebd7 49 eval {
72b16652 50 ($name, $home) = (getpwuid($>))[0,7];
0eb4ebd7
GS
51 1;
52 } and do {
7bb5bfba
JH
53 if (defined $home && defined $name && -d $home) {
54 @a = bsd_glob("~$name", GLOB_TILDE);
55 if ((scalar(@a) != 1 || $a[0] ne $home || GLOB_ERROR)) {
56 print "not ";
57 }
72b16652 58 }
0eb4ebd7 59 };
72b16652
GS
60}
61print "ok 3\n";
62
63# check backslashing
64# should return a list with one item, and not set ERROR
00c80938 65@a = bsd_glob('TEST', GLOB_QUOTE);
72b16652
GS
66if (scalar @a != 1 || $a[0] ne 'TEST' || GLOB_ERROR) {
67 local $/ = "][";
68 print "# [@a]\n";
69 print "not ";
70}
71print "ok 4\n";
72
73# check nonexistent checks
74# should return an empty list
75# XXX since errfunc is NULL on win32, this test is not valid there
00c80938 76@a = bsd_glob("asdfasdf", 0);
2986a63f 77if (($^O ne 'MSWin32' && $^O ne 'NetWare') and scalar @a != 0) {
72b16652
GS
78 print "# |@a|\nnot ";
79}
80print "ok 5\n";
81
82# check bad protections
83# should return an empty list, and set ERROR
2986a63f 84if ($^O eq 'mpeix' or $^O eq 'MSWin32' or $^O eq 'NetWare' or $^O eq 'os2' or $^O eq 'VMS'
eca1c073 85 or $^O eq 'cygwin' or Cwd::cwd() =~ m#^$Config{'afsroot'}#s or not $>)
a4cf958a 86{
1cf742e9
GS
87 print "ok 6 # skipped\n";
88}
89else {
8f562d3a 90 $dir = "pteerslo";
1cf742e9 91 mkdir $dir, 0;
00c80938 92 @a = bsd_glob("$dir/*", GLOB_ERR);
1cf742e9
GS
93 #print "\@a = ", array(@a);
94 rmdir $dir;
95 if (scalar(@a) != 0 || GLOB_ERROR == 0) {
29d78b18 96 if ($^O eq 'vos') {
8ffed148 97 print "not ok 6 # TODO hit VOS bug posix-956\n";
29d78b18
PG
98 } else {
99 print "not ok 6\n";
100 }
101 }
102 else {
103 print "ok 6\n";
1cf742e9 104 }
72b16652 105}
72b16652
GS
106
107# check for csh style globbing
00c80938 108@a = bsd_glob('{a,b}', GLOB_BRACE | GLOB_NOMAGIC);
72b16652
GS
109unless (@a == 2 and $a[0] eq 'a' and $a[1] eq 'b') {
110 print "not ";
111}
112print "ok 7\n";
113
00c80938 114@a = bsd_glob(
72b16652 115 '{TES*,doesntexist*,a,b}',
3eba041e 116 GLOB_BRACE | GLOB_NOMAGIC | ($^O eq 'VMS' ? GLOB_NOCASE : 0)
72b16652 117);
5d9a6404 118
8ac1de08
MS
119# Working on t/TEST often causes this test to fail because it sees Emacs temp
120# and RCS files. Filter them out, and .pm files too, and patch temp files.
121@a = grep !/(,v$|~$|\.(pm|ori?g|rej)$)/, @a;
c065ed18 122@a = (grep !/test.pl/, @a) if $^O eq 'VMS';
8ac1de08
MS
123
124print "# @a\n";
5d9a6404 125
72b16652 126unless (@a == 3
f0963acb 127 and $a[0] eq ($^O eq 'VMS'? 'test.' : 'TEST')
72b16652
GS
128 and $a[1] eq 'a'
129 and $a[2] eq 'b')
130{
c065ed18 131 print "not ok 8 # @a\n";
36bad43a
JH
132} else {
133 print "ok 8\n";
72b16652 134}
72b16652
GS
135
136# "~" should expand to $ENV{HOME}
137$ENV{HOME} = "sweet home";
00c80938 138@a = bsd_glob('~', GLOB_TILDE | GLOB_NOMAGIC);
7369a524 139unless ($^O eq "MacOS" || (@a == 1 and $a[0] eq $ENV{HOME})) {
72b16652
GS
140 print "not ";
141}
142print "ok 9\n";
ab3ed403
BS
143
144# GLOB_ALPHASORT (default) should sort alphabetically regardless of case
8f562d3a
NA
145mkdir "pteerslo", 0777;
146chdir "pteerslo";
93782ce2
BS
147
148@f_names = qw(Ax.pl Bx.pl Cx.pl aY.pl bY.pl cY.pl);
149@f_alpha = qw(Ax.pl aY.pl Bx.pl bY.pl Cx.pl cY.pl);
150if ('a' lt 'A') { # EBCDIC char sets sort lower case before UPPER
151 @f_names = sort(@f_names);
d2f5bb60 152}
89f4ed55 153if ($^O eq 'VMS') { # VMS is happily caseignorant
16421035
PP
154 @f_alpha = qw(ax.pl ay.pl bx.pl by.pl cx.pl cy.pl);
155 @f_names = @f_alpha;
156}
93782ce2
BS
157
158for (@f_names) {
ab3ed403
BS
159 open T, "> $_";
160 close T;
161}
93782ce2
BS
162
163$pat = "*.pl";
164
ab3ed403 165$ok = 1;
93782ce2
BS
166@g_names = bsd_glob($pat, 0);
167print "# f_names = @f_names\n";
168print "# g_names = @g_names\n";
169for (@f_names) {
170 $ok = 0 unless $_ eq shift @g_names;
ab3ed403
BS
171}
172print $ok ? "ok 10\n" : "not ok 10\n";
93782ce2 173
ab3ed403
BS
174$ok = 1;
175@g_alpha = bsd_glob($pat);
584c1423
JH
176print "# f_alpha = @f_alpha\n";
177print "# g_alpha = @g_alpha\n";
93782ce2
BS
178for (@f_alpha) {
179 $ok = 0 unless $_ eq shift @g_alpha;
ab3ed403
BS
180}
181print $ok ? "ok 11\n" : "not ok 11\n";
93782ce2
BS
182
183unlink @f_names;
ab3ed403 184chdir "..";
8f562d3a 185rmdir "pteerslo";
e0e8a4dc
MHM
186
187# this can panic if PL_glob_index gets passed as flags to bsd_glob
188<*>; <*>;
189print "ok 12\n";
77348331
SR
190
191{
192 use File::Temp qw(tempdir);
193 use File::Spec qw();
194
195 my($dir) = tempdir(CLEANUP => 1)
196 or die "Could not create temporary directory";
197 for my $file (qw(a_dej a_ghj a_qej)) {
198 open my $fh, ">", File::Spec->catfile($dir, $file)
199 or die "Could not create file $dir/$file: $!";
200 close $fh;
201 }
202 my $cwd = Cwd::cwd();
203 chdir $dir
204 or die "Could not chdir to $dir: $!";
205 my(@glob_files) = glob("a*{d[e]}j");
206 if (!(@glob_files == 1 && "@glob_files" eq "a_dej")) {
207 print "not ";
208 }
f172cc6b
CB
209 my $todo = $^O ne 'VMS' ? '' : " # TODO home-made glob doesn't do regexes";
210 print "ok 13$todo\n";
77348331
SR
211 chdir $cwd
212 or die "Could not chdir back to $cwd: $!";
213}