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