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