📄 20_cpanplus-dist-mm.t
字号:
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 + -