This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix for win32/buildext.pl
[perl5.git] / t / lib / glob-basic.t
CommitLineData
72b16652
GS
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
20822f61 5 @INC = '../lib';
d2a01882
GS
6 require Config; import Config;
7 if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
8 print "1..0\n";
9 exit 0;
10 }
ab3ed403 11 print "1..11\n";
72b16652
GS
12}
13END {
14 print "not ok 1\n" unless $loaded;
15}
16use File::Glob ':glob';
a4cf958a 17use Cwd ();
72b16652
GS
18$loaded = 1;
19print "ok 1\n";
20
21sub array {
22 return '(', join(", ", map {defined $_ ? "\"$_\"" : "undef"} @a), ")\n";
23}
24
25# look for the contents of the current directory
26$ENV{PATH} = "/bin";
27delete @ENV{BASH_ENV, CDPATH, ENV, IFS};
28@correct = ();
29if (opendir(D, ".")) {
94a371ee 30 @correct = grep { !/^\./ } sort readdir(D);
72b16652
GS
31 closedir D;
32}
33@a = File::Glob::glob("*", 0);
34@a = sort @a;
35if ("@a" ne "@correct" || GLOB_ERROR) {
36 print "# |@a| ne |@correct|\nnot ";
37}
38print "ok 2\n";
39
40# look up the user's home directory
41# should return a list with one item, and not set ERROR
4b1e50d9 42if ($^O ne 'MSWin32' && $^O ne 'VMS') {
0eb4ebd7 43 eval {
72b16652 44 ($name, $home) = (getpwuid($>))[0,7];
0eb4ebd7
GS
45 1;
46 } and do {
00c80938 47 @a = bsd_glob("~$name", GLOB_TILDE);
72b16652
GS
48 if (scalar(@a) != 1 || $a[0] ne $home || GLOB_ERROR) {
49 print "not ";
50 }
0eb4ebd7 51 };
72b16652
GS
52}
53print "ok 3\n";
54
55# check backslashing
56# should return a list with one item, and not set ERROR
00c80938 57@a = bsd_glob('TEST', GLOB_QUOTE);
72b16652
GS
58if (scalar @a != 1 || $a[0] ne 'TEST' || GLOB_ERROR) {
59 local $/ = "][";
60 print "# [@a]\n";
61 print "not ";
62}
63print "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
00c80938 68@a = bsd_glob("asdfasdf", 0);
72b16652
GS
69if ($^O ne 'MSWin32' and scalar @a != 0) {
70 print "# |@a|\nnot ";
71}
72print "ok 5\n";
73
74# check bad protections
75# should return an empty list, and set ERROR
a4cf958a
GS
76if ($^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{
1cf742e9
GS
79 print "ok 6 # skipped\n";
80}
81else {
ab3ed403 82 $dir = "pteerslt";
1cf742e9 83 mkdir $dir, 0;
00c80938 84 @a = bsd_glob("$dir/*", GLOB_ERR);
1cf742e9
GS
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";
72b16652 91}
72b16652
GS
92
93# check for csh style globbing
00c80938 94@a = bsd_glob('{a,b}', GLOB_BRACE | GLOB_NOMAGIC);
72b16652
GS
95unless (@a == 2 and $a[0] eq 'a' and $a[1] eq 'b') {
96 print "not ";
97}
98print "ok 7\n";
99
00c80938 100@a = bsd_glob(
72b16652 101 '{TES*,doesntexist*,a,b}',
3eba041e 102 GLOB_BRACE | GLOB_NOMAGIC | ($^O eq 'VMS' ? GLOB_NOCASE : 0)
72b16652 103);
5d9a6404 104
8ac1de08
MS
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
109print "# @a\n";
5d9a6404 110
72b16652 111unless (@a == 3
f0963acb 112 and $a[0] eq ($^O eq 'VMS'? 'test.' : 'TEST')
72b16652
GS
113 and $a[1] eq 'a'
114 and $a[2] eq 'b')
115{
116 print "not ";
117}
118print "ok 8\n";
119
120# "~" should expand to $ENV{HOME}
121$ENV{HOME} = "sweet home";
00c80938 122@a = bsd_glob('~', GLOB_TILDE | GLOB_NOMAGIC);
72b16652
GS
123unless (@a == 1 and $a[0] eq $ENV{HOME}) {
124 print "not ";
125}
126print "ok 9\n";
ab3ed403
BS
127
128# GLOB_ALPHASORT (default) should sort alphabetically regardless of case
129mkdir "pteerslt", 0777;
130chdir "pteerslt";
93782ce2
BS
131
132@f_names = qw(Ax.pl Bx.pl Cx.pl aY.pl bY.pl cY.pl);
133@f_alpha = qw(Ax.pl aY.pl Bx.pl bY.pl Cx.pl cY.pl);
134if ('a' lt 'A') { # EBCDIC char sets sort lower case before UPPER
135 @f_names = sort(@f_names);
136 @f_alpha = qw(aY.pl Ax.pl bY.pl Bx.pl cY.pl Cx.pl);
d2f5bb60 137}
93782ce2
BS
138
139for (@f_names) {
ab3ed403
BS
140 open T, "> $_";
141 close T;
142}
93782ce2
BS
143
144$pat = "*.pl";
145
ab3ed403 146$ok = 1;
93782ce2
BS
147@g_names = bsd_glob($pat, 0);
148print "# f_names = @f_names\n";
149print "# g_names = @g_names\n";
150for (@f_names) {
151 $ok = 0 unless $_ eq shift @g_names;
ab3ed403
BS
152}
153print $ok ? "ok 10\n" : "not ok 10\n";
93782ce2 154
ab3ed403
BS
155$ok = 1;
156@g_alpha = bsd_glob($pat);
584c1423
JH
157print "# f_alpha = @f_alpha\n";
158print "# g_alpha = @g_alpha\n";
93782ce2
BS
159for (@f_alpha) {
160 $ok = 0 unless $_ eq shift @g_alpha;
ab3ed403
BS
161}
162print $ok ? "ok 11\n" : "not ok 11\n";
93782ce2
BS
163
164unlink @f_names;
ab3ed403
BS
165chdir "..";
166rmdir "pteerslt";