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 'no_plan';
  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 and PL_files
  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   PL_files            => { 'foo.PL' => 'foo' },
  81 });
  82
  83 $dist->add_file("foo.PL", <<'END');
  84 open my $fh, ">$ARGV[0]" or die $!;
  85 print $fh "foo\n";
  86 END
  87
  88 $dist->regen;
  89
  90 test_makefile_types(
  91     requires => {
  92         'perl' => $],
  93         'File::Spec' => 0,
  94         'Test::More' => 0,
  95     },
  96     PL_files => {
  97         'foo.PL' => 'foo',
  98     },
  99 );
 100
 101 ######################
 102
 103 $dist->change_build_pl({
 104   module_name         => $distname,
 105   license             => 'perl',
 106 });
 107 $dist->regen;
 108
 109 # Create M::B instance but don't pollute STDOUT
 110 my $mb;
 111 stdout_of( sub {
 112     $mb = Module::Build->new_from_context;
 113 });
 114 ok $mb, "Module::Build->new_from_context";
 115
 116
 117 {
 118   # Make sure fake_makefile() can run without 'build_class', as it may be
 119   # in older-generated Makefile.PLs
 120   my $warning = '';
 121   local $SIG{__WARN__} = sub { $warning = shift; };
 122
 123   my $maketext = eval { Module::Build::Compat->fake_makefile(makefile => $makefile) };
 124   is $@, '', "fake_makefile lived";
 125   like $maketext, qr/^realclean/m, "found 'realclean' in fake_makefile output";
 126   like $warning, qr/build_class/, "saw warning about 'build_class'";
 127 }
 128
 129 {
 130   # Make sure custom builder subclass is used in the created
 131   # Makefile.PL - make sure it fails in the right way here.
 132   local @Foo::Builder::ISA = qw(Module::Build);
 133   my $foo_builder;
 134   stdout_of( sub {
 135     $foo_builder = Foo::Builder->new_from_context;
 136   });
 137   foreach my $style ('passthrough', 'small') {
 138     Module::Build::Compat->create_makefile_pl($style, $foo_builder);
 139     ok -e 'Makefile.PL', "$style Makefile.PL created";
 140
 141     # Should fail with "can't find Foo/Builder.pm"
 142     my $result;
 143     my ($stdout, $stderr ) = stdout_stderr_of (sub {
 144       $result = $mb->run_perl_script('Makefile.PL');
 145     });
 146     ok ! $result, "Makefile.PL failed";
 147     like $stderr, qr{Foo/Builder.pm}, "custom builder wasn't found";
 148   }
 149
 150   # Now make sure it can actually work.
 151   my $bar_builder;
 152   stdout_of( sub {
 153     $bar_builder = Module::Build->subclass( class => 'Bar::Builder' )->new_from_context;
 154   });
 155   foreach my $style ('passthrough', 'small') {
 156     Module::Build::Compat->create_makefile_pl($style, $bar_builder);
 157     ok -e 'Makefile.PL', "$style Makefile.PL created via subclass";
 158     my $result;
 159     stdout_of( sub {
 160       $result = $mb->run_perl_script('Makefile.PL');
 161     });
 162     ok $result, "Makefile.PL ran without error";
 163   }
 164 }
 165
 166 {
 167   # Make sure various Makefile.PL arguments are supported
 168   Module::Build::Compat->create_makefile_pl('passthrough', $mb);
 169
 170   my $libdir = File::Spec->catdir( $tmp, 'libdir' );
 171   my $result;
 172   stdout_of( sub {
 173     $result = $mb->run_perl_script('Makefile.PL', [],
 174       [
 175       "LIB=$libdir",
 176       'TEST_VERBOSE=1',
 177       'INSTALLDIRS=perl',
 178       'POLLUTE=1',
 179       ]
 180     );
 181   });
 182   ok $result, "passthrough Makefile.PL ran with arguments";
 183   ok -e 'Build.PL', "Build.PL generated";
 184
 185   my $new_build = Module::Build->resume();
 186   is $new_build->installdirs, 'core', "installdirs is core";
 187   is $new_build->verbose, 1, "tests set for verbose";
 188   is $new_build->install_destination('lib'), $libdir, "custom libdir";
 189   is $new_build->extra_compiler_flags->[0], '-DPERL_POLLUTE', "PERL_POLLUTE set";
 190
 191   # Make sure those switches actually had an effect
 192   my ($ran_ok, $output);
 193   $output = stdout_of( sub { $ran_ok = $new_build->do_system(@make, 'test') } );
 194   ok $ran_ok, "make test ran without error";
 195   $output =~ s/^/# /gm;  # Don't confuse our own test output
 196   like $output, qr/(?:# ok \d+\s+)+/, 'Should be verbose';
 197
 198   # Make sure various Makefile arguments are supported
 199   my $make_macro = 'TEST_VERBOSE=0';
 200
 201   # VMS MMK/MMS macros use different syntax.
 202   if ($is_vms_mms) {
 203     $make_macro = '/macro=("' . $make_macro . '")';
 204   }
 205
 206   $output = stdout_of( sub {
 207     local $ENV{HARNESS_TIMER}; # RT#39635 - timer messes with output
 208     $ran_ok = $mb->do_system(@make, 'test', $make_macro)
 209   } );
 210
 211   ok $ran_ok, "make test without verbose ran ok";
 212   $output =~ s/^/# /gm;  # Don't confuse our own test output
 213   like $output,
 214        qr/# .+basic(\.t)?[.\s#]+ok[.\s#]+All tests successful/,
 215        'Should be non-verbose';
 216
 217   (my $libdir2 = $libdir) =~ s/libdir/lbiidr/;
 218   my @make_args = ('INSTALLDIRS=vendor', "INSTALLVENDORLIB=$libdir2");
 219
 220   if ($is_vms_mms) { # VMS MMK/MMS macros use different syntax.
 221     $make_args[0] = '/macro=("' . join('","',@make_args) . '")';
 222     pop @make_args while scalar(@make_args) > 1;
 223   }
 224   ($output) = stdout_stderr_of(
 225     sub {
 226       $ran_ok = $mb->do_system(@make, 'fakeinstall', @make_args);
 227     }
 228   );
 229
 230   ok $ran_ok, "make fakeinstall with INSTALLDIRS=vendor ran ok";
 231   $output =~ s/^/# /gm;  # Don't confuse our own test output
 232   like $output,
 233        qr/\Q$libdir2\E .* Simple\.pm/x,
 234        'Should have installdirs=vendor';
 235
 236   stdout_of( sub { $mb->do_system(@make, 'realclean'); } );
 237   ok ! -e $makefile, "$makefile shouldn't exist";
 238
 239   1 while unlink 'Makefile.PL';
 240   ok ! -e 'Makefile.PL', "Makefile.PL cleaned up";
 241
 242   1 while unlink $libdir, $libdir2;
 243 }
 244
 245 { # Make sure tilde-expansion works
 246
 247   # C<glob> on MSWin32 uses $ENV{HOME} if defined to do tilde-expansion
 248   local $ENV{HOME} = 'C:/' if $^O =~ /MSWin/ && !exists( $ENV{HOME} );
 249
 250   Module::Build::Compat->create_makefile_pl('passthrough', $mb);
 251
 252   stdout_of( sub {
 253     $mb->run_perl_script('Makefile.PL', [], ['INSTALL_BASE=~/foo']);
 254   });
 255   my $b2 = Module::Build->current;
 256   ok $b2->install_base, "install_base set";
 257   unlike $b2->install_base, qr/^~/, "Tildes should be expanded";
 258
 259   stdout_of( sub { $mb->do_system(@make, 'realclean'); } );
 260   ok ! -e $makefile, "$makefile shouldn't exist";
 261
 262   1 while unlink 'Makefile.PL';
 263   ok ! -e 'Makefile.PL', "Makefile.PL cleaned up";
 264 }
 265
 266 # cleanup
 267 $dist->remove;
 268
 269 #########################################################
 270
 271 sub test_makefile_types {
 272   my %opts = @_;
 273   $opts{requires} ||= {};
 274   $opts{PL_files} ||= {};
 275
 276   foreach my $type (@makefile_types) {
 277     # Create M::B instance
 278     my $mb;
 279     stdout_of( sub {
 280         $mb = Module::Build->new_from_context;
 281     });
 282     ok $mb, "Module::Build->new_from_context";
 283
 284     # Create and test Makefile.PL
 285     Module::Build::Compat->create_makefile_pl($type, $mb);
 286     ok -e 'Makefile.PL', "$type Makefile.PL created";
 287     test_makefile_pl_requires_perl( $opts{requires}{perl} );
 288     test_makefile_creation($mb);
 289     test_makefile_prereq_pm( $opts{requires} );
 290     test_makefile_pl_files( $opts{PL_files} ) if $type eq 'traditional';
 291
 292     my ($output,$success);
 293     # Capture output to keep our STDOUT clean
 294     $output = stdout_of( sub {
 295       $success = $mb->do_system(@make);
 296     });
 297     ok $success, "make ran without error";
 298
 299     for my $file (values %{ $opts{PL_files} }) {
 300         ok -e $file, "PL_files generated - $file";
 301     }
 302
 303     # Can't let 'test' STDOUT go to our STDOUT, or it'll confuse Test::Harness.
 304     $output = stdout_of( sub {
 305       $success = $mb->do_system(@make, 'test');
 306     });
 307     ok $success, "make test ran without error";
 308     like uc $output, qr{DONE\.|SUCCESS}, "make test output indicated success";
 309
 310     $output = stdout_of( sub {
 311       $success = $mb->do_system(@make, 'realclean');
 312     });
 313     ok $success, "make realclean ran without error";
 314
 315     # Try again with some Makefile.PL arguments
 316     test_makefile_creation($mb, [], 'INSTALLDIRS=vendor', 1);
 317
 318     1 while unlink 'Makefile.PL';
 319     ok ! -e 'Makefile.PL', "cleaned up Makefile";
 320   }
 321 }
 322
 323 sub test_makefile_creation {
 324   my ($build, $preargs, $postargs, $cleanup) = @_;
 325
 326   my ($output, $result);
 327   # capture output to avoid polluting our test output
 328   $output = stdout_of( sub {
 329       $result = $build->run_perl_script('Makefile.PL', $preargs, $postargs);
 330   });
 331   my $label = "Makefile.PL ran without error";
 332   if ( defined $postargs && length $postargs ) {
 333     $label .= " (postargs: $postargs)";
 334   }
 335   ok $result, $label;
 336   ok -e $makefile, "$makefile exists";
 337
 338   if ($cleanup) {
 339     $output = stdout_of( sub {
 340       $build->do_system(@make, 'realclean');
 341     });
 342     ok ! -e '$makefile', "$makefile cleaned up";
 343   }
 344   else {
 345     pass '(skipping cleanup)'; # keep test count constant
 346   }
 347 }
 348
 349 sub test_makefile_prereq_pm {
 350   my %requires = %{ $_[0] };
 351   delete $requires{perl}; # until EU::MM supports this
 352   SKIP: {
 353     skip "$makefile not found", 1 unless -e $makefile;
 354     my $prereq_pm = find_params_in_makefile()->{PREREQ_PM} || {};
 355     is_deeply $prereq_pm, \%requires,
 356       "$makefile has correct PREREQ_PM line";
 357   }
 358 }
 359
 360 sub test_makefile_pl_files {
 361   my $expected = shift;
 362
 363   SKIP: {
 364     skip "$makefile not found", 1 unless -e $makefile;
 365     my $pl_files = find_params_in_makefile()->{PL_FILES} || {};
 366     is_deeply $pl_files, $expected,
 367       "$makefile has correct PL_FILES line";
 368   }
 369 }
 370
 371 sub test_makefile_pl_requires_perl {
 372   my $perl_version = shift || q{};
 373   SKIP: {
 374     skip 'Makefile.PL not found', 1 unless -e 'Makefile.PL';
 375     my $file_contents = slurp 'Makefile.PL';
 376     my $found_requires = $file_contents =~ m{^require $perl_version;}ms;
 377     if (length $perl_version) {
 378       ok $found_requires, "Makefile.PL has 'require $perl_version;'"
 379         or diag "Makefile.PL:\n$file_contents";
 380     }
 381     else {
 382       ok ! $found_requires, "Makefile.PL does not require a perl version";
 383     }
 384   }
 385 }
 386
 387 sub find_params_in_makefile {
 388   my $fh = IO::File->new( $makefile, 'r' )
 389     or die "Can't read $makefile: $!";
 390   local($/) = "\n";
 391
 392   my %params;
 393   while (<$fh>) {
 394     # Blank line after params.
 395     last if keys %params and !/\S+/;
 396
 397     next unless m{^\# \s+ ( [A-Z_]+ ) \s+ => \s+ ( .* )$}x;
 398
 399     my($key, $val) = ($1, $2);
 400     # extract keys and values
 401     while ( $val =~ m/(?:\s)(\S+)=>(q\[.*?\]|undef),?/g ) {
 402       my($m,$n) = ($1,$2);
 403       if ($n =~ /^q\[(.*?)\]$/) {
 404         $n = $1;
 405       }
 406       $params{$key}{$m} = $n;
 407     }
 408   }
 409
 410   return \%params;
 411 }