This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove wrong cast to (void *), which fixes a gcc warning, and use
[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" );
153 is( -w $copy, -w $orig, " writable if original was" );
154 is( -x $copy, -x $orig, " executable if original was" );
155}
156rmtree('copy');
157
158
0300da75
MS
159# poison the manifest, and add a comment that should be reported
160add_file( 'MANIFEST', 'none #none' );
f6d6199c
MS
161is( ExtUtils::Manifest::maniread()->{none}, '#none',
162 'maniread found comment' );
0300da75
MS
163
164ok( mkdir( 'copy', 0777 ), 'made copy directory' );
0300da75
MS
165$files = maniread();
166eval { (undef, $warn) = catch_warning( sub {
57b1a898 167 manicopy( $files, 'copy', 'cp' ) })
0300da75 168};
57b1a898 169like( $@, qr/^Can't read none: /, 'croaked about none' );
0300da75
MS
170
171# a newline comes through, so get rid of it
172chomp($warn);
173
174# the copy should have given one warning and one error
f6d6199c 175like($warn, qr/^Skipping MANIFEST.SKIP/i, 'warned about MANIFEST.SKIP' );
0300da75
MS
176
177# tell ExtUtils::Manifest to use a different file
f6d6199c
MS
178{
179 local $ExtUtils::Manifest::MANIFEST = 'albatross';
180 ($res, $warn) = catch_warning( \&mkmanifest );
181 like( $warn, qr/Added to albatross: /, 'using a new manifest file' );
182
183 # add the new file to the list of files to be deleted
2530b651 184 $Files{'albatross'}++;
39234879 185}
0300da75 186
0300da75 187
f6d6199c
MS
188# Make sure MANIFEST.SKIP is using complete relative paths
189add_file( 'MANIFEST.SKIP' => "^moretest/q\n" );
190
191# This'll skip moretest/quux
192($res, $warn) = catch_warning( \&skipcheck );
45bc4d3a
JH
193like( $warn, qr{^Skipping moretest/quux$}i, 'got skipping warning again' );
194
195
196# There was a bug where entries in MANIFEST would be blotted out
197# by MANIFEST.SKIP rules.
198add_file( 'MANIFEST.SKIP' => 'foo' );
479d2113 199add_file( 'MANIFEST' => "foobar\n" );
45bc4d3a
JH
200add_file( 'foobar' => '123' );
201($res, $warn) = catch_warning( \&manicheck );
202is( $res, '', 'MANIFEST overrides MANIFEST.SKIP' );
203is( $warn, undef, 'MANIFEST overrides MANIFEST.SKIP, no warnings' );
f6d6199c 204
479d2113
MS
205$files = maniread;
206ok( !$files->{wibble}, 'MANIFEST in good state' );
207maniadd({ wibble => undef });
208maniadd({ yarrow => "hock" });
209$files = maniread;
210is( $files->{wibble}, '', 'maniadd() with undef comment' );
211is( $files->{yarrow}, 'hock',' with comment' );
212is( $files->{foobar}, '', ' preserved old entries' );
5ca25ae7 213
2530b651 214add_file('MANIFEST' => 'Makefile.PL');
9d058bf8 215maniadd({ foo => 'bar' });
2530b651
MS
216$files = maniread;
217# VMS downcases the MANIFEST. We normalize it here to match.
218%$files = map { (lc $_ => $files->{$_}) } keys %$files;
219my %expect = ( 'makefile.pl' => '',
5ca25ae7
JH
220 'foo' => 'bar'
221 );
2530b651 222is_deeply( $files, \%expect, 'maniadd() vs MANIFEST without trailing newline');
0300da75 223
5ca25ae7
JH
224add_file('MANIFEST' => 'Makefile.PL');
225maniadd({ foo => 'bar' });
226
2c91f887
JH
227SKIP: {
228 chmod( 0400, 'MANIFEST' );
229 skip "Can't make MANIFEST read-only", 2 if -w 'MANIFEST';
230
380d5532
MS
231 eval {
232 maniadd({ 'foo' => 'bar' });
233 };
2c91f887
JH
234 is( $@, '', "maniadd() won't open MANIFEST if it doesn't need to" );
235
236 eval {
237 maniadd({ 'grrrwoof' => 'yippie' });
238 };
30361541 239 like( $@, qr/^\Qmaniadd() could not open MANIFEST:\E/,
2c91f887
JH
240 "maniadd() dies if it can't open the MANIFEST" );
241
0aa703b2 242 chmod( 0600, 'MANIFEST' );
2c91f887 243}
a7d1454b 244
2c91f887 245
0300da75 246END {
2530b651 247 is( unlink( keys %Files ), keys %Files, 'remove all added files' );
0300da75
MS
248 remove_dir( 'moretest', 'copy' );
249
250 # now get rid of the parent directory
251 ok( chdir( $cwd ), 'return to parent directory' );
252 remove_dir( 'mantest' );
253}
349e1be1 254