### make sure we can find our conf.pl file BEGIN { 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'; ### 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 sudo my $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_ version my $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 $conf->get_conf('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( 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 ); ### test target => 'init' { my $dist = $Mod->dist( target => TARGET_INIT ); ok( $dist, "Dist created with target => " . TARGET_INIT ); ok( !$dist->status->prepared, " Prepare was not run" ); } 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 methods ok( $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; ### 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'}; local $ENV{'PERL_MM_OPT'}; ### add the new dir to the configuration too, so eu::installed tests ### work as they should $conf->set_conf( lib => [ TEST_CONF_INSTALL_DIR ] ); ok( $Mod->install( force => 1, makemakerflags => 'PREFIX='.TEST_CONF_INSTALL_DIR, ), "Installing module" ); } ok( $Mod->status->installed," Module installed according to status" ); SKIP: { ### EU::Installed tests ### ### EU::I sometimes fails. See: ### #43292: ~/CPANPLUS-0.85_04 fails t/20_CPANPLUS-Dist-MM.t ### #46890: ExtUtils::Installed + EU::MM PREFIX= don't always work ### well together skip( "ExtUtils::Installed issue #46890 prevents these tests from running reliably", 8 ); 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; ok( $InstMod->uninstall,"Uninstalling module" ); } } } ### test exceptions in Dist::MM->create ### { ok( $Mod->status->mk_flush, "Old status info flushed" ); my $dist = INSTALLER_MM->new( module => $Mod ); 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 existence 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: