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

📄 20_cpanplus-dist-mm.t

📁 source of perl for linux application,
💻 T
📖 第 1 页 / 共 2 页
字号:
            ok( $InstMod->uninstall,"Uninstalling module" );        }    }}### test exceptions in Dist::MM->create ###{   ok( $Mod->status->mk_flush, "Old status info flushed" );    my $dist = CPANPLUS::Dist->new( module => $Mod,                                    format => INSTALLER_MM );    ok( $dist,                  "New dist object made" );    ok(!$dist->prepare,         "   Dist->prepare failed" );    like( CPANPLUS::Error->stack_as_string, qr/No dir found to operate on/,                                "       Failure logged" );    ### manually set the extract dir,    $Mod->status->extract($0);    ok(!$dist->create,          "   Dist->create failed" );    like( CPANPLUS::Error->stack_as_string, qr/not successfully prepared/s,                                "       Failure logged" );    ### pretend we've been prepared ###    $dist->status->prepared(1);    ok(!$dist->create,          "   Dist->create failed" );    like( CPANPLUS::Error->stack_as_string, qr/Could not chdir/s,                                "       Failure logged" );}### writemakefile.pl tests ###{   ### remove old status info    ok( $Mod->status->mk_flush, "Old status info flushed" );    ok( $Mod->fetch,            "Module fetched again" );    ok( $Mod->extract,          "Module extracted again" );    ### cheat and add fake prereqs ###    my $prereq = TEST_CONF_PREREQ;    $Mod->status->prereqs( { $prereq => 0 } );    my $makefile_pl = MAKEFILE_PL->( $Mod->status->extract );    my $makefile    = MAKEFILE->(    $Mod->status->extract );    my $dist        = $Mod->dist;    ok( $dist,                  "Dist object built" );    ### check for a makefile.pl and 'write' one    ok( -s $makefile_pl,        "   Makefile.PL present" );    ok( $dist->write_makefile_pl( force => 0 ),                                "   Makefile.PL written" );    like( CPANPLUS::Error->stack_as_string, qr/Already created/,                                "   Prior existance noted" );    ### ok, unlink the makefile.pl, now really write one    1 while unlink $makefile;    ### must do '1 while' for VMS    {   my $unlink_sts = unlink($makefile_pl);        1 while unlink $makefile_pl;        ok( $unlink_sts,        "Deleting Makefile.PL");    }    ok( !-s $makefile_pl,       "   Makefile.PL deleted" );    ok( !-s $makefile,          "   Makefile deleted" );    ok($dist->write_makefile_pl,"   Makefile.PL written" );    ### see if we wrote anything sensible    my $fh = OPEN_FILE->( $makefile_pl );    ok( $fh,                    "Makefile.PL open for read" );    my $str = do { local $/; <$fh> };    like( $str, qr/### Auto-generated .+ by CPANPLUS ###/,                                "   Autogeneration noted" );    like( $str, '/'. $Mod->module .'/',                                "   Contains module name" );    like( $str, '/'. quotemeta($Mod->version) . '/',                                "   Contains version" );    like( $str, '/'. $Mod->author->author .'/',                                "   Contains author" );    like( $str, '/PREREQ_PM/',  "   Contains prereqs" );    like( $str, qr/$prereq.+0/, "   Contains prereqs" );    close $fh;    ### seems ok, now delete it again and go via install()    ### to see if it picks up on the missing makefile.pl and    ### does the right thing    ### must do '1 while' for VMS    {   my $unlink_sts = unlink($makefile_pl);        1 while unlink $makefile_pl;        ok( $unlink_sts,        "Deleting Makefile.PL");    }        ok( !-s $makefile_pl,       "   Makefile.PL deleted" );    ok( $dist->status->mk_flush,"Dist status flushed" );    ok( $dist->prepare,         "   Dist->prepare run again" );    ok( $dist->create,          "   Dist->create run again" );    ok( -s $makefile_pl,        "   Makefile.PL present" );    like( CPANPLUS::Error->stack_as_string,          qr/attempting to generate one/,                                "   Makefile.PL generation attempt logged" );    ### now let's throw away the makefile.pl, flush the status and not    ### write a makefile.pl    {   local $^W;        local *CPANPLUS::Dist::MM::write_makefile_pl = sub { 1 };        1 while unlink $makefile_pl;        1 while unlink $makefile;        ok(!-s $makefile_pl,        "Makefile.PL deleted" );        ok(!-s $makefile,           "Makefile deleted" );        ok( $dist->status->mk_flush,"Dist status flushed" );        ok(!$dist->prepare,         "   Dist->prepare failed" );        like( CPANPLUS::Error->stack_as_string,              qr/Could not find 'Makefile.PL'/i,                                    "   Missing Makefile.PL noted" );        is( $dist->status->makefile, 0,                                    "   Did not manage to create Makefile" );    }    ### now let's write a makefile.pl that just does 'die'    {   local $^W;        local *CPANPLUS::Dist::MM::write_makefile_pl =             __PACKAGE__->_custom_makefile_pl_sub( "exit 1;" );        ### there's no makefile.pl now, since the previous test failed        ### to create one        #ok( -e $makefile_pl,        "Makefile.PL exists" );        #ok( unlink($makefile_pl),   "   Deleting Makefile.PL");        ok(!-s $makefile_pl,        "Makefile.PL deleted" );        ok( $dist->status->mk_flush,"Dist status flushed" );        ok(!$dist->prepare,         "   Dist->prepare failed" );        like( CPANPLUS::Error->stack_as_string, qr/Could not run/s,                                    "   Logged failed 'perl Makefile.PL'" );        is( $dist->status->makefile, 0,                                    "   Did not manage to create Makefile" );    }    ### clean up afterwards ###    ### must do '1 while' for VMS    {   my $unlink_sts = unlink($makefile_pl);        1 while unlink $makefile_pl;        ok( $unlink_sts,        "Deleting Makefile.PL");    }           $dist->status->mk_flush;}### test ENV setting in Makefile.PL{   ### use print() not die() -- we're redirecting STDERR in tests!    my $env     = ENV_CPANPLUS_IS_EXECUTING;    my $sub     = __PACKAGE__->_custom_makefile_pl_sub(                                    "print qq[ENV=\$ENV{$env}\n]; exit 1;" );        my $clone   = $Mod->clone;    $clone->status->fetch( $Mod->status->fetch );        ok( $clone,                 'Testing ENV settings $dist->prepare' );    ok( $clone->extract,        '   Files extracted' );    ok( $clone->prepare,        '   $mod->prepare worked first time' );        my $dist        = $clone->status->dist;    my $makefile_pl = MAKEFILE_PL->( $clone->status->extract );    ok( $sub->($dist),          "   Custom Makefile.PL written" );    ok( -e $makefile_pl,        "       File exists" );    ### clear errors        CPANPLUS::Error->flush;    my $rv = $dist->prepare( force => 1, verbose => 0 );    ok( !$rv,                   '   $dist->prepare failed' );    SKIP: {        skip( "Can't test ENV{$env} -- no buffers available", 1 )            unless IPC::Cmd->can_capture_buffer;        my $re = quotemeta( $makefile_pl );        like( CPANPLUS::Error->stack_as_string, qr/ENV=$re/,                                "   \$ENV $env set correctly during execution");    }    ### and the ENV var should no longer be set now    ok( !$ENV{$env},            "   ENV var now unset" );}    sub _custom_makefile_pl_sub {    my $pkg = shift;    my $txt = shift or return;        return sub {        my $dist = shift;         my $self = $dist->parent;        my $fh   = OPEN_FILE->(                    MAKEFILE_PL->($self->status->extract), '>' );        print $fh $txt;        close $fh;            return 1;    }}# Local variables:# c-indentation-style: bsd# c-basic-offset: 4# indent-tabs-mode: nil# End:# vim: expandtab shiftwidth=4:

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -