lib/Module/Build/t/compat.t

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
   5 use MBTest;
   6 use File::Spec;
   7 use IO::File;
   8 use Config;
   9
  10 # Don't let our own verbosity/test_file get mixed up with our subprocess's
  11 my @makefile_keys = qw(TEST_VERBOSE HARNESS_VERBOSE TEST_FILES MAKEFLAGS);
  12 local  @ENV{@makefile_keys};
  13 delete @ENV{@makefile_keys};
  14
  15 my @makefile_types = qw(small passthrough traditional);
  16 my $tests_per_type = 15;
  17
  18 #find_in_path does not understand VMS.
  19
  20 if ( $Config{make} && $^O ne 'VMS' ? find_in_path($Config{make}) : 1 ) {
  21     plan tests => 34 + @makefile_types*$tests_per_type*2;
  22 } else {
  23     plan skip_all => "Don't know how to invoke 'make'";
  24 }
  25
  26 my $is_vms_mms = ($^O eq 'VMS') && ($Config{make} =~ /MM[SK]/i);
  27
  28 use_ok 'Module::Build';
  29 ensure_blib('Module::Build');
  30
  31
  32 #########################
  33
  34 my $tmp = MBTest->tmpdir;
  35
  36 # Create test distribution; set requires and build_requires
  37 use DistGen;
  38 my $dist = DistGen->new( dir => $tmp );
  39 $dist->regen;
  40
  41 $dist->chdir_in;
  42
  43
  44 #########################
  45
  46 use Module::Build;
  47 use Module::Build::Compat;
  48
  49 use Carp;  $SIG{__WARN__} = \&Carp::cluck;
  50
  51 my @make = $Config{make} eq 'nmake' ? ('nmake', '-nologo') : ($Config{make});
  52
  53 my $makefile = 'Makefile';
  54
  55 # VMS MMK/MMS by convention use Descrip.MMS
  56 if ($is_vms_mms) {
  57     $makefile = 'Descrip.MMS';
  58 }
  59
  60
  61 #########################
  62
  63 # Test without requires
  64
  65 test_makefile_types();
  66
  67 # Test with requires
  68
  69 my $distname = $dist->name;
  70 $dist->change_build_pl({
  71   module_name         => $distname,
  72   license             => 'perl',
  73   requires            => {
  74     'perl'        => $],
  75     'File::Spec'  => 0,
  76   },
  77   build_requires      => {
  78     'Test::More'  => 0,
  79   },
  80 });
  81
  82 $dist->regen;
  83
  84 test_makefile_types( requires => {
  85     'perl' => $],
  86     'File::Spec' => 0,
  87     'Test::More' => 0,
  88 });
  89
  90 ######################
  91
  92 $dist->change_build_pl({
  93   module_name         => $distname,
  94   license             => 'perl',
  95 });
  96 $dist->regen;
  97
  98 # Create M::B instance but don't pollute STDOUT
  99 my $mb;
 100 stdout_of( sub {
 101     $mb = Module::Build->new_from_context;
 102 });
 103 ok $mb, "Module::Build->new_from_context";
 104
 105
 106 {
 107   # Make sure fake_makefile() can run without 'build_class', as it may be
 108   # in older-generated Makefile.PLs
 109   my $warning = '';
 110   local $SIG{__WARN__} = sub { $warning = shift; };
 111
 112   my $maketext = eval { Module::Build::Compat->fake_makefile(makefile => $makefile) };
 113   is $@, '', "fake_makefile lived";
 114   like $maketext, qr/^realclean/m, "found 'realclean' in fake_makefile output";
 115   like $warning, qr/build_class/, "saw warning about 'build_class'";
 116 }
 117
 118 {
 119   # Make sure custom builder subclass is used in the created
 120   # Makefile.PL - make sure it fails in the right way here.
 121   local @Foo::Builder::ISA = qw(Module::Build);
 122   my $foo_builder;
 123   stdout_of( sub {
 124     $foo_builder = Foo::Builder->new_from_context;
 125   });
 126   foreach my $style ('passthrough', 'small') {
 127     Module::Build::Compat->create_makefile_pl($style, $foo_builder);
 128     ok -e 'Makefile.PL', "$style Makefile.PL created";
 129
 130     # Should fail with "can't find Foo/Builder.pm"
 131     my $result;
 132     my ($stdout, $stderr ) = stdout_stderr_of (sub {
 133       $result = $mb->run_perl_script('Makefile.PL');
 134     });
 135     ok ! $result, "Makefile.PL failed";
 136     like $stderr, qr{Foo/Builder.pm}, "custom builder wasn't found";
 137   }
 138
 139   # Now make sure it can actually work.
 140   my $bar_builder;
 141   stdout_of( sub {
 142     $bar_builder = Module::Build->subclass( class => 'Bar::Builder' )->new_from_context;
 143   });
 144   foreach my $style ('passthrough', 'small') {
 145     Module::Build::Compat->create_makefile_pl($style, $bar_builder);
 146     ok -e 'Makefile.PL', "$style Makefile.PL created via subclass";
 147     my $result;
 148     stdout_of( sub {
 149       $result = $mb->run_perl_script('Makefile.PL');
 150     });
 151     ok $result, "Makefile.PL ran without error";
 152   }
 153 }
 154
 155 {
 156   # Make sure various Makefile.PL arguments are supported
 157   Module::Build::Compat->create_makefile_pl('passthrough', $mb);
 158
 159   my $libdir = File::Spec->catdir( $tmp, 'libdir' );
 160   my $result;
 161   stdout_of( sub {
 162     $result = $mb->run_perl_script('Makefile.PL', [],
 163       [
 164       "LIB=$libdir",
 165       'TEST_VERBOSE=1',
 166       'INSTALLDIRS=perl',
 167       'POLLUTE=1',
 168       ]
 169     );
 170   });
 171   ok $result, "passthrough Makefile.PL ran with arguments";
 172   ok -e 'Build.PL', "Build.PL generated";
 173
 174   my $new_build = Module::Build->resume();
 175   is $new_build->installdirs, 'core', "installdirs is core";
 176   is $new_build->verbose, 1, "tests set for verbose";
 177   is $new_build->install_destination('lib'), $libdir, "custom libdir";
 178   is $new_build->extra_compiler_flags->[0], '-DPERL_POLLUTE', "PERL_POLLUTE set";
 179
 180   # Make sure those switches actually had an effect
 181   my ($ran_ok, $output);
 182   $output = stdout_of( sub { $ran_ok = $new_build->do_system(@make, 'test') } );
 183   ok $ran_ok, "make test ran without error";
 184   $output =~ s/^/# /gm;  # Don't confuse our own test output
 185   like $output, qr/(?:# ok \d+\s+)+/, 'Should be verbose';
 186
 187   # Make sure various Makefile arguments are supported
 188   my $make_macro = 'TEST_VERBOSE=0';
 189
 190   # VMS MMK/MMS macros use different syntax.
 191   if ($is_vms_mms) {
 192     $make_macro = '/macro=("' . $make_macro . '")';
 193   }
 194
 195   $output = stdout_of( sub {
 196     $ran_ok = $mb->do_system(@make, 'test', $make_macro)
 197   } );
 198
 199   ok $ran_ok, "make test without verbose ran ok";
 200   $output =~ s/^/# /gm;  # Don't confuse our own test output
 201   like $output,
 202        qr/# .+basic(\.t)?[.\s#]+ok[.\s#]+All tests successful/,
 203        'Should be non-verbose';
 204
 205   (my $libdir2 = $libdir) =~ s/libdir/lbiidr/;
 206   my @make_args = ('INSTALLDIRS=vendor', "INSTALLVENDORLIB=$libdir2");
 207
 208   if ($is_vms_mms) { # VMS MMK/MMS macros use different syntax.
 209     $make_args[0] = '/macro=("' . join('","',@make_args) . '")';
 210     pop @make_args while scalar(@make_args) > 1;
 211   }
 212   ($output) = stdout_stderr_of(
 213     sub {
 214       $ran_ok = $mb->do_system(@make, 'fakeinstall', @make_args);
 215     }
 216   );
 217
 218   ok $ran_ok, "make fakeinstall with INSTALLDIRS=vendor ran ok";
 219   $output =~ s/^/# /gm;  # Don't confuse our own test output
 220   like $output,
 221        qr/\Q$libdir2\E .* Simple\.pm/x,
 222        'Should have installdirs=vendor';
 223
 224   stdout_of( sub { $mb->do_system(@make, 'realclean'); } );
 225   ok ! -e $makefile, "$makefile shouldn't exist";
 226
 227   1 while unlink 'Makefile.PL';
 228   ok ! -e 'Makefile.PL', "Makefile.PL cleaned up";
 229
 230   1 while unlink $libdir, $libdir2;
 231 }
 232
 233 { # Make sure tilde-expansion works
 234
 235   # C<glob> on MSWin32 uses $ENV{HOME} if defined to do tilde-expansion
 236   local $ENV{HOME} = 'C:/' if $^O =~ /MSWin/ && !exists( $ENV{HOME} );
 237
 238   Module::Build::Compat->create_makefile_pl('passthrough', $mb);
 239
 240   stdout_of( sub {
 241     $mb->run_perl_script('Makefile.PL', [], ['INSTALL_BASE=~/foo']);
 242   });
 243   my $b2 = Module::Build->current;
 244   ok $b2->install_base, "install_base set";
 245   unlike $b2->install_base, qr/^~/, "Tildes should be expanded";
 246
 247   stdout_of( sub { $mb->do_system(@make, 'realclean'); } );
 248   ok ! -e $makefile, "$makefile shouldn't exist";
 249
 250   1 while unlink 'Makefile.PL';
 251   ok ! -e 'Makefile.PL', "Makefile.PL cleaned up";
 252 }
 253
 254 # cleanup
 255 $dist->remove;
 256
 257 #########################################################
 258
 259 sub test_makefile_types {
 260   my %opts = @_;
 261   $opts{requires} ||= {};
 262
 263   foreach my $type (@makefile_types) {
 264     # Create M::B instance
 265     my $mb;
 266     stdout_of( sub {
 267         $mb = Module::Build->new_from_context;
 268     });
 269     ok $mb, "Module::Build->new_from_context";
 270
 271     # Create and test Makefile.PL
 272     Module::Build::Compat->create_makefile_pl($type, $mb);
 273     ok -e 'Makefile.PL', "$type Makefile.PL created";
 274     test_makefile_pl_requires_perl( $opts{requires}{perl} );
 275     test_makefile_creation($mb);
 276     test_makefile_prereq_pm( $opts{requires} );
 277
 278     my ($output,$success);
 279     # Capture output to keep our STDOUT clean
 280     $output = stdout_of( sub {
 281       $success = $mb->do_system(@make);
 282     });
 283     ok $success, "make ran without error";
 284
 285     # Can't let 'test' STDOUT go to our STDOUT, or it'll confuse Test::Harness.
 286     $output = stdout_of( sub {
 287       $success = $mb->do_system(@make, 'test');
 288     });
 289     ok $success, "make test ran without error";
 290     like uc $output, qr{DONE\.|SUCCESS}, "make test output indicated success";
 291
 292     $output = stdout_of( sub {
 293       $success = $mb->do_system(@make, 'realclean');
 294     });
 295     ok $success, "make realclean ran without error";
 296
 297     # Try again with some Makefile.PL arguments
 298     test_makefile_creation($mb, [], 'INSTALLDIRS=vendor', 1);
 299
 300     1 while unlink 'Makefile.PL';
 301     ok ! -e 'Makefile.PL', "cleaned up Makefile";
 302   }
 303 }
 304
 305 sub test_makefile_creation {
 306   my ($build, $preargs, $postargs, $cleanup) = @_;
 307
 308   my ($output, $result);
 309   # capture output to avoid polluting our test output
 310   $output = stdout_of( sub {
 311       $result = $build->run_perl_script('Makefile.PL', $preargs, $postargs);
 312   });
 313   my $label = "Makefile.PL ran without error";
 314   if ( defined $postargs && length $postargs ) {
 315     $label .= " (postargs: $postargs)";
 316   }
 317   ok $result, $label;
 318   ok -e $makefile, "$makefile exists";
 319
 320   if ($cleanup) {
 321     $output = stdout_of( sub {
 322       $build->do_system(@make, 'realclean');
 323     });
 324     ok ! -e '$makefile', "$makefile cleaned up";
 325   }
 326   else {
 327     pass '(skipping cleanup)'; # keep test count constant
 328   }
 329 }
 330
 331 sub test_makefile_prereq_pm {
 332   my %requires = %{ $_[0] };
 333   delete $requires{perl}; # until EU::MM supports this
 334   SKIP: {
 335     skip "$makefile not found", 1 unless -e $makefile;
 336     my $prereq_pm = find_makefile_prereq_pm();
 337     is_deeply $prereq_pm, \%requires,
 338       "$makefile has correct PREREQ_PM line";
 339   }
 340 }
 341
 342 sub test_makefile_pl_requires_perl {
 343   my $perl_version = shift || q{};
 344   SKIP: {
 345     skip 'Makefile.PL not found', 1 unless -e 'Makefile.PL';
 346     my $file_contents = slurp 'Makefile.PL';
 347     my $found_requires = $file_contents =~ m{^require $perl_version;}ms;
 348     if (length $perl_version) {
 349       ok $found_requires, "Makefile.PL has 'require $perl_version;'"
 350         or diag "Makefile.PL:\n$file_contents";
 351     }
 352     else {
 353       ok ! $found_requires, "Makefile.PL does not require a perl version";
 354     }
 355   }
 356 }
 357
 358 # Following subroutine adapted from code in CPAN.pm
 359 # by Andreas Koenig and A. Speer.
 360 sub find_makefile_prereq_pm {
 361   my $fh = IO::File->new( $makefile, 'r' )
 362     or die "Can't read $makefile: $!";
 363   my $req = {};
 364   local($/) = "\n";
 365   while (<$fh>) {
 366     # locate PREREQ_PM
 367     last if /MakeMaker post_initialize section/;
 368     my($p) = m{^[\#]
 369       \s+PREREQ_PM\s+=>\s+(.+)
 370     }x;
 371     next unless $p;
 372
 373     # extract modules
 374     while ( $p =~ m/(?:\s)([\w\:]+)=>(q\[.*?\]|undef),?/g ){
 375       my($m,$n) = ($1,$2);
 376       if ($n =~ /^q\[(.*?)\]$/) {
 377         $n = $1;
 378       }
 379       $req->{$m} = $n;
 380     }
 381     last;
 382   }
 383   return $req;
 384 }