Skip to content

Commit

Permalink
Pull out manicopy tests
Browse files Browse the repository at this point in the history
  • Loading branch information
kentfredric committed Feb 11, 2015
1 parent cf0e83e commit 78ce16a
Show file tree
Hide file tree
Showing 2 changed files with 65 additions and 39 deletions.
44 changes: 5 additions & 39 deletions t/Manifest.t
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,7 @@ chdir 't';

use strict;

use Test::More tests => 92;
use Test::More tests => 81;
use Cwd;

use File::Spec;
Expand Down Expand Up @@ -75,7 +75,7 @@ sub remove_dir {
BEGIN {
use_ok( 'ExtUtils::Manifest',
qw( mkmanifest
maniread manicopy skipcheck maniadd maniskip) );
maniread skipcheck maniadd maniskip) );
}

my $cwd = Cwd::getcwd();
Expand All @@ -87,14 +87,7 @@ ok( mkdir( 'mantest', 0777 ), 'make mantest directory' );
ok( chdir( 'mantest' ), 'chdir() to mantest' );
ok( add_file('foo'), 'add a temporary file' );

# This ensures the -x check for manicopy means something
# Some platforms don't have chmod or an executable bit, in which case
# this call will do nothing or fail, but on the platforms where chmod()
# works, we test the executable bit is copied
chmod( 0744, 'foo') if $Config{'chmod'};

my ($res, $warn);

add_file('MANIFEST',<<'EOF');
foo
MANIFEST
Expand Down Expand Up @@ -132,38 +125,11 @@ add_file( File::Spec->catfile('moretest', 'quux'), 'quux' );
ok( exists( ExtUtils::Manifest::manifind()->{'moretest/quux'} ),
"manifind found moretest/quux" );

my $files = maniread();
ok( mkdir( 'copy', 0777 ), 'made copy directory' );

# Check that manicopy copies files.
manicopy( $files, 'copy', 'cp' );
my @copies = ();
find( sub { push @copies, $_ if -f }, 'copy' );
@copies = map { s/\.$//; $_ } @copies if $Is_VMS; # VMS likes to put dots on
# the end of files.
# Have to compare insensitively for non-case preserving VMS
is_deeply( [sort map { lc } @copies], [sort map { lc } keys %$files] );

# cp would leave files readonly, so check permissions.
foreach my $orig (@copies) {
my $copy = "copy/$orig";
ok( -r $copy, "$copy: must be readable" );
is( -w $copy, -w $orig, " writable if original was" );
is( -x $copy, -x $orig, " executable if original was" );
}
rmtree('copy');

add_file( 'MANIFEST', 'none #none' );
ok( mkdir( 'copy', 0777 ), 'made copy directory' );

$files = maniread();
eval { (undef, $warn) = catch_warning( sub {
manicopy( $files, 'copy', 'cp' ) })
};
my $files = maniread();

# a newline comes through, so get rid of it
chomp($warn);
# the copy should have given a warning
like($warn, qr/^none not found/, 'carped about none' );
($res, $warn) = catch_warning( \&skipcheck );
like($warn, qr/^Skipping MANIFEST.SKIP/i, 'warned about MANIFEST.SKIP' );

Expand Down Expand Up @@ -426,7 +392,7 @@ END {
is(( unlink $file ), 1, "Unlink $file") or note "$!";
}
for my $file ( keys %Files ) { 1 while unlink $file; } # all versions
remove_dir( 'moretest', 'copy' );
remove_dir( 'moretest');

# now get rid of the parent directory
ok( chdir( $cwd ), 'return to parent directory' );
Expand Down
60 changes: 60 additions & 0 deletions t/manicopy.t
Original file line number Diff line number Diff line change
@@ -0,0 +1,60 @@
use strict;
use warnings;

use lib 't/lib';
use ManifestTest qw( catch_warning canon_warning spew slurp runtemp );
use ExtUtils::Manifest qw( manicopy );
use Test::More tests => 16;
use Config;

runtemp "manicopy.emptylist" => sub {
note "Sanity check running manicopy with no work to do";
ok( ( mkdir 'target', 0700 ), 'make target dir ok' );
my ( $exit, $warn ) = catch_warning sub { manicopy( {}, 'target' ) };
is( $warn, '', 'No-op = no warning' );
};

runtemp "manicopy.basic" => sub {
note "Copying a file";
ok( ( mkdir 'target', 0700 ), 'make target dir ok' );
spew( 'file', "####" );
my $source = 'file';
my $target = 'target/file';

my ( $exit, $warn ) = catch_warning sub { manicopy( { 'file' => 'description' }, 'target', 'cp' ) };
is( $warn, '', 'no warning' );
ok( -e $target, 'Copied ok' );
is( slurp($target), '####', 'Content preserved' );
ok( -r $target, 'Copied file should be readable' );
is( -x $target, -x $source, '-x bits copied' );
is( -w $target, -w $source, '-w bits copied' );
};

runtemp "manicopy.executable" => sub {
note "Copying a file that might have -x bits";

SKIP: {
# This ensures the -x check for manicopy means something
# Some platforms don't have chmod or an executable bit, in which case
# this call will do nothing or fail, but on the platforms where chmod()
# works, we test the executable bit is copied

skip "No Exec bits support for copy test", 5 unless $Config{'chmod'};

ok( ( mkdir 'target', 0700 ), 'make target dir ok' );
spew( 'execfile', "####" );
chmod( 0744, 'execfile' );
ok( -x 'execfile', 'Created an -x file' );
my ( $exit, $warn ) = catch_warning sub { manicopy( { 'execfile' => 'description' }, 'target' ) };
is( $warn, '', 'no warning' );
ok( -e 'target/execfile', 'Copied ok' );
ok( -x 'target/execfile', '-x bits copied' );
}
};

runtemp 'manicopy.warn_missing' => sub {
note "Copying a file that doesn't exist";
ok( ( mkdir 'target', 0700 ), 'make target dir ok' );
my ( $exit, $warn ) = catch_warning sub { manicopy( { none => 'none' }, 'target', 'cp' ) };
like( $warn, qr/^none not found/, 'carped about missing file' );
};

0 comments on commit 78ce16a

Please sign in to comment.