This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
PATCH lib/ExtUtils/Command.t
[perl5.git] / lib / ExtUtils / Command.t
CommitLineData
e38fdfdb 1#!./perl -w
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
8f78c13d
JH
6}
7
8BEGIN {
e38fdfdb 9 1 while unlink 'ecmdfile';
10 # forcibly remove ecmddir/temp2, but don't import mkpath
11 use File::Path ();
12 File::Path::rmtree( 'ecmddir' );
13}
14
8f78c13d
JH
15BEGIN {
16 use Test::More tests => 21;
17 use File::Spec;
18}
e38fdfdb 19
8f78c13d 20{
e38fdfdb 21 use vars qw( *CORE::GLOBAL::exit );
22
23 # bad neighbor, but test_f() uses exit()
24 *CORE::GLOBAL::exit = sub { return @_ };
25
26 use_ok( 'ExtUtils::Command' );
27
28 # get a file in the current directory, replace last char with wildcard
29 my $file;
30 {
31 local *DIR;
32 opendir(DIR, File::Spec->curdir());
33 while ($file = readdir(DIR)) {
34 last if $file =~ /^\w/;
35 }
36 }
37
38 # this should find the file
39 ($ARGV[0] = $file) =~ s/.\z/\?/;
40 ExtUtils::Command::expand_wildcards();
41
42 is( scalar @ARGV, 1, 'found one file' );
43 like( $ARGV[0], qr/$file/, 'expanded wildcard ? successfully' );
44
45 # try it with the asterisk now
46 ($ARGV[0] = $file) =~ s/.{3}\z/\*/;
47 ExtUtils::Command::expand_wildcards();
48
49 ok( (grep { qr/$file/ } @ARGV), 'expanded wildcard * successfully' );
50
51 # concatenate this file with itself
52 # be extra careful the regex doesn't match itself
53 my $out = tie *STDOUT, 'TieOut';
8f78c13d
JH
54 my $self = $0;
55 unless (-f $self) {
56 my ($vol, $dirs, $file) = File::Spec->splitpath($self);
57 my @dirs = File::Spec->splitdir($dirs);
58 unshift(@dirs, File::Spec->updir);
59 $dirs = File::Spec->catdir(@dirs);
60 $self = File::Spec->catpath($vol, $dirs, $file);
61 }
62 @ARGV = ($self, $self);
e38fdfdb 63
64 cat();
65 is( scalar( $$out =~ s/use_ok\( 'ExtUtils::Command'//g), 2,
66 'concatenation worked' );
67
68 # the truth value here is reversed -- Perl true is C false
69 @ARGV = ( 'ecmdfile' );
70 ok( test_f(), 'testing non-existent file' );
71
72 @ARGV = ( 'ecmdfile' );
73 is( ! test_f(), (-f 'ecmdfile'), 'testing non-existent file' );
74
75 # these are destructive, have to keep setting @ARGV
76 @ARGV = ( 'ecmdfile' );
77 touch();
78
79 @ARGV = ( 'ecmdfile' );
80 ok( test_f(), 'now creating that file' );
81
82 @ARGV = ( 'ecmdfile' );
83 ok( -e $ARGV[0], 'created!' );
84
851f5327
NK
85 my ($now) = time;
86 utime ($now, $now, $ARGV[0]);
87
fbac1b85
NK
88 # Just checking modify time stamp, access time stamp is set
89 # to the beginning of the day in Win95
e38fdfdb 90 is( (stat($ARGV[0]))[9], $now, 'checking modify time stamp' );
91
92 # change a file to read-only
93 @ARGV = ( 0600, 'ecmdfile' );
94 ExtUtils::Command::chmod();
95
3af7c81f 96 is( ((stat('ecmdfile'))[2] & 07777) & 0700, 0600, 'change a file to read-only' );
e38fdfdb 97
98 # mkpath
99 @ARGV = ( File::Spec->join( 'ecmddir', 'temp2' ) );
100 ok( ! -e $ARGV[0], 'temp directory not there yet' );
101
102 mkpath();
103 ok( -e $ARGV[0], 'temp directory created' );
104
105 # copy a file to a nested subdirectory
106 unshift @ARGV, 'ecmdfile';
107 cp();
108
109 ok( -e File::Spec->join( 'ecmddir', 'temp2', 'ecmdfile' ), 'copied okay' );
110
111 # cp should croak if destination isn't directory (not a great warning)
112 @ARGV = ( 'ecmdfile' ) x 3;
113 eval { cp() };
114
115 like( $@, qr/Too many arguments/, 'cp croaks on error' );
116
117 # move a file to a subdirectory
118 @ARGV = ( 'ecmdfile', 'ecmddir' );
119 mv();
120
121 ok( ! -e 'ecmdfile', 'moved file away' );
122 ok( -e File::Spec->join( 'ecmddir', 'ecmdfile' ), 'file in new location' );
123
124 # mv should also croak with the same wacky warning
125 @ARGV = ( 'ecmdfile' ) x 3;
126
127 eval { mv() };
128 like( $@, qr/Too many arguments/, 'mv croaks on error' );
129
130 # remove some files
131 my @files = @ARGV = ( File::Spec->catfile( 'ecmddir', 'ecmdfile' ),
132 File::Spec->catfile( 'ecmddir', 'temp2', 'ecmdfile' ) );
133 rm_f();
134
135 ok( ! -e $_, "removed $_ successfully" ) for (@ARGV);
136
137 # rm_f dir
138 @ARGV = my $dir = File::Spec->catfile( 'ecmddir' );
139 rm_rf();
140 ok( ! -e $dir, "removed $dir successfully" );
141}
142
143END {
144 1 while unlink 'ecmdfile';
145 File::Path::rmtree( 'ecmddir' );
146}
147
148package TieOut;
149
150sub TIEHANDLE {
151 bless( \(my $text), $_[0] );
152}
153
154sub PRINT {
155 ${ $_[0] } .= join($/, @_);
156}