cpan/CPANPLUS/t/20_CPANPLUS-Dist-MM.t

   1 ### make sure we can find our conf.pl file
   2 BEGIN {
   3     use FindBin;
   4     require "$FindBin::Bin/inc/conf.pl";
   5 }
   6
   7 use strict;
   8
   9 use CPANPLUS::Configure;
  10 use CPANPLUS::Backend;
  11 use CPANPLUS::Dist;
  12 use CPANPLUS::Dist::MM;
  13 use CPANPLUS::Internals::Constants;
  14
  15 use Test::More 'no_plan';
  16 use Cwd;
  17 use Config;
  18 use Data::Dumper;
  19 use File::Basename ();
  20 use File::Spec ();
  21
  22 my $conf    = gimme_conf();
  23 my $cb      = CPANPLUS::Backend->new( $conf );
  24 my $File    = 'Bar.pm';
  25
  26 ### if we need sudo that's no guarantee we can actually run it
  27 ### so set $noperms if sudo is required, as that may mean tests
  28 ### fail if you're not allowed to execute sudo. This resolves
  29 ### #29904: make test should not use sudo
  30 my $noperms = $conf->get_program('sudo')        || #you need sudo
  31               $conf->get_conf('makemakerflags') || #you set some funky flags
  32               not -w $Config{installsitelib};      #cant write to install target
  33
  34 #$IPC::Cmd::DEBUG = $Verbose;
  35
  36 ### Make sure we get the _EUMM_NOXS_ version
  37 my $ModName = TEST_CONF_MODULE;
  38
  39 ### This is the module name that gets /installed/
  40 my $InstName = TEST_CONF_INST_MODULE;
  41
  42 ### don't start sending test reports now... ###
  43 $cb->_callbacks->send_test_report( sub { 0 } );
  44 $conf->set_conf( cpantest => 0 );
  45
  46 ### Redirect errors to file ###
  47 *STDERR = output_handle() unless $conf->get_conf('verbose');
  48
  49 ### dont uncomment this, it screws up where STDOUT goes and makes
  50 ### test::harness create test counter mismatches
  51 #*STDOUT                          = output_handle() unless @ARGV;
  52 ### for the same test-output counter mismatch, we disable verbose
  53 ### mode
  54 $conf->set_conf( allow_build_interactivity => 0 );
  55
  56 ### start with fresh sources ###
  57 ok( $cb->reload_indices( update_source => 0 ),
  58                                 "Rebuilding trees" );
  59
  60 ### we might need this Some Day when we're going to install into
  61 ### our own sandbox dir.. but for now, no dice due to EU::I bug
  62 # $conf->set_program( sudo => '' );
  63 # $conf->set_conf( makemakerflags => TEST_INSTALL_EU_MM_FLAGS );
  64
  65 ### set alternate install dir ###
  66 ### XXX rather pointless, since we can't uninstall them, due to a bug
  67 ### in EU::Installed (6871). And therefor we can't test uninstall() or any of
  68 ### the EU::Installed functions. So, let's just install into sitelib... =/
  69 #my $prefix  = File::Spec->rel2abs( File::Spec->catdir(cwd(),'dummy-perl') );
  70 #my $rv = $cb->configure_object->set_conf( makemakerflags => "PREFIX=$prefix" );
  71 #ok( $rv,                        "Alternate install path set" );
  72
  73 my $Mod     = $cb->module_tree( $ModName );
  74 my $InstMod = $cb->module_tree( $InstName );
  75 ok( $Mod,                       "Loaded object for: " . $Mod->name );
  76 ok( $Mod,                       "Loaded object for: " . $InstMod->name );
  77
  78 ### format_available tests ###
  79 {   ok( CPANPLUS::Dist::MM->format_available,
  80                                 "Format is available" );
  81
  82     ### whitebox test!
  83     {   local $^W;
  84         local *CPANPLUS::Dist::MM::can_load = sub { 0 };
  85         ok(!CPANPLUS::Dist::MM->format_available,
  86                                 "   Making format unavailable" );
  87     }
  88
  89     ### test if the error got logged ok ###
  90     like( CPANPLUS::Error->stack_as_string,
  91           qr/You do not have .+?'CPANPLUS::Dist::MM' not available/s,
  92                                 "   Format failure logged" );
  93
  94     ### flush the stack ###
  95     CPANPLUS::Error->flush;
  96 }
  97
  98 ok( $Mod->fetch,                "Fetching module to ".$Mod->status->fetch );
  99 ok( $Mod->extract,              "Extracting module to ".$Mod->status->extract );
 100
 101 ### test target => 'init'
 102 {   my $dist = $Mod->dist( target => TARGET_INIT );
 103     ok( $dist,                  "Dist created with target => " . TARGET_INIT );
 104     ok( !$dist->status->prepared,
 105                                 "   Prepare was not run" );
 106 }
 107
 108 ok( $Mod->test,                 "Testing module" );
 109
 110 ok( $Mod->status->dist_cpan->status->test,
 111                                 "   Test success registered as status" );
 112 ok( $Mod->status->dist_cpan->status->prepared,
 113                                 "   Prepared status registered" );
 114 ok( $Mod->status->dist_cpan->status->created,
 115                                 "   Created status registered" );
 116 is( $Mod->status->dist_cpan->status->distdir, $Mod->status->extract,
 117                                 "   Distdir status registered properly" );
 118
 119 ### test the convenience methods
 120 ok( $Mod->prepare,              "Preparing module" );
 121 ok( $Mod->create,               "Creating module" );
 122
 123 ok( $Mod->dist,                 "Building distribution" );
 124 ok( $Mod->status->dist_cpan,    "   Dist registered as status" );
 125 isa_ok( $Mod->status->dist_cpan,    "CPANPLUS::Dist::MM" );
 126
 127 ### flush the lib cache
 128 ### otherwise, cpanplus thinks the module's already installed
 129 ### since the blib is already in @INC
 130 $cb->_flush( list => [qw|lib|] );
 131
 132 SKIP: {
 133
 134     skip(q[No install tests under core perl],            10) if $ENV{PERL_CORE};
 135     skip(q[Possibly no permission to install, skipping], 10) if $noperms;
 136
 137     ### we now say 'no perms' if sudo is configured, as per #29904
 138     #diag(q[Note: 'sudo' might ask for your password to do the install test])
 139     #    if $conf->get_program('sudo');
 140
 141     ### make sure no options are set in PERL5_MM_OPT, as they might
 142     ### change the installation target and therefor will 1. mess up
 143     ### the tests and 2. leave an installed copy of our test module
 144     ### lying around. This addresses bug #29716: 20_CPANPLUS-Dist-MM.t
 145     ### fails (and leaves test files installed) when EUMM options
 146     ### include INSTALL_BASE
 147     {   local $ENV{'PERL5_MM_OPT'};
 148
 149         ### add the new dir to the configuration too, so eu::installed tests
 150         ### work as they should
 151         $conf->set_conf( lib => [ TEST_CONF_INSTALL_DIR ] );
 152
 153         ok( $Mod->install(  force           => 1,
 154                             makemakerflags  => 'PREFIX='.TEST_CONF_INSTALL_DIR,
 155                         ),      "Installing module" );
 156     }
 157
 158     ok( $Mod->status->installed,"   Module installed according to status" );
 159
 160
 161     SKIP: {   ### EU::Installed tests ###
 162         ### EU::I sometimes fails. See:
 163         ### #43292: ~/CPANPLUS-0.85_04 fails t/20_CPANPLUS-Dist-MM.t
 164         ### #46890: ExtUtils::Installed + EU::MM PREFIX= don't always work
 165         ### well together
 166         skip( "ExtUtils::Installed issue #46890 prevents these tests from running reliably", 8 );
 167
 168
 169         skip( "Old perl on cygwin detected " .
 170               "-- tests will fail due to known bugs", 8
 171         ) if ON_OLD_CYGWIN;
 172
 173         ### might need it Later when EU::I is fixed..
 174         #local @INC = ( TEST_INSTALL_DIR_LIB, @INC );
 175
 176         {   ### validate
 177             my @missing = $InstMod->validate;
 178
 179             is_deeply( \@missing, [],
 180                                     "No missing files" );
 181         }
 182
 183         {   ### files
 184             my @files = $InstMod->files;
 185
 186             ### number of files may vary from OS to OS
 187             ok( scalar(@files),     "All files accounted for" );
 188             ok( grep( /$File/, @files),
 189                                     "   Found the module" );
 190
 191             ### XXX does this work on all OSs?
 192             #ok( grep( /man/, @files ),
 193             #                        "   Found the manpage" );
 194         }
 195
 196         {   ### packlist
 197             my ($obj) = $InstMod->packlist;
 198             isa_ok( $obj,           "ExtUtils::Packlist" );
 199         }
 200
 201         {   ### directory_tree
 202             my @dirs = $InstMod->directory_tree;
 203             ok( scalar(@dirs),      "Directory tree obtained" );
 204
 205             my $found;
 206             for my $dir (@dirs) {
 207                 ok( -d $dir,        "   Directory exists" );
 208
 209                 my $file = File::Spec->catfile( $dir, $File );
 210                 $found = $file if -e $file;
 211             }
 212
 213             ok( -e $found,          "   Module found" );
 214         }
 215
 216         SKIP: {
 217             skip("Probably no permissions to uninstall", 1)
 218                 if $noperms;
 219
 220             ok( $InstMod->uninstall,"Uninstalling module" );
 221         }
 222     }
 223 }
 224
 225 ### test exceptions in Dist::MM->create ###
 226 {   ok( $Mod->status->mk_flush, "Old status info flushed" );
 227     my $dist = INSTALLER_MM->new( module => $Mod );
 228
 229     ok( $dist,                  "New dist object made" );
 230     ok(!$dist->prepare,         "   Dist->prepare failed" );
 231     like( CPANPLUS::Error->stack_as_string, qr/No dir found to operate on/,
 232                                 "       Failure logged" );
 233
 234     ### manually set the extract dir,
 235     $Mod->status->extract($0);
 236
 237     ok(!$dist->create,          "   Dist->create failed" );
 238     like( CPANPLUS::Error->stack_as_string, qr/not successfully prepared/s,
 239                                 "       Failure logged" );
 240
 241     ### pretend we've been prepared ###
 242     $dist->status->prepared(1);
 243
 244     ok(!$dist->create,          "   Dist->create failed" );
 245     like( CPANPLUS::Error->stack_as_string, qr/Could not chdir/s,
 246                                 "       Failure logged" );
 247 }
 248
 249 ### writemakefile.pl tests ###
 250 {   ### remove old status info
 251     ok( $Mod->status->mk_flush, "Old status info flushed" );
 252     ok( $Mod->fetch,            "Module fetched again" );
 253     ok( $Mod->extract,          "Module extracted again" );
 254
 255     ### cheat and add fake prereqs ###
 256     my $prereq = TEST_CONF_PREREQ;
 257
 258     $Mod->status->prereqs( { $prereq => 0 } );
 259
 260     my $makefile_pl = MAKEFILE_PL->( $Mod->status->extract );
 261     my $makefile    = MAKEFILE->(    $Mod->status->extract );
 262
 263     my $dist        = $Mod->dist;
 264     ok( $dist,                  "Dist object built" );
 265
 266     ### check for a makefile.pl and 'write' one
 267     ok( -s $makefile_pl,        "   Makefile.PL present" );
 268     ok( $dist->write_makefile_pl( force => 0 ),
 269                                 "   Makefile.PL written" );
 270     like( CPANPLUS::Error->stack_as_string, qr/Already created/,
 271                                 "   Prior existance noted" );
 272
 273     ### ok, unlink the makefile.pl, now really write one
 274     1 while unlink $makefile;
 275
 276     ### must do '1 while' for VMS
 277     {   my $unlink_sts = unlink($makefile_pl);
 278         1 while unlink $makefile_pl;
 279         ok( $unlink_sts,        "Deleting Makefile.PL");
 280     }
 281
 282     ok( !-s $makefile_pl,       "   Makefile.PL deleted" );
 283     ok( !-s $makefile,          "   Makefile deleted" );
 284     ok($dist->write_makefile_pl,"   Makefile.PL written" );
 285
 286     ### see if we wrote anything sensible
 287     my $fh = OPEN_FILE->( $makefile_pl );
 288     ok( $fh,                    "Makefile.PL open for read" );
 289
 290     my $str = do { local $/; <$fh> };
 291     like( $str, qr/### Auto-generated .+ by CPANPLUS ###/,
 292                                 "   Autogeneration noted" );
 293     like( $str, '/'. $Mod->module .'/',
 294                                 "   Contains module name" );
 295     like( $str, '/'. quotemeta($Mod->version) . '/',
 296                                 "   Contains version" );
 297     like( $str, '/'. $Mod->author->author .'/',
 298                                 "   Contains author" );
 299     like( $str, '/PREREQ_PM/',  "   Contains prereqs" );
 300     like( $str, qr/$prereq.+0/, "   Contains prereqs" );
 301
 302     close $fh;
 303
 304     ### seems ok, now delete it again and go via install()
 305     ### to see if it picks up on the missing makefile.pl and
 306     ### does the right thing
 307     ### must do '1 while' for VMS
 308     {   my $unlink_sts = unlink($makefile_pl);
 309         1 while unlink $makefile_pl;
 310         ok( $unlink_sts,        "Deleting Makefile.PL");
 311     }
 312     ok( !-s $makefile_pl,       "   Makefile.PL deleted" );
 313     ok( $dist->status->mk_flush,"Dist status flushed" );
 314     ok( $dist->prepare,         "   Dist->prepare run again" );
 315     ok( $dist->create,          "   Dist->create run again" );
 316     ok( -s $makefile_pl,        "   Makefile.PL present" );
 317     like( CPANPLUS::Error->stack_as_string,
 318           qr/attempting to generate one/,
 319                                 "   Makefile.PL generation attempt logged" );
 320
 321     ### now let's throw away the makefile.pl, flush the status and not
 322     ### write a makefile.pl
 323     {   local $^W;
 324         local *CPANPLUS::Dist::MM::write_makefile_pl = sub { 1 };
 325
 326         1 while unlink $makefile_pl;
 327         1 while unlink $makefile;
 328
 329         ok(!-s $makefile_pl,        "Makefile.PL deleted" );
 330         ok(!-s $makefile,           "Makefile deleted" );
 331         ok( $dist->status->mk_flush,"Dist status flushed" );
 332         ok(!$dist->prepare,         "   Dist->prepare failed" );
 333         like( CPANPLUS::Error->stack_as_string,
 334               qr/Could not find 'Makefile.PL'/i,
 335                                     "   Missing Makefile.PL noted" );
 336         is( $dist->status->makefile, 0,
 337                                     "   Did not manage to create Makefile" );
 338     }
 339
 340     ### now let's write a makefile.pl that just does 'die'
 341     {   local $^W;
 342         local *CPANPLUS::Dist::MM::write_makefile_pl =
 343             __PACKAGE__->_custom_makefile_pl_sub( "exit 1;" );
 344
 345         ### there's no makefile.pl now, since the previous test failed
 346         ### to create one
 347         #ok( -e $makefile_pl,        "Makefile.PL exists" );
 348         #ok( unlink($makefile_pl),   "   Deleting Makefile.PL");
 349         ok(!-s $makefile_pl,        "Makefile.PL deleted" );
 350         ok( $dist->status->mk_flush,"Dist status flushed" );
 351         ok(!$dist->prepare,         "   Dist->prepare failed" );
 352         like( CPANPLUS::Error->stack_as_string, qr/Could not run/s,
 353                                     "   Logged failed 'perl Makefile.PL'" );
 354         is( $dist->status->makefile, 0,
 355                                     "   Did not manage to create Makefile" );
 356     }
 357
 358     ### clean up afterwards ###
 359     ### must do '1 while' for VMS
 360     {   my $unlink_sts = unlink($makefile_pl);
 361         1 while unlink $makefile_pl;
 362         ok( $unlink_sts,        "Deleting Makefile.PL");
 363     }
 364
 365     $dist->status->mk_flush;
 366 }
 367
 368 ### test ENV setting in Makefile.PL
 369 {   ### use print() not die() -- we're redirecting STDERR in tests!
 370     my $env     = ENV_CPANPLUS_IS_EXECUTING;
 371     my $sub     = __PACKAGE__->_custom_makefile_pl_sub(
 372                                     "print qq[ENV=\$ENV{$env}\n]; exit 1;" );
 373
 374     my $clone   = $Mod->clone;
 375     $clone->status->fetch( $Mod->status->fetch );
 376
 377     ok( $clone,                 'Testing ENV settings $dist->prepare' );
 378     ok( $clone->extract,        '   Files extracted' );
 379     ok( $clone->prepare,        '   $mod->prepare worked first time' );
 380
 381     my $dist        = $clone->status->dist;
 382     my $makefile_pl = MAKEFILE_PL->( $clone->status->extract );
 383
 384     ok( $sub->($dist),          "   Custom Makefile.PL written" );
 385     ok( -e $makefile_pl,        "       File exists" );
 386
 387     ### clear errors
 388     CPANPLUS::Error->flush;
 389
 390     my $rv = $dist->prepare( force => 1, verbose => 0 );
 391     ok( !$rv,                   '   $dist->prepare failed' );
 392
 393     SKIP: {
 394         skip( "Can't test ENV{$env} -- no buffers available", 1 )
 395             unless IPC::Cmd->can_capture_buffer;
 396
 397         my $re = quotemeta( $makefile_pl );
 398         like( CPANPLUS::Error->stack_as_string, qr/ENV=$re/,
 399                                 "   \$ENV $env set correctly during execution");
 400     }
 401
 402     ### and the ENV var should no longer be set now
 403     ok( !$ENV{$env},            "   ENV var now unset" );
 404 }
 405
 406 sub _custom_makefile_pl_sub {
 407     my $pkg = shift;
 408     my $txt = shift or return;
 409
 410     return sub {
 411         my $dist = shift;
 412         my $self = $dist->parent;
 413         my $fh   = OPEN_FILE->(
 414                     MAKEFILE_PL->($self->status->extract), '>' );
 415         print $fh $txt;
 416         close $fh;
 417
 418         return 1;
 419     }
 420 }
 421
 422
 423 # Local variables:
 424 # c-indentation-style: bsd
 425 # c-basic-offset: 4
 426 # indent-tabs-mode: nil
 427 # End:
 428 # vim: expandtab shiftwidth=4:
 429
 430