This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make Manifest.t do what is says it's doing.
[perl5.git] / lib / ExtUtils / t / Manifest.t
CommitLineData
f6d6199c 1#!/usr/bin/perl -w
0300da75
MS
2
3BEGIN {
39234879
MS
4 if( $ENV{PERL_CORE} ) {
5 chdir 't' if -d 't';
6 unshift @INC, '../lib';
7 }
f6d6199c
MS
8 else {
9 unshift @INC, 't/lib';
10 }
0300da75 11}
39234879 12chdir 't';
0300da75 13
f6d6199c
MS
14use strict;
15
a7d1454b 16use Test::More tests => 49;
0300da75
MS
17use Cwd;
18
0300da75
MS
19use File::Spec;
20use File::Path;
a7d1454b
RGS
21use File::Find;
22
23my $Is_VMS = $^O eq 'VMS';
57b1a898
MS
24
25# We're going to be chdir'ing and modules are sometimes loaded on the
26# fly in this test, so we need an absolute @INC.
27@INC = map { File::Spec->rel2abs($_) } @INC;
0300da75
MS
28
29# keep track of everything added so it can all be deleted
2530b651 30my %Files;
0300da75 31sub add_file {
479d2113
MS
32 my ($file, $data) = @_;
33 $data ||= 'foo';
2530b651 34 1 while unlink $file; # or else we'll get multiple versions on VMS
479d2113
MS
35 open( T, '>'.$file) or return;
36 print T $data;
2530b651 37 ++$Files{$file};
57b1a898 38 close T;
0300da75
MS
39}
40
41sub read_manifest {
a7d1454b
RGS
42 open( M, 'MANIFEST' ) or return;
43 chomp( my @files = <M> );
57b1a898 44 close M;
a7d1454b 45 return @files;
0300da75
MS
46}
47
48sub catch_warning {
a7d1454b
RGS
49 my $warn;
50 local $SIG{__WARN__} = sub { $warn .= $_[0] };
51 return join('', $_[0]->() ), $warn;
0300da75
MS
52}
53
54sub remove_dir {
a7d1454b 55 ok( rmdir( $_ ), "remove $_ directory" ) for @_;
0300da75
MS
56}
57
58# use module, import functions
f6d6199c
MS
59BEGIN {
60 use_ok( 'ExtUtils::Manifest',
61 qw( mkmanifest manicheck filecheck fullcheck
479d2113 62 maniread manicopy skipcheck maniadd) );
f6d6199c 63}
0300da75
MS
64
65my $cwd = Cwd::getcwd();
66
67# Just in case any old files were lying around.
68rmtree('mantest');
69
70ok( mkdir( 'mantest', 0777 ), 'make mantest directory' );
71ok( chdir( 'mantest' ), 'chdir() to mantest' );
72ok( add_file('foo'), 'add a temporary file' );
73
74# there shouldn't be a MANIFEST there
75my ($res, $warn) = catch_warning( \&mkmanifest );
f2e6bef3 76# Canonize the order.
f6d6199c
MS
77$warn = join("", map { "$_|" }
78 sort { lc($a) cmp lc($b) } split /\r?\n/, $warn);
f2e6bef3 79is( $warn, "Added to MANIFEST: foo|Added to MANIFEST: MANIFEST|",
f6d6199c 80 "mkmanifest() displayed its additions" );
0300da75
MS
81
82# and now you see it
83ok( -e 'MANIFEST', 'create MANIFEST file' );
84
85my @list = read_manifest();
86is( @list, 2, 'check files in MANIFEST' );
87ok( ! ExtUtils::Manifest::filecheck(), 'no additional files in directory' );
88
89# after adding bar, the MANIFEST is out of date
90ok( add_file( 'bar' ), 'add another file' );
91ok( ! manicheck(), 'MANIFEST now out of sync' );
92
93# it reports that bar has been added and throws a warning
94($res, $warn) = catch_warning( \&filecheck );
95
96like( $warn, qr/^Not in MANIFEST: bar/, 'warning that bar has been added' );
97is( $res, 'bar', 'bar reported as new' );
98
99# now quiet the warning that bar was added and test again
f6d6199c
MS
100($res, $warn) = do { local $ExtUtils::Manifest::Quiet = 1;
101 catch_warning( \&skipcheck )
102 };
6e908d91 103ok( ! defined $warn, 'disabled warnings' );
0300da75 104
f6d6199c 105# add a skip file with a rule to skip itself (and the nonexistent glob '*baz*')
0300da75
MS
106add_file( 'MANIFEST.SKIP', "baz\n.SKIP" );
107
108# this'll skip the new file
f6d6199c
MS
109($res, $warn) = catch_warning( \&skipcheck );
110like( $warn, qr/^Skipping MANIFEST\.SKIP/i, 'got skipping warning' );
0300da75 111
45bc4d3a 112my @skipped;
0300da75 113catch_warning( sub {
45bc4d3a 114 @skipped = skipcheck()
0300da75
MS
115});
116
45bc4d3a 117is( join( ' ', @skipped ), 'MANIFEST.SKIP', 'listed skipped files' );
0300da75 118
f6d6199c
MS
119{
120 local $ExtUtils::Manifest::Quiet = 1;
121 is( join(' ', filecheck() ), 'bar', 'listing skipped with filecheck()' );
122}
0300da75
MS
123
124# add a subdirectory and a file there that should be found
125ok( mkdir( 'moretest', 0777 ), 'created moretest directory' );
f6d6199c
MS
126add_file( File::Spec->catfile('moretest', 'quux'), 'quux' );
127ok( exists( ExtUtils::Manifest::manifind()->{'moretest/quux'} ),
128 "manifind found moretest/quux" );
0300da75
MS
129
130# only MANIFEST and foo are in the manifest
2530b651 131$_ = 'foo';
0300da75
MS
132my $files = maniread();
133is( keys %$files, 2, 'two files found' );
f6d6199c
MS
134is( join(' ', sort { lc($a) cmp lc($b) } keys %$files), 'foo MANIFEST',
135 'both files found' );
2530b651 136is( $_, 'foo', q{maniread() doesn't clobber $_} );
0300da75 137
a7d1454b
RGS
138ok( mkdir( 'copy', 0777 ), 'made copy directory' );
139
140# Check that manicopy copies files.
141manicopy( $files, 'copy', 'cp' );
142my @copies = ();
143find( sub { push @copies, $_ if -f }, 'copy' );
144@copies = map { s/\.$//; $_ } @copies if $Is_VMS; # VMS likes to put dots on
145 # the end of files.
146# Have to compare insensitively for non-case preserving VMS
147is_deeply( [sort map { lc } @copies], [sort map { lc } keys %$files] );
148
149# cp would leave files readonly, so check permissions.
150foreach my $orig (@copies) {
151 my $copy = "copy/$orig";
152 ok( -r $copy, "$copy: must be readable" );
1bd1db6f
CB
153
154 SKIP: {
155 skip " original was not writable", 1 unless -w $orig;
156 ok(-w $copy, " writable if original was" );
157 }
158
159 SKIP: {
160 skip " original was not executable", 1 unless -x $orig;
161 ok(-x $copy, " executable if original was" );
162 }
a7d1454b
RGS
163}
164rmtree('copy');
165
166
0300da75
MS
167# poison the manifest, and add a comment that should be reported
168add_file( 'MANIFEST', 'none #none' );
f6d6199c
MS
169is( ExtUtils::Manifest::maniread()->{none}, '#none',
170 'maniread found comment' );
0300da75
MS
171
172ok( mkdir( 'copy', 0777 ), 'made copy directory' );
0300da75
MS
173$files = maniread();
174eval { (undef, $warn) = catch_warning( sub {
57b1a898 175 manicopy( $files, 'copy', 'cp' ) })
0300da75 176};
57b1a898 177like( $@, qr/^Can't read none: /, 'croaked about none' );
0300da75
MS
178
179# a newline comes through, so get rid of it
180chomp($warn);
181
182# the copy should have given one warning and one error
f6d6199c 183like($warn, qr/^Skipping MANIFEST.SKIP/i, 'warned about MANIFEST.SKIP' );
0300da75
MS
184
185# tell ExtUtils::Manifest to use a different file
f6d6199c
MS
186{
187 local $ExtUtils::Manifest::MANIFEST = 'albatross';
188 ($res, $warn) = catch_warning( \&mkmanifest );
189 like( $warn, qr/Added to albatross: /, 'using a new manifest file' );
190
191 # add the new file to the list of files to be deleted
2530b651 192 $Files{'albatross'}++;
39234879 193}
0300da75 194
0300da75 195
f6d6199c
MS
196# Make sure MANIFEST.SKIP is using complete relative paths
197add_file( 'MANIFEST.SKIP' => "^moretest/q\n" );
198
199# This'll skip moretest/quux
200($res, $warn) = catch_warning( \&skipcheck );
45bc4d3a
JH
201like( $warn, qr{^Skipping moretest/quux$}i, 'got skipping warning again' );
202
203
204# There was a bug where entries in MANIFEST would be blotted out
205# by MANIFEST.SKIP rules.
206add_file( 'MANIFEST.SKIP' => 'foo' );
479d2113 207add_file( 'MANIFEST' => "foobar\n" );
45bc4d3a
JH
208add_file( 'foobar' => '123' );
209($res, $warn) = catch_warning( \&manicheck );
210is( $res, '', 'MANIFEST overrides MANIFEST.SKIP' );
211is( $warn, undef, 'MANIFEST overrides MANIFEST.SKIP, no warnings' );
f6d6199c 212
479d2113
MS
213$files = maniread;
214ok( !$files->{wibble}, 'MANIFEST in good state' );
215maniadd({ wibble => undef });
216maniadd({ yarrow => "hock" });
217$files = maniread;
218is( $files->{wibble}, '', 'maniadd() with undef comment' );
219is( $files->{yarrow}, 'hock',' with comment' );
220is( $files->{foobar}, '', ' preserved old entries' );
5ca25ae7 221
2530b651 222add_file('MANIFEST' => 'Makefile.PL');
9d058bf8 223maniadd({ foo => 'bar' });
2530b651
MS
224$files = maniread;
225# VMS downcases the MANIFEST. We normalize it here to match.
226%$files = map { (lc $_ => $files->{$_}) } keys %$files;
227my %expect = ( 'makefile.pl' => '',
5ca25ae7
JH
228 'foo' => 'bar'
229 );
2530b651 230is_deeply( $files, \%expect, 'maniadd() vs MANIFEST without trailing newline');
0300da75 231
5ca25ae7
JH
232add_file('MANIFEST' => 'Makefile.PL');
233maniadd({ foo => 'bar' });
234
2c91f887
JH
235SKIP: {
236 chmod( 0400, 'MANIFEST' );
237 skip "Can't make MANIFEST read-only", 2 if -w 'MANIFEST';
238
380d5532
MS
239 eval {
240 maniadd({ 'foo' => 'bar' });
241 };
2c91f887
JH
242 is( $@, '', "maniadd() won't open MANIFEST if it doesn't need to" );
243
244 eval {
245 maniadd({ 'grrrwoof' => 'yippie' });
246 };
30361541 247 like( $@, qr/^\Qmaniadd() could not open MANIFEST:\E/,
2c91f887
JH
248 "maniadd() dies if it can't open the MANIFEST" );
249
0aa703b2 250 chmod( 0600, 'MANIFEST' );
2c91f887 251}
a7d1454b 252
2c91f887 253
0300da75 254END {
2530b651 255 is( unlink( keys %Files ), keys %Files, 'remove all added files' );
0300da75
MS
256 remove_dir( 'moretest', 'copy' );
257
258 # now get rid of the parent directory
259 ok( chdir( $cwd ), 'return to parent directory' );
260 remove_dir( 'mantest' );
261}
349e1be1 262