This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to ExtUtils::Command 1.15
[perl5.git] / lib / ExtUtils / t / eu_command.t
CommitLineData
39234879 1#!/usr/bin/perl -w
e38fdfdb 2
3BEGIN {
39234879
MS
4 if( $ENV{PERL_CORE} ) {
5 chdir 't';
6 @INC = ('../lib', 'lib/');
7 }
8 else {
9 unshift @INC, 't/lib/';
10 }
8f78c13d 11}
39234879 12chdir 't';
8f78c13d
JH
13
14BEGIN {
5e719f03
MS
15 $Testfile = 'testfile.foo';
16}
17
18BEGIN {
19 1 while unlink $Testfile, 'newfile';
479d2113
MS
20 # forcibly remove ecmddir/temp2, but don't import mkpath
21 use File::Path ();
22 File::Path::rmtree( 'ecmddir' );
e38fdfdb 23}
24
8bdaab24
NC
25use Test::More tests => 40;
26use File::Spec;
e38fdfdb 27
479d2113
MS
28BEGIN {
29 # bad neighbor, but test_f() uses exit()
a85f5f83
SP
30 *CORE::GLOBAL::exit = ''; # quiet 'only once' warning.
31 *CORE::GLOBAL::exit = sub (;$) { return $_[0] };
479d2113
MS
32 use_ok( 'ExtUtils::Command' );
33}
e38fdfdb 34
479d2113 35{
479d2113
MS
36 # concatenate this file with itself
37 # be extra careful the regex doesn't match itself
39234879 38 use TieOut;
479d2113
MS
39 my $out = tie *STDOUT, 'TieOut';
40 my $self = $0;
41 unless (-f $self) {
42 my ($vol, $dirs, $file) = File::Spec->splitpath($self);
43 my @dirs = File::Spec->splitdir($dirs);
44 unshift(@dirs, File::Spec->updir);
45 $dirs = File::Spec->catdir(@dirs);
46 $self = File::Spec->catpath($vol, $dirs, $file);
47 }
48 @ARGV = ($self, $self);
49
50 cat();
51 is( scalar( $$out =~ s/use_ok\( 'ExtUtils::Command'//g), 2,
52 'concatenation worked' );
53
a85f5f83 54 # the truth value here is reversed -- Perl true is shell false
5e719f03 55 @ARGV = ( $Testfile );
a85f5f83 56 is( test_f(), 1, 'testing non-existent file' );
479d2113 57
479d2113 58 # these are destructive, have to keep setting @ARGV
5e719f03 59 @ARGV = ( $Testfile );
479d2113
MS
60 touch();
61
5e719f03 62 @ARGV = ( $Testfile );
a85f5f83 63 is( test_f(), 0, 'testing touch() and test_f()' );
a7d1454b 64 is_deeply( \@ARGV, [$Testfile], 'test_f preserves @ARGV' );
479d2113 65
5e719f03 66 @ARGV = ( $Testfile );
479d2113
MS
67 ok( -e $ARGV[0], 'created!' );
68
69 my ($now) = time;
70 utime ($now, $now, $ARGV[0]);
5cff3c2c 71 sleep 2;
851f5327 72
479d2113
MS
73 # Just checking modify time stamp, access time stamp is set
74 # to the beginning of the day in Win95.
5cff3c2c
MS
75 # There's a small chance of a 1 second flutter here.
76 my $stamp = (stat($ARGV[0]))[9];
479d2113 77 cmp_ok( abs($now - $stamp), '<=', 1, 'checking modify time stamp' ) ||
57b1a898 78 diag "mtime == $stamp, should be $now";
e38fdfdb 79
479d2113
MS
80 @ARGV = qw(newfile);
81 touch();
82
83 my $new_stamp = (stat('newfile'))[9];
84 cmp_ok( abs($new_stamp - $stamp), '>=', 2, 'newer file created' );
85
5e719f03 86 @ARGV = ('newfile', $Testfile);
479d2113
MS
87 eqtime();
88
5e719f03 89 $stamp = (stat($Testfile))[9];
479d2113
MS
90 cmp_ok( abs($new_stamp - $stamp), '<=', 1, 'eqtime' );
91
92 # eqtime use to clear the contents of the file being equalized!
5e719f03 93 open(FILE, ">>$Testfile") || die $!;
479d2113
MS
94 print FILE "Foo";
95 close FILE;
96
5e719f03 97 @ARGV = ('newfile', $Testfile);
479d2113 98 eqtime();
5e719f03 99 ok( -s $Testfile, "eqtime doesn't clear the file being equalized" );
479d2113 100
f6d6199c
MS
101 SKIP: {
102 if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' ||
d5201bd2 103 $^O eq 'NetWare' || $^O eq 'dos' || $^O eq 'cygwin' ||
d5d4ec93
MS
104 $^O eq 'MacOS'
105 ) {
f353a419 106 skip( "different file permission semantics on $^O", 3);
f6d6199c 107 }
388296f8 108
f6d6199c 109 # change a file to execute-only
5e719f03 110 @ARGV = ( '0100', $Testfile );
f6d6199c 111 ExtUtils::Command::chmod();
388296f8 112
5e719f03 113 is( ((stat($Testfile))[2] & 07777) & 0700,
f6d6199c 114 0100, 'change a file to execute-only' );
388296f8 115
f6d6199c 116 # change a file to read-only
5e719f03 117 @ARGV = ( '0400', $Testfile );
f6d6199c 118 ExtUtils::Command::chmod();
388296f8 119
5e719f03 120 is( ((stat($Testfile))[2] & 07777) & 0700,
f6d6199c 121 ($^O eq 'vos' ? 0500 : 0400), 'change a file to read-only' );
388296f8 122
f6d6199c 123 # change a file to write-only
5e719f03 124 @ARGV = ( '0200', $Testfile );
f6d6199c 125 ExtUtils::Command::chmod();
388296f8 126
5e719f03 127 is( ((stat($Testfile))[2] & 07777) & 0700,
f6d6199c
MS
128 ($^O eq 'vos' ? 0700 : 0200), 'change a file to write-only' );
129 }
388296f8 130
f6d6199c 131 # change a file to read-write
5e719f03 132 @ARGV = ( '0600', $Testfile );
a7d1454b 133 my @orig_argv = @ARGV;
479d2113 134 ExtUtils::Command::chmod();
a7d1454b 135 is_deeply( \@ARGV, \@orig_argv, 'chmod preserves @ARGV' );
e38fdfdb 136
5e719f03 137 is( ((stat($Testfile))[2] & 07777) & 0700,
f6d6199c 138 ($^O eq 'vos' ? 0700 : 0600), 'change a file to read-write' );
e38fdfdb 139
5dca256e
RGS
140
141 SKIP: {
142 if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' ||
143 $^O eq 'NetWare' || $^O eq 'dos' || $^O eq 'cygwin' ||
8bdaab24 144 $^O eq 'MacOS'
5dca256e 145 ) {
a85f5f83 146 skip( "different file permission semantics on $^O", 5);
5dca256e
RGS
147 }
148
149 @ARGV = ('testdir');
150 mkpath;
151 ok( -e 'testdir' );
152
153 # change a dir to execute-only
154 @ARGV = ( '0100', 'testdir' );
155 ExtUtils::Command::chmod();
156
157 is( ((stat('testdir'))[2] & 07777) & 0700,
158 0100, 'change a dir to execute-only' );
159
f353a419
SP
160 # change a dir to read-only
161 @ARGV = ( '0400', 'testdir' );
5dca256e
RGS
162 ExtUtils::Command::chmod();
163
164 is( ((stat('testdir'))[2] & 07777) & 0700,
f353a419 165 ($^O eq 'vos' ? 0500 : 0400), 'change a dir to read-only' );
5dca256e 166
f353a419
SP
167 # change a dir to write-only
168 @ARGV = ( '0200', 'testdir' );
5dca256e
RGS
169 ExtUtils::Command::chmod();
170
171 is( ((stat('testdir'))[2] & 07777) & 0700,
f353a419 172 ($^O eq 'vos' ? 0700 : 0200), 'change a dir to write-only' );
5dca256e
RGS
173
174 @ARGV = ('testdir');
175 rm_rf;
a85f5f83 176 ok( ! -e 'testdir', 'rm_rf can delete a read-only dir' );
5dca256e
RGS
177 }
178
179
479d2113 180 # mkpath
f353a419
SP
181 my $test_dir = File::Spec->join( 'ecmddir', 'temp2' );
182 @ARGV = ( $test_dir );
479d2113 183 ok( ! -e $ARGV[0], 'temp directory not there yet' );
a85f5f83 184 is( test_d(), 1, 'testing non-existent directory' );
e38fdfdb 185
f353a419 186 @ARGV = ( $test_dir );
479d2113
MS
187 mkpath();
188 ok( -e $ARGV[0], 'temp directory created' );
a85f5f83 189 is( test_d(), 0, 'testing existing dir' );
e38fdfdb 190
f353a419 191 @ARGV = ( $test_dir );
479d2113 192 # copy a file to a nested subdirectory
5e719f03 193 unshift @ARGV, $Testfile;
a7d1454b 194 @orig_argv = @ARGV;
479d2113 195 cp();
a7d1454b 196 is_deeply( \@ARGV, \@orig_argv, 'cp preserves @ARGV' );
e38fdfdb 197
5e719f03 198 ok( -e File::Spec->join( 'ecmddir', 'temp2', $Testfile ), 'copied okay' );
e38fdfdb 199
479d2113 200 # cp should croak if destination isn't directory (not a great warning)
5e719f03 201 @ARGV = ( $Testfile ) x 3;
479d2113 202 eval { cp() };
e38fdfdb 203
479d2113 204 like( $@, qr/Too many arguments/, 'cp croaks on error' );
e38fdfdb 205
479d2113 206 # move a file to a subdirectory
5e719f03 207 @ARGV = ( $Testfile, 'ecmddir' );
a7d1454b
RGS
208 @orig_argv = @ARGV;
209 ok( mv() );
210 is_deeply( \@ARGV, \@orig_argv, 'mv preserves @ARGV' );
e38fdfdb 211
5e719f03
MS
212 ok( ! -e $Testfile, 'moved file away' );
213 ok( -e File::Spec->join( 'ecmddir', $Testfile ), 'file in new location' );
e38fdfdb 214
479d2113 215 # mv should also croak with the same wacky warning
5e719f03 216 @ARGV = ( $Testfile ) x 3;
e38fdfdb 217
479d2113
MS
218 eval { mv() };
219 like( $@, qr/Too many arguments/, 'mv croaks on error' );
e38fdfdb 220
5e719f03
MS
221 # Test expand_wildcards()
222 {
223 my $file = $Testfile;
224 @ARGV = ();
225 chdir 'ecmddir';
226
227 # % means 'match one character' on VMS. Everything else is ?
228 my $match_char = $^O eq 'VMS' ? '%' : '?';
229 ($ARGV[0] = $file) =~ s/.\z/$match_char/;
230
231 # this should find the file
232 ExtUtils::Command::expand_wildcards();
233
234 is_deeply( \@ARGV, [$file], 'expanded wildcard ? successfully' );
235
236 # try it with the asterisk now
237 ($ARGV[0] = $file) =~ s/.{3}\z/\*/;
238 ExtUtils::Command::expand_wildcards();
239
240 is_deeply( \@ARGV, [$file], 'expanded wildcard * successfully' );
241
242 chdir File::Spec->updir;
243 }
244
479d2113 245 # remove some files
5e719f03
MS
246 my @files = @ARGV = ( File::Spec->catfile( 'ecmddir', $Testfile ),
247 File::Spec->catfile( 'ecmddir', 'temp2', $Testfile ) );
479d2113 248 rm_f();
e38fdfdb 249
479d2113 250 ok( ! -e $_, "removed $_ successfully" ) for (@ARGV);
e38fdfdb 251
479d2113
MS
252 # rm_f dir
253 @ARGV = my $dir = File::Spec->catfile( 'ecmddir' );
254 rm_rf();
255 ok( ! -e $dir, "removed $dir successfully" );
e38fdfdb 256}
257
a7d1454b 258{
dd0810f9 259 { local @ARGV = 'd2utest'; mkpath; }
a7d1454b 260 open(FILE, '>d2utest/foo');
295d5f02 261 binmode(FILE);
a7d1454b
RGS
262 print FILE "stuff\015\012and thing\015\012";
263 close FILE;
264
265 open(FILE, '>d2utest/bar');
266 binmode(FILE);
267 my $bin = "\c@\c@\c@\c@\c@\c@\cA\c@\c@\c@\015\012".
268 "\@\c@\cA\c@\c@\c@8__LIN\015\012";
269 print FILE $bin;
270 close FILE;
271
272 local @ARGV = 'd2utest';
273 ExtUtils::Command::dos2unix();
274
275 open(FILE, 'd2utest/foo');
276 is( join('', <FILE>), "stuff\012and thing\012", 'dos2unix' );
277 close FILE;
278
279 open(FILE, 'd2utest/bar');
280 binmode(FILE);
281 ok( -B 'd2utest/bar' );
282 is( join('', <FILE>), $bin, 'dos2unix preserves binaries');
283 close FILE;
284}
285
e38fdfdb 286END {
5e719f03 287 1 while unlink $Testfile, 'newfile';
479d2113 288 File::Path::rmtree( 'ecmddir' );
a7d1454b 289 File::Path::rmtree( 'd2utest' );
e38fdfdb 290}