diff options
Diffstat (limited to 't')
| -rw-r--r-- | t/00-compile.t | 51 | ||||
| -rw-r--r-- | t/destinations.t | 284 | ||||
| -rw-r--r-- | t/release-pod-coverage.t | 15 | ||||
| -rw-r--r-- | t/release-pod-syntax.t | 14 |
4 files changed, 364 insertions, 0 deletions
diff --git a/t/00-compile.t b/t/00-compile.t new file mode 100644 index 0000000..0b7224f --- /dev/null +++ b/t/00-compile.t @@ -0,0 +1,51 @@ +use 5.006; +use strict; +use warnings; + +# this test was generated with Dist::Zilla::Plugin::Test::Compile 2.051 + +use Test::More; + +plan tests => 1 + ($ENV{AUTHOR_TESTING} ? 1 : 0); + +my @module_files = ( + 'ExtUtils/InstallPaths.pm' +); + + + +# no fake home requested + +my $inc_switch = -d 'blib' ? '-Mblib' : '-Ilib'; + +use File::Spec; +use IPC::Open3; +use IO::Handle; + +open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!"; + +my @warnings; +for my $lib (@module_files) +{ + # see L<perlfaq8/How can I capture STDERR from an external command?> + my $stderr = IO::Handle->new; + + my $pid = open3($stdin, '>&STDERR', $stderr, $^X, $inc_switch, '-e', "require q[$lib]"); + binmode $stderr, ':crlf' if $^O eq 'MSWin32'; + my @_warnings = <$stderr>; + waitpid($pid, 0); + is($?, 0, "$lib loaded ok"); + + if (@_warnings) + { + warn @_warnings; + push @warnings, @_warnings; + } +} + + + +is(scalar(@warnings), 0, 'no warnings found') + or diag 'got warnings: ', ( Test::More->can('explain') ? Test::More::explain(\@warnings) : join("\n", '', @warnings) ) if $ENV{AUTHOR_TESTING}; + + diff --git a/t/destinations.t b/t/destinations.t new file mode 100644 index 0000000..0575eb3 --- /dev/null +++ b/t/destinations.t @@ -0,0 +1,284 @@ +#!/usr/bin/perl -w + +use strict; +use warnings FATAL => 'all'; +use Test::More tests => 105; + +use Config; +use File::Temp (); + +use File::Spec::Functions 0.83 ':ALL'; +my $tmp = File::Temp::tempdir('EIP-XXXXXXXX', CLEANUP => 1, DIR => tmpdir); + +use ExtUtils::Config; +use ExtUtils::InstallPaths; + +######################### + +# We need to create a well defined environment to test install paths. +# We do this by setting up appropriate Config entries. + +my @installstyle = qw(lib perl5); +my $config = ExtUtils::Config->new({ + installstyle => catdir(@installstyle), + + installprivlib => catdir($tmp, @installstyle), + installarchlib => catdir($tmp, @installstyle, @Config{qw(version archname)}), + installbin => catdir($tmp, 'bin'), + installscript => catdir($tmp, 'bin'), + installman1dir => catdir($tmp, 'man', 'man1'), + installman3dir => catdir($tmp, 'man', 'man3'), + installhtml1dir => catdir($tmp, 'html'), + installhtml3dir => catdir($tmp, 'html'), + + installsitelib => catdir($tmp, 'site', @installstyle, 'site_perl'), + installsitearch => catdir($tmp, 'site', @installstyle, 'site_perl', @Config{qw(version archname)}), + installsitebin => catdir($tmp, 'site', 'bin'), + installsitescript => catdir($tmp, 'site', 'bin'), + installsiteman1dir => catdir($tmp, 'site', 'man', 'man1'), + installsiteman3dir => catdir($tmp, 'site', 'man', 'man3'), + installsitehtml1dir => catdir($tmp, 'site', 'html'), + installsitehtml3dir => catdir($tmp, 'site', 'html'), +}); + +sub get_ei { + my %args = @_; + return ExtUtils::InstallPaths->new(installdirs => 'site', config => $config, dist_name => 'ExtUtils-InstallPaths', %args); +} + +isa_ok(get_ei, 'ExtUtils::InstallPaths'); + +{ + my $elem = catdir(rootdir, qw/foo bar/); + my $ei = get_ei(install_path => { elem => $elem}); + is($ei->install_path('elem'), $elem, ' can read stored path'); +} + +{ + my $ei = get_ei(install_base => catdir(rootdir, 'bar'), install_base_relpaths => { 'elem' => catdir(qw/foo bar/) }); + + is($ei->install_base_relpaths('elem'), catdir(qw/foo bar/), ' can read stored path'); + is($ei->install_destination('lib'), catdir(rootdir, qw/bar lib perl5/), 'destination of other items is not affected'); +} + + +{ + my $ei = eval { get_ei(prefix_relpaths => { 'site' => { 'elem' => catdir(rootdir, qw/foo bar/)} }) }; + is ($ei, undef, '$ei undefined'); + like($@, qr/Value must be a relative path/, ' emits error if path not relative'); +} + +{ + my $ei = get_ei(prefix_relpaths => { site => { elem => catdir(qw/foo bar/) } }); + + my $path = $ei->prefix_relpaths('site', 'elem'); + is($path, catdir(qw(foo bar)), ' can read stored path'); +} + + +# Check that we install into the proper default locations. +{ + my $ei = get_ei(); + + test_install_destinations($ei, { + lib => catdir($tmp, 'site', @installstyle, 'site_perl'), + arch => catdir($tmp, 'site', @installstyle, 'site_perl', @Config{qw(version archname)}), + bin => catdir($tmp, 'site', 'bin'), + script => catdir($tmp, 'site', 'bin'), + bindoc => catdir($tmp, 'site', 'man', 'man1'), + libdoc => catdir($tmp, 'site', 'man', 'man3'), + binhtml => catdir($tmp, 'site', 'html'), + libhtml => catdir($tmp, 'site', 'html'), + }, 'installdirs=site'); + test_install_map($ei, { + read => '', + write => catfile($ei->install_destination('arch'), qw/auto ExtUtils InstallPaths .packlist/), + catdir('blib', 'lib') => catdir($tmp, 'site', @installstyle, 'site_perl'), + catdir('blib', 'arch') => catdir($tmp, 'site', @installstyle, 'site_perl', @Config{qw(version archname)}), + catdir('blib', 'bin') => catdir($tmp, 'site', 'bin'), + catdir('blib', 'script') => catdir($tmp, 'site', 'bin'), + }, 'installdirs=site'); +} + +# Is installdirs honored? +{ + my $ei = get_ei(installdirs => 'core'); + is($ei->installdirs, 'core'); + + test_install_destinations($ei, { + lib => catdir($tmp, @installstyle), + arch => catdir($tmp, @installstyle, @Config{qw(version archname)}), + bin => catdir($tmp, 'bin'), + script => catdir($tmp, 'bin'), + bindoc => catdir($tmp, 'man', 'man1'), + libdoc => catdir($tmp, 'man', 'man3'), + binhtml => catdir($tmp, 'html'), + libhtml => catdir($tmp, 'html'), + }); +} + +# Check install_base() +{ + my $install_base = catdir('foo', 'bar'); + my $ei = get_ei(install_base => $install_base); + + is($ei->prefix, undef); + is($ei->install_base, $install_base); + + test_install_destinations($ei, { + lib => catdir($install_base, 'lib', 'perl5'), + arch => catdir($install_base, 'lib', 'perl5', $Config{archname}), + bin => catdir($install_base, 'bin'), + script => catdir($install_base, 'bin'), + bindoc => catdir($install_base, 'man', 'man1'), + libdoc => catdir($install_base, 'man', 'man3'), + binhtml => catdir($install_base, 'html'), + libhtml => catdir($install_base, 'html'), + }); + + test_install_map($ei, { + read => '', + write => catfile($ei->install_destination('arch'), qw/auto ExtUtils InstallPaths .packlist/), + catdir('blib', 'lib') => catdir($install_base, 'lib', 'perl5'), + catdir('blib', 'arch') => catdir($install_base, 'lib', 'perl5', $Config{archname}), + catdir('blib', 'bin') => catdir($install_base, 'bin'), + catdir('blib', 'script') => catdir($install_base, 'bin'), + }, 'install_base'); +} + + +# Basic prefix test. Ensure everything is under the prefix. +{ + my $prefix = catdir(qw/some prefix/); + my $ei = get_ei(prefix => $prefix); + + ok(!defined $ei->install_base, 'install_base is not defined'); + is($ei->prefix, $prefix, "The prefix is $prefix"); + + test_prefix($ei, $prefix); +# test_prefix($ei, $prefix, $ei->install_sets('site')); +} + +# And now that prefix honors installdirs. +{ + my $prefix = catdir(qw/some prefix/); + my $ei = get_ei(prefix => $prefix, installdirs => 'core'); + + is($ei->installdirs, 'core'); + test_prefix($ei, $prefix); +} + +{ + my $ei = get_ei; +# Try a config setting which would result in installation locations outside +# the prefix. Ensure it doesn't. + # Get the prefix defaults + my @types = $ei->install_types; + + # Create a configuration involving weird paths that are outside of + # the configured prefix. + my @prefixes = ([qw(foo bar)], [qw(biz)], []); + + my %test_config; + foreach my $type (@types) { + my $prefix = shift @prefixes || [qw(foo bar)]; + $test_config{$type} = catdir(rootdir, @$prefix, @{$ei->prefix_relpaths('site', $type)}); + } + + # Poke at the innards of E::IP to change the default install locations. + my $prefix = catdir('another', 'prefix'); + my $config = ExtUtils::Config->new({ siteprefixexp => catdir(rootdir, 'wierd', 'prefix')}); + $ei = get_ei(install_sets => { site => \%test_config }, config => $config, prefix => $prefix); + + test_prefix($ei, $prefix, \%test_config); +} + +# Check that we can use install_base after setting prefix. +{ + my $install_base = catdir('foo', 'bar'); + my $ei = get_ei(install_base => $install_base, prefix => 'whatever'); + + test_install_destinations($ei, { + lib => catdir($install_base, 'lib', 'perl5'), + arch => catdir($install_base, 'lib', 'perl5', $Config{archname}), + bin => catdir($install_base, 'bin'), + script => catdir($install_base, 'bin'), + bindoc => catdir($install_base, 'man', 'man1'), + libdoc => catdir($install_base, 'man', 'man3'), + binhtml => catdir($install_base, 'html'), + libhtml => catdir($install_base, 'html'), + }); +} + +sub dir_contains { + my ($first, $second) = @_; + # File::Spec doesn't have an easy way to check whether one directory + # is inside another, unfortunately. + + ($first, $second) = map { canonpath($_) } ($first, $second); + my @first_dirs = splitdir($first); + my @second_dirs = splitdir($second); + + return 0 if @second_dirs < @first_dirs; + + my $is_same = ( case_tolerant() ? sub { lc(shift()) eq lc(shift()) } : sub { shift() eq shift() }); + + while (@first_dirs) { + return 0 unless $is_same->(shift @first_dirs, shift @second_dirs); + } + + return 1; +} + + +sub test_prefix { + my ($ei, $prefix, $test_config) = @_; + + local $Test::Builder::Level = $Test::Builder::Level + 1; + + foreach my $type (qw/lib arch bin script bindoc libdoc binhtml libhtml/) { + my $dest = $ei->install_destination($type); + ok dir_contains($prefix, $dest), "$type prefixed"; + + SKIP: { + skip("'$type' not configured", 1) unless $test_config && $test_config->{$type}; + + have_same_ending($dest, $test_config->{$type}, " suffix correctish ($test_config->{$type} + $prefix = $dest)"); + } + } +} + +sub have_same_ending { + my ($dir1, $dir2, $message) = @_; + + $dir1 =~ s{/$}{} if $^O eq 'cygwin'; # remove any trailing slash + my (undef, $dirs1, undef) = splitpath $dir1; + my @dir1 = splitdir $dirs1; + + $dir2 =~ s{/$}{} if $^O eq 'cygwin'; # remove any trailing slash + my (undef, $dirs2, undef) = splitpath $dir2; + my @dir2 = splitdir $dirs2; + + is $dir1[-1], $dir2[-1], $message; +} + +sub test_install_destinations { + my ($build, $expect) = @_; + + local $Test::Builder::Level = $Test::Builder::Level + 1; + + while(my ($type, $expect) = each %$expect) { + is($build->install_destination($type), $expect, "$type destination"); + } +} + +sub test_install_map { + my ($paths, $expect, $case) = @_; + + local $Test::Builder::Level = $Test::Builder::Level + 1; + + my $map = $paths->install_map; + while(my ($type, $expect) = each %$expect) { + is($map->{$type}, $expect, "$type destination for $case"); + } +} diff --git a/t/release-pod-coverage.t b/t/release-pod-coverage.t new file mode 100644 index 0000000..18a8274 --- /dev/null +++ b/t/release-pod-coverage.t @@ -0,0 +1,15 @@ +#!perl + +BEGIN { + unless ($ENV{RELEASE_TESTING}) { + require Test::More; + Test::More::plan(skip_all => 'these tests are for release candidate testing'); + } +} + +# This file was automatically generated by Dist::Zilla::Plugin::PodCoverageTests. + +use Test::Pod::Coverage 1.08; +use Pod::Coverage::TrustPod; + +all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::TrustPod' }); diff --git a/t/release-pod-syntax.t b/t/release-pod-syntax.t new file mode 100644 index 0000000..cdd6a6c --- /dev/null +++ b/t/release-pod-syntax.t @@ -0,0 +1,14 @@ +#!perl + +BEGIN { + unless ($ENV{RELEASE_TESTING}) { + require Test::More; + Test::More::plan(skip_all => 'these tests are for release candidate testing'); + } +} + +# This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. +use Test::More; +use Test::Pod 1.41; + +all_pod_files_ok(); |