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