git.maemo.org Git - dh-make-perl/blob - dev/arm/libmodule-build-perl/libmodule-build-perl-0.2808.01/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, qr/(?:# .+basic\.+ok\s+(?:[\d.]+\s*m?s\s*)?)# All tests/,
 178       'Should be non-verbose';
 179
 180   $mb->delete_filetree($libdir);
 181   ok ! -e $libdir, "Sample installation directory should be cleaned up";
 182
 183   stdout_of( sub { $mb->do_system(@make, 'realclean'); } );
 184   ok ! -e 'Makefile', "Makefile shouldn't exist";
 185
 186   1 while unlink 'Makefile.PL';
 187   ok ! -e 'Makefile.PL', "Makefile.PL cleaned up";
 188 }
 189
 190 { # Make sure tilde-expansion works
 191
 192   # C<glob> on MSWin32 uses $ENV{HOME} if defined to do tilde-expansion
 193   local $ENV{HOME} = 'C:/' if $^O =~ /MSWin/ && !exists( $ENV{HOME} );
 194
 195   Module::Build::Compat->create_makefile_pl('passthrough', $mb);
 196
 197   stdout_of( sub {
 198     $mb->run_perl_script('Makefile.PL', [], ['INSTALL_BASE=~/foo']);
 199   });
 200   my $b2 = Module::Build->current;
 201   ok $b2->install_base, "install_base set";
 202   unlike $b2->install_base, qr/^~/, "Tildes should be expanded";
 203
 204   stdout_of( sub { $mb->do_system(@make, 'realclean'); } );
 205   ok ! -e 'Makefile', "Makefile shouldn't exist";
 206
 207   1 while unlink 'Makefile.PL';
 208   ok ! -e 'Makefile.PL', "Makefile.PL cleaned up";
 209 }
 210
 211 #########################################################
 212
 213 sub test_makefile_types {
 214   my %opts = @_;
 215   $opts{requires} ||= {};
 216
 217   foreach my $type (@makefile_types) {
 218     # Create M::B instance
 219     my $mb;
 220     stdout_of( sub {
 221         $mb = Module::Build->new_from_context;
 222     });
 223     ok $mb, "Module::Build->new_from_context";
 224
 225     # Create and test Makefile.PL
 226     Module::Build::Compat->create_makefile_pl($type, $mb);
 227     ok -e 'Makefile.PL', "$type Makefile.PL created";
 228     test_makefile_pl_requires_perl( $opts{requires}{perl} );
 229     test_makefile_creation($mb);
 230     test_makefile_prereq_pm( $opts{requires} );
 231
 232     my ($output,$success);
 233     # Capture output to keep our STDOUT clean
 234     $output = stdout_of( sub {
 235       $success = $mb->do_system(@make);
 236     });
 237     ok $success, "make ran without error";
 238
 239     # Can't let 'test' STDOUT go to our STDOUT, or it'll confuse Test::Harness.
 240     $output = stdout_of( sub {
 241       $success = $mb->do_system(@make, 'test');
 242     });
 243     ok $success, "make test ran without error";
 244     like uc $output, qr{DONE\.|SUCCESS}, "make test output indicated success";
 245
 246     $output = stdout_of( sub {
 247       $success = $mb->do_system(@make, 'realclean');
 248     });
 249     ok $success, "make realclean ran without error";
 250
 251     # Try again with some Makefile.PL arguments
 252     test_makefile_creation($mb, [], 'INSTALLDIRS=vendor', 1);
 253
 254     1 while unlink 'Makefile.PL';
 255     ok ! -e 'Makefile.PL', "cleaned up Makefile";
 256   }
 257 }
 258
 259 sub test_makefile_creation {
 260   my ($build, $preargs, $postargs, $cleanup) = @_;
 261
 262   my ($output, $result);
 263   # capture output to avoid polluting our test output
 264   $output = stdout_of( sub {
 265       $result = $build->run_perl_script('Makefile.PL', $preargs, $postargs);
 266   });
 267   my $label = "Makefile.PL ran without error";
 268   if ( defined $postargs && length $postargs ) {
 269     $label .= " (postargs: $postargs)";
 270   }
 271   ok $result, $label;
 272   ok -e 'Makefile', "Makefile exists";
 273
 274   if ($cleanup) {
 275     $output = stdout_of( sub {
 276       $build->do_system(@make, 'realclean');
 277     });
 278     ok ! -e 'Makefile', "Makefile cleaned up";
 279   }
 280   else {
 281     pass '(skipping cleanup)'; # keep test count constant
 282   }
 283 }
 284
 285 sub test_makefile_prereq_pm {
 286   my %requires = %{ $_[0] };
 287   delete $requires{perl}; # until EU::MM supports this
 288   SKIP: {
 289     skip 'Makefile not found', 1 unless -e 'Makefile';
 290     my $prereq_pm = find_makefile_prereq_pm();
 291     is_deeply $prereq_pm, \%requires,
 292       "Makefile has correct PREREQ_PM line";
 293   }
 294 }
 295
 296 sub test_makefile_pl_requires_perl {
 297   my $perl_version = shift || q{};
 298   SKIP: {
 299     skip 'Makefile.PL not found', 1 unless -e 'Makefile.PL';
 300     my $file_contents = slurp 'Makefile.PL';
 301     my $found_requires = $file_contents =~ m{^require $perl_version;}ms;
 302     if (length $perl_version) {
 303       ok $found_requires, "Makefile.PL has 'require $perl_version;'"
 304         or diag "Makefile.PL:\n$file_contents";
 305     }
 306     else {
 307       ok ! $found_requires, "Makefile.PL does not require a perl version";
 308     }
 309   }
 310 }
 311
 312 # Following subroutine adapted from code in CPAN.pm
 313 # by Andreas Koenig and A. Speer.
 314 sub find_makefile_prereq_pm {
 315   my $fh = IO::File->new( 'Makefile', 'r' )
 316     or die "Can't read Makefile: $!";
 317   my $req = {};
 318   local($/) = "\n";
 319   while (<$fh>) {
 320     # locate PREREQ_PM
 321     last if /MakeMaker post_initialize section/;
 322     my($p) = m{^[\#]
 323       \s+PREREQ_PM\s+=>\s+(.+)
 324     }x;
 325     next unless $p;
 326
 327     # extract modules
 328     while ( $p =~ m/(?:\s)([\w\:]+)=>(q\[.*?\]|undef),?/g ){
 329       my($m,$n) = ($1,$2);
 330       if ($n =~ /^q\[(.*?)\]$/) {
 331         $n = $1;
 332       }
 333       $req->{$m} = $n;
 334     }
 335     last;
 336   }
 337   return $req;
 338 }
 339
 340 # cleanup
 341 chdir( $cwd ) or die "Can''t chdir to '$cwd': $!";
 342 $dist->remove;
 343
 344 use File::Path;
 345 rmtree( $tmp );