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