⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 20_cpanplus-dist-mm.t

📁 source of perl for linux application,
💻 T
📖 第 1 页 / 共 2 页
字号:
### 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 + -