cpan/Module-Build/t/compat.t

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use 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 blib_load('Module::Build');
  29 blib_load('Module::Build::Version');
  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 blib_load('Module::Build');
  47 blib_load('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.2,
  76   },
  77   build_requires => {
  78       'Test::More' => 0,
  79       'File::Spec' => 0,
  80   },
  81   PL_files            => { 'foo.PL' => 'foo' },
  82 });
  83
  84 $dist->add_file("foo.PL", <<'END');
  85 open my $fh, ">$ARGV[0]" or die $!;
  86 print $fh "foo\n";
  87 END
  88
  89 $dist->regen;
  90
  91 test_makefile_types(
  92     requires => {
  93         'perl' => $],
  94         'File::Spec' => 0.2,
  95     },
  96     build_requires => {
  97         'Test::More' => 0,
  98         'File::Spec' => 0,
  99     },
 100     PL_files => {
 101         'foo.PL' => 'foo',
 102     },
 103 );
 104
 105 ######################
 106
 107 $dist->change_build_pl({
 108   module_name         => $distname,
 109   license             => 'perl',
 110 });
 111 $dist->regen;
 112
 113 # Create M::B instance but don't pollute STDOUT
 114 my $mb;
 115 stdout_stderr_of( sub {
 116     $mb = Module::Build->new_from_context;
 117 });
 118 ok $mb, "Module::Build->new_from_context";
 119
 120
 121 {
 122   # Make sure fake_makefile() can run without 'build_class', as it may be
 123   # in older-generated Makefile.PLs
 124   my $warning = '';
 125   local $SIG{__WARN__} = sub { $warning = shift; };
 126
 127   my $maketext = eval { Module::Build::Compat->fake_makefile(makefile => $makefile) };
 128   is $@, '', "fake_makefile lived";
 129   like $maketext, qr/^realclean/m, "found 'realclean' in fake_makefile output";
 130   like $warning, qr/build_class/, "saw warning about 'build_class'";
 131 }
 132
 133 {
 134   # Make sure custom builder subclass is used in the created
 135   # Makefile.PL - make sure it fails in the right way here.
 136   local @Foo::Builder::ISA = qw(Module::Build);
 137   my $foo_builder;
 138   stdout_stderr_of( sub {
 139     $foo_builder = Foo::Builder->new_from_context;
 140   });
 141   foreach my $style ('passthrough', 'small') {
 142     create_makefile_pl($style, $foo_builder);
 143
 144     # Should fail with "can't find Foo/Builder.pm"
 145     my $result;
 146     my ($stdout, $stderr ) = stdout_stderr_of (sub {
 147       $result = $mb->run_perl_script('Makefile.PL');
 148     });
 149     ok ! $result, "Makefile.PL failed";
 150     like $stderr, qr{Foo/Builder.pm}, "custom builder wasn't found";
 151   }
 152
 153   # Now make sure it can actually work.
 154   my $bar_builder;
 155   stdout_stderr_of( sub {
 156     $bar_builder = Module::Build->subclass( class => 'Bar::Builder' )->new_from_context;
 157   });
 158   foreach my $style ('passthrough', 'small') {
 159     create_makefile_pl($style, $bar_builder);
 160     my $result;
 161     stdout_stderr_of( sub {
 162       $result = $mb->run_perl_script('Makefile.PL');
 163     });
 164     ok $result, "Makefile.PL ran without error";
 165   }
 166 }
 167
 168 {
 169   # Make sure various Makefile.PL arguments are supported
 170   create_makefile_pl('passthrough', $mb);
 171
 172   my $libdir = File::Spec->catdir( $tmp, 'libdir' );
 173   my $result;
 174   stdout_stderr_of( sub {
 175     $result = $mb->run_perl_script('Makefile.PL', [],
 176       [
 177       "LIB=$libdir",
 178       'TEST_VERBOSE=1',
 179       'INSTALLDIRS=perl',
 180       'POLLUTE=1',
 181       ]
 182     );
 183   });
 184   ok $result, "passthrough Makefile.PL ran with arguments";
 185   ok -e 'Build.PL', "Build.PL generated";
 186
 187   my $new_build = Module::Build->resume();
 188   is $new_build->installdirs, 'core', "installdirs is core";
 189   is $new_build->verbose, 1, "tests set for verbose";
 190   is $new_build->install_destination('lib'), $libdir, "custom libdir";
 191   is $new_build->extra_compiler_flags->[0], '-DPERL_POLLUTE', "PERL_POLLUTE set";
 192
 193   # Make sure those switches actually had an effect
 194   my ($ran_ok, $output);
 195   $output = stdout_stderr_of( sub { $ran_ok = $new_build->do_system(@make, 'test') } );
 196   ok $ran_ok, "make test ran without error";
 197   $output =~ s/^/# /gm;  # Don't confuse our own test output
 198   like $output, qr/(?:# ok \d+\s+)+/, 'Should be verbose';
 199
 200   # Make sure various Makefile arguments are supported
 201   my $make_macro = 'TEST_VERBOSE=0';
 202
 203   # VMS MMK/MMS macros use different syntax.
 204   if ($is_vms_mms) {
 205     $make_macro = '/macro=("' . $make_macro . '")';
 206   }
 207
 208   $output = stdout_stderr_of( sub {
 209     local $ENV{HARNESS_TIMER}; # RT#39635 - timer messes with output
 210     $ran_ok = $mb->do_system(@make, 'test', $make_macro)
 211   } );
 212
 213   ok $ran_ok, "make test without verbose ran ok";
 214   $output =~ s/^/# /gm;  # Don't confuse our own test output
 215   like $output,
 216        qr/# .+basic(\.t)?[.\s#]+ok[.\s#]+All tests successful/,
 217        'Should be non-verbose';
 218
 219   (my $libdir2 = $libdir) =~ s/libdir/lbiidr/;
 220   my $libarch2 = File::Spec->catdir($libdir2, 'arch');
 221
 222   SKIP: {
 223     my @cases = (
 224       {
 225         label => "INSTALLDIRS=vendor",
 226         args => [ 'INSTALLDIRS=vendor', "INSTALLVENDORLIB=$libdir2", "INSTALLVENDORARCH=$libarch2"],
 227         check => qr/\Q$libdir2\E .* Simple\.pm/ix,
 228       },
 229       {
 230         label => "PREFIX=\$libdir2",
 231         args => [ "PREFIX=$libdir2"],
 232         check => qr/\Q$libdir2\E .* Simple\.pm/ix,
 233       },
 234       {
 235         label => "PREFIX=\$libdir2 LIB=mylib",
 236         args => [ "PREFIX=$libdir2", "LIB=mylib" ],
 237         check => qr{\Q$libdir2\E[/\\]mylib[/\\]Simple\.pm}ix,
 238       },
 239     );
 240
 241     require ExtUtils::Install;
 242     skip "Needs ExtUtils::Install 1.32 or later", 2 * @cases
 243       if ExtUtils::Install->VERSION < 1.32;
 244
 245     skip "Needs upstream patch at http://rt.cpan.org/Public/Bug/Display.html?id=55288", 2 * @cases
 246       if $^O eq 'VMS';
 247
 248     for my $c (@cases) {
 249       my @make_args = @{$c->{args}};
 250       if ($is_vms_mms) { # VMS MMK/MMS macros use different syntax.
 251         $make_args[0] = '/macro=("' . join('","',@make_args) . '")';
 252         pop @make_args while scalar(@make_args) > 1;
 253       }
 254       ($output) = stdout_stderr_of(
 255         sub {
 256           $result = $mb->run_perl_script('Makefile.PL', [], \@make_args);
 257           $ran_ok = $mb->do_system(@make, 'fakeinstall');
 258         }
 259       );
 260
 261       ok $ran_ok, "fakeinstall $c->{label} ran ok";
 262       $output =~ s/^/# /gm;  # Don't confuse our own test output
 263       like $output, $c->{check},
 264           "Saw destination directory for $c->{label}";
 265     }
 266   }
 267
 268   stdout_stderr_of( sub { $mb->do_system(@make, 'realclean'); } );
 269   ok ! -e $makefile, "$makefile shouldn't exist";
 270
 271   1 while unlink 'Makefile.PL';
 272   ok ! -e 'Makefile.PL', "Makefile.PL cleaned up";
 273
 274   1 while unlink $libdir, $libdir2;
 275 }
 276
 277 { # Make sure tilde-expansion works
 278
 279   # C<glob> on MSWin32 uses $ENV{HOME} if defined to do tilde-expansion
 280   local $ENV{HOME} = 'C:/' if $^O =~ /MSWin/ && !exists( $ENV{HOME} );
 281
 282   create_makefile_pl('passthrough', $mb);
 283
 284   stdout_stderr_of( sub {
 285     $mb->run_perl_script('Makefile.PL', [], ['INSTALL_BASE=~/foo']);
 286   });
 287   my $b2 = Module::Build->current;
 288   ok $b2->install_base, "install_base set";
 289   unlike $b2->install_base, qr/^~/, "Tildes should be expanded";
 290
 291   stdout_stderr_of( sub { $mb->do_system(@make, 'realclean'); } );
 292   ok ! -e $makefile, "$makefile shouldn't exist";
 293
 294   1 while unlink 'Makefile.PL';
 295   ok ! -e 'Makefile.PL', "Makefile.PL cleaned up";
 296 }
 297
 298 {
 299   $dist->add_file('t/deep/foo.t', q{});
 300   $dist->regen;
 301
 302   my $mb;
 303   stdout_stderr_of( sub {
 304       $mb = Module::Build->new_from_context( recursive_test_files => 1 );
 305   });
 306
 307   create_makefile_pl('traditional', $mb);
 308   my $args = extract_writemakefile_args() || {};
 309
 310   if ( exists $args->{test}->{TESTS} ) {
 311     is $args->{test}->{TESTS},
 312       join( q{ },
 313         File::Spec->catfile(qw(t *.t)),
 314         File::Spec->catfile(qw(t deep *.t))
 315       ),
 316       'Makefile.PL has correct TESTS line for recursive test files';
 317   } else {
 318     ok( ! exists $args->{TESTS}, 'Not using incorrect recursive tests key' );
 319   }
 320
 321 }
 322
 323 #########################################################
 324
 325 sub _merge_prereqs {
 326   my ($first, $second) = @_;
 327   my $new = { %$first };
 328   for my $k (keys %$second) {
 329     if ( exists $new->{$k} ) {
 330       my ($v1,$v2) = ($new->{$k},$second->{$k});
 331       $new->{$k} = ($v1 > $v2 ? $v1 : $v2);
 332     }
 333     else {
 334       $new->{$k} = $second->{$k};
 335     }
 336   }
 337   return $new;
 338 }
 339
 340 sub test_makefile_types {
 341   my %opts = @_;
 342   $opts{requires} ||= {};
 343   $opts{build_requires} ||= {};
 344   $opts{PL_files} ||= {};
 345
 346   foreach my $type (@makefile_types) {
 347     # Create M::B instance
 348     my $mb;
 349     stdout_stderr_of( sub {
 350         $mb = Module::Build->new_from_context;
 351     });
 352     ok $mb, "Module::Build->new_from_context";
 353
 354     # Create and test Makefile.PL
 355     create_makefile_pl($type, $mb);
 356
 357     test_makefile_pl_requires_perl( $opts{requires}{perl} );
 358     test_makefile_creation($mb);
 359     test_makefile_prereq_pm( _merge_prereqs($opts{requires}, $opts{build_requires}) );
 360     test_makefile_pl_files( $opts{PL_files} ) if $type eq 'traditional';
 361
 362     my ($output,$success);
 363     # Capture output to keep our STDOUT clean
 364     $output = stdout_stderr_of( sub {
 365       $success = $mb->do_system(@make);
 366     });
 367     ok $success, "make ran without error";
 368
 369     for my $file (values %{ $opts{PL_files} }) {
 370         ok -e $file, "PL_files generated - $file";
 371     }
 372
 373     # Can't let 'test' STDOUT go to our STDOUT, or it'll confuse Test::Harness.
 374     $output = stdout_stderr_of( sub {
 375       $success = $mb->do_system(@make, 'test');
 376     });
 377     ok $success, "make test ran without error";
 378     like uc $output, qr{DONE\.|SUCCESS}, "make test output indicated success";
 379
 380     $output = stdout_stderr_of( sub {
 381       $success = $mb->do_system(@make, 'realclean');
 382     });
 383     ok $success, "make realclean ran without error";
 384
 385     # Try again with some Makefile.PL arguments
 386     test_makefile_creation($mb, [], 'INSTALLDIRS=vendor', 'realclean');
 387
 388     # Try again using distclean
 389     test_makefile_creation($mb, [], '', 'distclean');
 390
 391     1 while unlink 'Makefile.PL';
 392     ok ! -e 'Makefile.PL', "cleaned up Makefile";
 393   }
 394 }
 395
 396 sub test_makefile_creation {
 397   my ($build, $preargs, $postargs, $cleanup) = @_;
 398
 399   my ($output, $result);
 400   # capture output to avoid polluting our test output
 401   $output = stdout_stderr_of( sub {
 402       $result = $build->run_perl_script('Makefile.PL', $preargs, $postargs);
 403   });
 404   my $label = "Makefile.PL ran without error";
 405   if ( defined $postargs && length $postargs ) {
 406     $label .= " (postargs: $postargs)";
 407   }
 408   ok $result, $label;
 409   ok -e $makefile, "$makefile exists";
 410
 411   if ($cleanup) {
 412     # default to 'realclean' unless we recognize the clean method
 413     $cleanup = 'realclean' unless $cleanup =~ /^(dist|real)clean$/;
 414     my ($stdout, $stderr ) = stdout_stderr_of (sub {
 415       $build->do_system(@make, $cleanup);
 416     });
 417     ok ! -e $makefile, "$makefile cleaned up with $cleanup";
 418   }
 419   else {
 420     pass '(skipping cleanup)'; # keep test count constant
 421   }
 422 }
 423
 424 sub test_makefile_prereq_pm {
 425   my %requires = %{ $_[0] };
 426   delete $requires{perl}; # until EU::MM supports this
 427   SKIP: {
 428     skip "$makefile not found", 1 unless -e $makefile;
 429     my $prereq_pm = find_params_in_makefile()->{PREREQ_PM} || {};
 430     is_deeply $prereq_pm, \%requires,
 431       "$makefile has correct PREREQ_PM line";
 432   }
 433 }
 434
 435 sub test_makefile_pl_files {
 436   my $expected = shift;
 437
 438   SKIP: {
 439     skip 1, 'Makefile.PL not found' unless -e 'Makefile.PL';
 440     my $args = extract_writemakefile_args() || {};
 441     is_deeply $args->{PL_FILES}, $expected,
 442       "Makefile.PL has correct PL_FILES line";
 443   }
 444 }
 445
 446 sub test_makefile_pl_requires_perl {
 447   my $perl_version = shift || q{};
 448   SKIP: {
 449     skip 1, 'Makefile.PL not found' unless -e 'Makefile.PL';
 450     my $file_contents = slurp 'Makefile.PL';
 451     my $found_requires = $file_contents =~ m{^require $perl_version;}ms;
 452     if (length $perl_version) {
 453       ok $found_requires, "Makefile.PL has 'require $perl_version;'"
 454         or diag "Makefile.PL:\n$file_contents";
 455     }
 456     else {
 457       ok ! $found_requires, "Makefile.PL does not require a perl version";
 458     }
 459   }
 460 }
 461
 462 sub find_params_in_makefile {
 463   my $fh = IO::File->new( $makefile, 'r' )
 464     or die "Can't read $makefile: $!";
 465   local($/) = "\n";
 466
 467   my %params;
 468   while (<$fh>) {
 469     # Blank line after params.
 470     last if keys %params and !/\S+/;
 471
 472     next unless m{^\# \s+ ( [A-Z_]+ ) \s+ => \s+ ( .* )$}x;
 473
 474     my($key, $val) = ($1, $2);
 475     # extract keys and values
 476     while ( $val =~ m/(?:\s)(\S+)=>(q\[.*?\]|undef),?/g ) {
 477       my($m,$n) = ($1,$2);
 478       if ($n =~ /^q\[(.*?)\]$/) {
 479         $n = $1;
 480       }
 481       $params{$key}{$m} = $n;
 482     }
 483   }
 484
 485   return \%params;
 486 }
 487
 488 sub extract_writemakefile_args {
 489   SKIP: {
 490     skip 1, 'Makefile.PL not found' unless -e 'Makefile.PL';
 491     my $file_contents = slurp 'Makefile.PL';
 492     my ($args) = $file_contents =~ m{^WriteMakefile\n\((.*)\).*;}ms;
 493     ok $args, "Found WriteMakefile arguments"
 494         or diag "Makefile.PL:\n$file_contents";
 495     my %args = eval $args or diag $args; ## no critic
 496     return \%args;
 497   }
 498 }
 499
 500 sub create_makefile_pl {
 501     my @args = @_;
 502     stdout_stderr_of( sub { Module::Build::Compat->create_makefile_pl(@args) } );
 503     my $ok = ok -e 'Makefile.PL', "$_[0] Makefile.PL created";
 504
 505     # Some really conservative make's, like HP/UX, assume files with the same
 506     # timestamp are out of date.  Send the Makefile.PL one second into the past
 507     # so its older than the Makefile it will generate.
 508     # See [rt.cpan.org 45700]
 509     my $mtime = (stat("Makefile.PL"))[9];
 510     utime $mtime, $mtime - 1, "Makefile.PL";
 511
 512     return $ok;
 513 }