📄 20_cpanplus-dist-mm.t
字号:
### make sure we can find our conf.pl fileBEGIN { use FindBin; require "$FindBin::Bin/inc/conf.pl";}use strict;use CPANPLUS::Configure;use CPANPLUS::Backend;use CPANPLUS::Dist;use CPANPLUS::Dist::MM;use CPANPLUS::Internals::Constants;use Test::More 'no_plan';use Cwd;use Config;use Data::Dumper;use File::Basename ();use File::Spec ();my $conf = gimme_conf();my $cb = CPANPLUS::Backend->new( $conf );my $File = 'Bar.pm';my $Verbose = @ARGV ? 1 : 0;### if we need sudo that's no guarantee we can actually run it### so set $noperms if sudo is required, as that may mean tests### fail if you're not allowed to execute sudo. This resolves### #29904: make test should not use sudomy $noperms = $conf->get_program('sudo') || #you need sudo $conf->get_conf('makemakerflags') || #you set some funky flags not -w $Config{installsitelib}; #cant write to install target#$IPC::Cmd::DEBUG = $Verbose;### Make sure we get the _EUMM_NOXS_ versionmy $ModName = TEST_CONF_MODULE;### This is the module name that gets /installed/my $InstName = TEST_CONF_INST_MODULE;### don't start sending test reports now... ###$cb->_callbacks->send_test_report( sub { 0 } );$conf->set_conf( cpantest => 0 );### Redirect errors to file ###*STDERR = output_handle() unless $Verbose;### dont uncomment this, it screws up where STDOUT goes and makes### test::harness create test counter mismatches#*STDOUT = output_handle() unless @ARGV;### for the same test-output counter mismatch, we disable verbose### mode$conf->set_conf( verbose => $Verbose );$conf->set_conf( allow_build_interactivity => 0 );### start with fresh sources ###ok( $cb->reload_indices( update_source => 0 ), "Rebuilding trees" );### we might need this Some Day when we're going to install into### our own sandbox dir.. but for now, no dice due to EU::I bug# $conf->set_program( sudo => '' );# $conf->set_conf( makemakerflags => TEST_INSTALL_EU_MM_FLAGS );### set alternate install dir ###### XXX rather pointless, since we can't uninstall them, due to a bug### in EU::Installed (6871). And therefor we can't test uninstall() or any of### the EU::Installed functions. So, let's just install into sitelib... =/#my $prefix = File::Spec->rel2abs( File::Spec->catdir(cwd(),'dummy-perl') );#my $rv = $cb->configure_object->set_conf( makemakerflags => "PREFIX=$prefix" );#ok( $rv, "Alternate install path set" );my $Mod = $cb->module_tree( $ModName );my $InstMod = $cb->module_tree( $InstName );ok( $Mod, "Loaded object for: " . $Mod->name );ok( $Mod, "Loaded object for: " . $InstMod->name );### format_available tests ###{ ok( CPANPLUS::Dist::MM->format_available, "Format is available" ); ### whitebox test! { local $^W; local *CPANPLUS::Dist::MM::can_load = sub { 0 }; ok(!CPANPLUS::Dist::MM->format_available, " Making format unavailable" ); } ### test if the error got logged ok ### like( CPANPLUS::Error->stack_as_string, qr/You do not have .+?'CPANPLUS::Dist::MM' not available/s, " Format failure logged" ); ### flush the stack ### CPANPLUS::Error->flush;}ok( $Mod->fetch, "Fetching module to ".$Mod->status->fetch );ok( $Mod->extract, "Extracting module to ".$Mod->status->extract );ok( $Mod->test, "Testing module" );ok( $Mod->status->dist_cpan->status->test, " Test success registered as status" );ok( $Mod->status->dist_cpan->status->prepared, " Prepared status registered" );ok( $Mod->status->dist_cpan->status->created, " Created status registered" );is( $Mod->status->dist_cpan->status->distdir, $Mod->status->extract, " Distdir status registered properly" );### test the convenience methodsok( $Mod->prepare, "Preparing module" );ok( $Mod->create, "Creating module" );ok( $Mod->dist, "Building distribution" );ok( $Mod->status->dist_cpan, " Dist registered as status" );isa_ok( $Mod->status->dist_cpan, "CPANPLUS::Dist::MM" );### flush the lib cache### otherwise, cpanplus thinks the module's already installed### since the blib is already in @INC$cb->_flush( list => [qw|lib|] );SKIP: { skip(q[No install tests under core perl], 10) if $ENV{PERL_CORE}; skip(q[Possibly no permission to install, skipping], 10) if $noperms; ### XXX new EU::I should be forthcoming pending this patch from Steffen ### Mueller on p5p: http://www.xray.mpe.mpg.de/mailing-lists/ \ ### perl5-porters/2007-01/msg00895.html ### This should become EU::I 1.42.. if so, we should upgrade this bit of ### code and remove the diag, since we can then install in our dummy dir.. diag("\nSorry, installing into your real perl dir, rather than our test"); diag("area since ExtUtils::Installed does not probe for .packlists in " ); diag('other dirs than those in %Config. See bug #6871 on rt.cpan.org ' ); diag('for details'); ### we now say 'no perms' if sudo is configured, as per #29904 #diag(q[Note: 'sudo' might ask for your password to do the install test]) # if $conf->get_program('sudo'); ### make sure no options are set in PERL5_MM_OPT, as they might ### change the installation target and therefor will 1. mess up ### the tests and 2. leave an installed copy of our test module ### lying around. This addresses bug #29716: 20_CPANPLUS-Dist-MM.t ### fails (and leaves test files installed) when EUMM options ### include INSTALL_BASE { local $ENV{'PERL5_MM_OPT'}; ok( $Mod->install( force =>1 ), "Installing module" ); } ok( $Mod->status->installed," Module installed according to status" ); SKIP: { ### EU::Installed tests ### skip("makemakerflags set -- probably EU::Installed tests will fail", 8) if $conf->get_conf('makemakerflags'); skip( "Old perl on cygwin detected " . "-- tests will fail due to known bugs", 8 ) if ON_OLD_CYGWIN; ### might need it Later when EU::I is fixed.. #local @INC = ( TEST_INSTALL_DIR_LIB, @INC ); { ### validate my @missing = $InstMod->validate; is_deeply( \@missing, [], "No missing files" ); } { ### files my @files = $InstMod->files; ### number of files may vary from OS to OS ok( scalar(@files), "All files accounted for" ); ok( grep( /$File/, @files), " Found the module" ); ### XXX does this work on all OSs? #ok( grep( /man/, @files ), # " Found the manpage" ); } { ### packlist my ($obj) = $InstMod->packlist; isa_ok( $obj, "ExtUtils::Packlist" ); } { ### directory_tree my @dirs = $InstMod->directory_tree; ok( scalar(@dirs), "Directory tree obtained" ); my $found; for my $dir (@dirs) { ok( -d $dir, " Directory exists" ); my $file = File::Spec->catfile( $dir, $File ); $found = $file if -e $file; } ok( -e $found, " Module found" ); } SKIP: { skip("Probably no permissions to uninstall", 1) if $noperms;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -