[p5sagit/p5-mst-13.2.git] / lib / Module / Build / t / compat.t

#!/usr/bin/perl -w

use strict;
use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
use MBTest;
use File::Spec;
use IO::File;
use Config;

# Don't let our own verbosity/test_file get mixed up with our subprocess's
my @makefile_keys = qw(TEST_VERBOSE HARNESS_VERBOSE TEST_FILES MAKEFLAGS);
local  @ENV{@makefile_keys};
delete @ENV{@makefile_keys};

my @makefile_types = qw(small passthrough traditional);
my $tests_per_type = 15;

#find_in_path does not understand VMS.

if ( $Config{make} && $^O ne 'VMS' ? find_in_path($Config{make}) : 1 ) {
    plan 'no_plan';
} else {
    plan skip_all => "Don't know how to invoke 'make'";
}

my $is_vms_mms = ($^O eq 'VMS') && ($Config{make} =~ /MM[SK]/i);

use_ok 'Module::Build';
ensure_blib('Module::Build');


#########################

my $tmp = MBTest->tmpdir;

# Create test distribution; set requires and build_requires
use DistGen;
my $dist = DistGen->new( dir => $tmp );
$dist->regen;

$dist->chdir_in;


#########################

use Module::Build;
use Module::Build::Compat;

use Carp;  $SIG{__WARN__} = \&Carp::cluck;

my @make = $Config{make} eq 'nmake' ? ('nmake', '-nologo') : ($Config{make});

my $makefile = 'Makefile';

# VMS MMK/MMS by convention use Descrip.MMS
if ($is_vms_mms) {
    $makefile = 'Descrip.MMS';
}


#########################

# Test without requires

test_makefile_types();

# Test with requires and PL_files

my $distname = $dist->name;
$dist->change_build_pl({ 
  module_name         => $distname,
  license             => 'perl',
  requires            => {
    'perl'        => $],
    'File::Spec'  => 0,
  },
  build_requires      => {
    'Test::More'  => 0,
  },
  PL_files            => { 'foo.PL' => 'foo' },
});

$dist->add_file("foo.PL", <<'END');
open my $fh, ">$ARGV[0]" or die $!;
print $fh "foo\n";
END

$dist->regen;

test_makefile_types(
    requires => {
        'perl' => $],
        'File::Spec' => 0,
        'Test::More' => 0,
    },
    PL_files => {
        'foo.PL' => 'foo',
    },
);

######################

$dist->change_build_pl({ 
  module_name         => $distname,
  license             => 'perl',
});
$dist->regen;

# Create M::B instance but don't pollute STDOUT
my $mb;
stdout_of( sub {
    $mb = Module::Build->new_from_context;
});
ok $mb, "Module::Build->new_from_context";


{
  # Make sure fake_makefile() can run without 'build_class', as it may be
  # in older-generated Makefile.PLs
  my $warning = '';
  local $SIG{__WARN__} = sub { $warning = shift; };

  my $maketext = eval { Module::Build::Compat->fake_makefile(makefile => $makefile) };
  is $@, '', "fake_makefile lived";
  like $maketext, qr/^realclean/m, "found 'realclean' in fake_makefile output";
  like $warning, qr/build_class/, "saw warning about 'build_class'";
}

{
  # Make sure custom builder subclass is used in the created
  # Makefile.PL - make sure it fails in the right way here.
  local @Foo::Builder::ISA = qw(Module::Build);
  my $foo_builder;
  stdout_of( sub {
    $foo_builder = Foo::Builder->new_from_context;
  });
  foreach my $style ('passthrough', 'small') {
    create_makefile_pl($style, $foo_builder);
    
    # Should fail with "can't find Foo/Builder.pm"
    my $result;
    my ($stdout, $stderr ) = stdout_stderr_of (sub {
      $result = $mb->run_perl_script('Makefile.PL');
    });
    ok ! $result, "Makefile.PL failed";
    like $stderr, qr{Foo/Builder.pm}, "custom builder wasn't found";
  }
  
  # Now make sure it can actually work.
  my $bar_builder;
  stdout_of( sub {
    $bar_builder = Module::Build->subclass( class => 'Bar::Builder' )->new_from_context;
  });
  foreach my $style ('passthrough', 'small') {
    create_makefile_pl($style, $bar_builder);
    my $result;
    stdout_of( sub {
      $result = $mb->run_perl_script('Makefile.PL');
    });
    ok $result, "Makefile.PL ran without error";
  }
}

{
  # Make sure various Makefile.PL arguments are supported
  create_makefile_pl('passthrough', $mb);

  my $libdir = File::Spec->catdir( $tmp, 'libdir' );
  my $result;
  stdout_of( sub {
    $result = $mb->run_perl_script('Makefile.PL', [],
      [
      "LIB=$libdir",
      'TEST_VERBOSE=1',
      'INSTALLDIRS=perl',
      'POLLUTE=1',
      ]
    );
  });
  ok $result, "passthrough Makefile.PL ran with arguments";
  ok -e 'Build.PL', "Build.PL generated";

  my $new_build = Module::Build->resume();
  is $new_build->installdirs, 'core', "installdirs is core";
  is $new_build->verbose, 1, "tests set for verbose";
  is $new_build->install_destination('lib'), $libdir, "custom libdir";
  is $new_build->extra_compiler_flags->[0], '-DPERL_POLLUTE', "PERL_POLLUTE set";

  # Make sure those switches actually had an effect
  my ($ran_ok, $output);
  $output = stdout_of( sub { $ran_ok = $new_build->do_system(@make, 'test') } );
  ok $ran_ok, "make test ran without error";
  $output =~ s/^/# /gm;  # Don't confuse our own test output
  like $output, qr/(?:# ok \d+\s+)+/, 'Should be verbose';

  # Make sure various Makefile arguments are supported
  my $make_macro = 'TEST_VERBOSE=0';

  # VMS MMK/MMS macros use different syntax.
  if ($is_vms_mms) {
    $make_macro = '/macro=("' . $make_macro . '")';
  }

  $output = stdout_of( sub {
    local $ENV{HARNESS_TIMER}; # RT#39635 - timer messes with output
    $ran_ok = $mb->do_system(@make, 'test', $make_macro)
  } );

  ok $ran_ok, "make test without verbose ran ok";
  $output =~ s/^/# /gm;  # Don't confuse our own test output
  like $output,
       qr/# .+basic(\.t)?[.\s#]+ok[.\s#]+All tests successful/,
       'Should be non-verbose';

  (my $libdir2 = $libdir) =~ s/libdir/lbiidr/;

  SKIP: {
    require ExtUtils::Install;
    skip "Needs ExtUtils::Install 1.32 or later", 2
      if ExtUtils::Install->VERSION < 1.32;

    my @make_args = ('INSTALLDIRS=vendor', "INSTALLVENDORLIB=$libdir2");

    if ($is_vms_mms) { # VMS MMK/MMS macros use different syntax.
      $make_args[0] = '/macro=("' . join('","',@make_args) . '")';
      pop @make_args while scalar(@make_args) > 1;
    }

    ($output) = stdout_stderr_of(
      sub {
        $ran_ok = $mb->do_system(@make, 'fakeinstall', @make_args);
      }
    );

    ok $ran_ok, "make fakeinstall with INSTALLDIRS=vendor ran ok";
    $output =~ s/^/# /gm;  # Don't confuse our own test output
    like $output,
        qr/\Q$libdir2\E .* Simple\.pm/ix,
        'Should have installdirs=vendor';
  }

  stdout_of( sub { $mb->do_system(@make, 'realclean'); } );
  ok ! -e $makefile, "$makefile shouldn't exist";

  1 while unlink 'Makefile.PL';
  ok ! -e 'Makefile.PL', "Makefile.PL cleaned up";

  1 while unlink $libdir, $libdir2;
}

{ # Make sure tilde-expansion works

  # C<glob> on MSWin32 uses $ENV{HOME} if defined to do tilde-expansion
  local $ENV{HOME} = 'C:/' if $^O =~ /MSWin/ && !exists( $ENV{HOME} );

  create_makefile_pl('passthrough', $mb);

  stdout_of( sub {
    $mb->run_perl_script('Makefile.PL', [], ['INSTALL_BASE=~/foo']);
  });
  my $b2 = Module::Build->current;
  ok $b2->install_base, "install_base set";
  unlike $b2->install_base, qr/^~/, "Tildes should be expanded";
  
  stdout_of( sub { $mb->do_system(@make, 'realclean'); } );
  ok ! -e $makefile, "$makefile shouldn't exist";

  1 while unlink 'Makefile.PL';
  ok ! -e 'Makefile.PL', "Makefile.PL cleaned up";
}

# cleanup
$dist->remove;

#########################################################

sub test_makefile_types {
  my %opts = @_;
  $opts{requires} ||= {};
  $opts{PL_files} ||= {};

  foreach my $type (@makefile_types) {
    # Create M::B instance 
    my $mb;
    stdout_of( sub {
        $mb = Module::Build->new_from_context;
    });
    ok $mb, "Module::Build->new_from_context";

    # Create and test Makefile.PL
    create_makefile_pl($type, $mb);

    test_makefile_pl_requires_perl( $opts{requires}{perl} );
    test_makefile_creation($mb);
    test_makefile_prereq_pm( $opts{requires} );
    test_makefile_pl_files( $opts{PL_files} ) if $type eq 'traditional';
      
    my ($output,$success);
    # Capture output to keep our STDOUT clean
    $output = stdout_of( sub {
      $success = $mb->do_system(@make);
    });
    ok $success, "make ran without error";

    for my $file (values %{ $opts{PL_files} }) {
        ok -e $file, "PL_files generated - $file";
    }

    # Can't let 'test' STDOUT go to our STDOUT, or it'll confuse Test::Harness.
    $output = stdout_of( sub {
      $success = $mb->do_system(@make, 'test');
    });
    ok $success, "make test ran without error";
    like uc $output, qr{DONE\.|SUCCESS}, "make test output indicated success";
    
    $output = stdout_of( sub {
      $success = $mb->do_system(@make, 'realclean');
    });
    ok $success, "make realclean ran without error";

    # Try again with some Makefile.PL arguments
    test_makefile_creation($mb, [], 'INSTALLDIRS=vendor', 'realclean');
    
    # Try again using distclean
    test_makefile_creation($mb, [], '', 'distclean');

    1 while unlink 'Makefile.PL';
    ok ! -e 'Makefile.PL', "cleaned up Makefile";
  }
}

sub test_makefile_creation {
  my ($build, $preargs, $postargs, $cleanup) = @_;
  
  my ($output, $result);
  # capture output to avoid polluting our test output
  $output = stdout_of( sub {
      $result = $build->run_perl_script('Makefile.PL', $preargs, $postargs);
  });
  my $label = "Makefile.PL ran without error";
  if ( defined $postargs && length $postargs ) {
    $label .= " (postargs: $postargs)";
  }
  ok $result, $label;
  ok -e $makefile, "$makefile exists";
  
  if ($cleanup) {
    # default to 'realclean' unless we recognize the clean method
    $cleanup = 'realclean' unless $cleanup =~ /^(dist|real)clean$/;
    my ($stdout, $stderr ) = stdout_stderr_of (sub {
      $build->do_system(@make, $cleanup);
    });
    ok ! -e $makefile, "$makefile cleaned up with $cleanup";
  }
  else {
    pass '(skipping cleanup)'; # keep test count constant
  }
}

sub test_makefile_prereq_pm {
  my %requires = %{ $_[0] };
  delete $requires{perl}; # until EU::MM supports this
  SKIP: {
    skip "$makefile not found", 1 unless -e $makefile;
    my $prereq_pm = find_params_in_makefile()->{PREREQ_PM} || {};
    is_deeply $prereq_pm, \%requires,
      "$makefile has correct PREREQ_PM line";
  }
}

sub test_makefile_pl_files {
  my $expected = shift;

  SKIP: {
    skip 1, 'Makefile.PL not found' unless -e 'Makefile.PL';
    my $args = extract_writemakefile_args() || {};
    is_deeply $args->{PL_FILES}, $expected,
      "Makefile.PL has correct PL_FILES line";
  }
}

sub test_makefile_pl_requires_perl {
  my $perl_version = shift || q{};
  SKIP: {
    skip 1, 'Makefile.PL not found' unless -e 'Makefile.PL';
    my $file_contents = slurp 'Makefile.PL';
    my $found_requires = $file_contents =~ m{^require $perl_version;}ms;
    if (length $perl_version) {
      ok $found_requires, "Makefile.PL has 'require $perl_version;'"
        or diag "Makefile.PL:\n$file_contents";
    }
    else {
      ok ! $found_requires, "Makefile.PL does not require a perl version";
    }
  }
}

sub find_params_in_makefile {
  my $fh = IO::File->new( $makefile, 'r' ) 
    or die "Can't read $makefile: $!";
  local($/) = "\n";

  my %params;
  while (<$fh>) {
    # Blank line after params.
    last if keys %params and !/\S+/;

    next unless m{^\# \s+ ( [A-Z_]+ ) \s+ => \s+ ( .* )$}x;

    my($key, $val) = ($1, $2);
    # extract keys and values
    while ( $val =~ m/(?:\s)(\S+)=>(q\[.*?\]|undef),?/g ) {
      my($m,$n) = ($1,$2);
      if ($n =~ /^q\[(.*?)\]$/) {
        $n = $1;
      }
      $params{$key}{$m} = $n;
    }
  }

  return \%params;
}

sub extract_writemakefile_args {
  SKIP: {
    skip 1, 'Makefile.PL not found' unless -e 'Makefile.PL';
    my $file_contents = slurp 'Makefile.PL';
    my ($args) = $file_contents =~ m{^WriteMakefile\n\((.*)\).*;}ms;
    ok $args, "Found WriteMakefile arguments"
        or diag "Makefile.PL:\n$file_contents";
    my %args = eval $args or diag $args; ## no critic
    return \%args;
  }
}

sub create_makefile_pl {
    Module::Build::Compat->create_makefile_pl(@_);
    my $ok = ok -e 'Makefile.PL', "$_[0] Makefile.PL created";

    # Some really conservative make's, like HP/UX, assume files with the same
    # timestamp are out of date.  Send the Makefile.PL one second into the past
    # so its older than the Makefile it will generate.
    # See [rt.cpan.org 45700]
    my $mtime = (stat("Makefile.PL"))[9];
    utime $mtime, $mtime - 1, "Makefile.PL";

    return $ok;
}
Commit	Line	Data
bb4e9162	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;
7a827510	7	use IO::File;
bb4e9162	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);
738349a8	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 ) {
15cb7b9d	21	plan 'no_plan';
bb4e9162	22	} else {
	23	plan skip_all => "Don't know how to invoke 'make'";
	24	}
738349a8	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');
bb4e9162	30
	31
	32	#########################
	33
7a827510	34	my $tmp = MBTest->tmpdir;
bb4e9162	35
7a827510	36	# Create test distribution; set requires and build_requires
bb4e9162	37	use DistGen;
	38	my $dist = DistGen->new( dir => $tmp );
	39	$dist->regen;
	40
738349a8	41	$dist->chdir_in;
bb4e9162	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
738349a8	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
bb4e9162	61	#########################
bb4e9162	62
7a827510	63	# Test without requires
bb4e9162	64
7a827510	65	test_makefile_types();
7a827510	66
15cb7b9d	67	# Test with requires and PL_files
7a827510	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	},
15cb7b9d	80	PL_files => { 'foo.PL' => 'foo' },
7a827510	81	});
7a827510	82
15cb7b9d	83	$dist->add_file("foo.PL", <<'END');
	84	open my $fh, ">$ARGV[0]" or die $!;
	85	print $fh "foo\n";
	86	END
	87
7a827510	88	$dist->regen;
7a827510	89
15cb7b9d	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	);
7a827510	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";
bb4e9162	115
bb4e9162	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; };
738349a8	122
738349a8	123	my $maketext = eval { Module::Build::Compat->fake_makefile(makefile => $makefile) };
7a827510	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'";
bb4e9162	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);
7a827510	133	my $foo_builder;
	134	stdout_of( sub {
	135	$foo_builder = Foo::Builder->new_from_context;
	136	});
bb4e9162	137	foreach my $style ('passthrough', 'small') {
94410036	138	create_makefile_pl($style, $foo_builder);
bb4e9162	139
bb4e9162	140	# Should fail with "can't find Foo/Builder.pm"
7a827510	141	my $result;
	142	my ($stdout, $stderr ) = stdout_stderr_of (sub {
	143	$result = $mb->run_perl_script('Makefile.PL');
	144	});
	145	ok ! $result, "Makefile.PL failed";
	146	like $stderr, qr{Foo/Builder.pm}, "custom builder wasn't found";
bb4e9162	147	}
	148
	149	# Now make sure it can actually work.
7a827510	150	my $bar_builder;
	151	stdout_of( sub {
	152	$bar_builder = Module::Build->subclass( class => 'Bar::Builder' )->new_from_context;
	153	});
bb4e9162	154	foreach my $style ('passthrough', 'small') {
94410036	155	create_makefile_pl($style, $bar_builder);
7a827510	156	my $result;
	157	stdout_of( sub {
	158	$result = $mb->run_perl_script('Makefile.PL');
	159	});
	160	ok $result, "Makefile.PL ran without error";
bb4e9162	161	}
	162	}
	163
	164	{
	165	# Make sure various Makefile.PL arguments are supported
94410036	166	create_makefile_pl('passthrough', $mb);
bb4e9162	167
738349a8	168	my $libdir = File::Spec->catdir( $tmp, 'libdir' );
7a827510	169	my $result;
	170	stdout_of( sub {
	171	$result = $mb->run_perl_script('Makefile.PL', [],
	172	[
	173	"LIB=$libdir",
	174	'TEST_VERBOSE=1',
	175	'INSTALLDIRS=perl',
	176	'POLLUTE=1',
	177	]
	178	);
	179	});
	180	ok $result, "passthrough Makefile.PL ran with arguments";
	181	ok -e 'Build.PL', "Build.PL generated";
bb4e9162	182
bb4e9162	183	my $new_build = Module::Build->resume();
7a827510	184	is $new_build->installdirs, 'core', "installdirs is core";
	185	is $new_build->verbose, 1, "tests set for verbose";
	186	is $new_build->install_destination('lib'), $libdir, "custom libdir";
	187	is $new_build->extra_compiler_flags->[0], '-DPERL_POLLUTE', "PERL_POLLUTE set";
bb4e9162	188
	189	# Make sure those switches actually had an effect
	190	my ($ran_ok, $output);
	191	$output = stdout_of( sub { $ran_ok = $new_build->do_system(@make, 'test') } );
7a827510	192	ok $ran_ok, "make test ran without error";
bb4e9162	193	$output =~ s/^/# /gm; # Don't confuse our own test output
	194	like $output, qr/(?:# ok \d+\s+)+/, 'Should be verbose';
	195
	196	# Make sure various Makefile arguments are supported
738349a8	197	my $make_macro = 'TEST_VERBOSE=0';
	198
	199	# VMS MMK/MMS macros use different syntax.
	200	if ($is_vms_mms) {
	201	$make_macro = '/macro=("' . $make_macro . '")';
	202	}
	203
	204	$output = stdout_of( sub {
798f208d	205	local $ENV{HARNESS_TIMER}; # RT#39635 - timer messes with output
738349a8	206	$ran_ok = $mb->do_system(@make, 'test', $make_macro)
	207	} );
	208
7a827510	209	ok $ran_ok, "make test without verbose ran ok";
bb4e9162	210	$output =~ s/^/# /gm; # Don't confuse our own test output
ba889e8f	211	like $output,
738349a8	212	qr/# .+basic(\.t)?[.\s#]+ok[.\s#]+All tests successful/,
738349a8	213	'Should be non-verbose';
bb4e9162	214
738349a8	215	(my $libdir2 = $libdir) =~ s/libdir/lbiidr/;
738349a8	216
66e531b6	217	SKIP: {
	218	require ExtUtils::Install;
	219	skip "Needs ExtUtils::Install 1.32 or later", 2
	220	if ExtUtils::Install->VERSION < 1.32;
	221
	222	my @make_args = ('INSTALLDIRS=vendor', "INSTALLVENDORLIB=$libdir2");
	223
	224	if ($is_vms_mms) { # VMS MMK/MMS macros use different syntax.
	225	$make_args[0] = '/macro=("' . join('","',@make_args) . '")';
	226	pop @make_args while scalar(@make_args) > 1;
738349a8	227	}
738349a8	228
66e531b6	229	($output) = stdout_stderr_of(
	230	sub {
	231	$ran_ok = $mb->do_system(@make, 'fakeinstall', @make_args);
	232	}
	233	);
	234
	235	ok $ran_ok, "make fakeinstall with INSTALLDIRS=vendor ran ok";
	236	$output =~ s/^/# /gm; # Don't confuse our own test output
	237	like $output,
86bddcbf	238	qr/\Q$libdir2\E .* Simple\.pm/ix,
66e531b6	239	'Should have installdirs=vendor';
66e531b6	240	}
bb4e9162	241
7a827510	242	stdout_of( sub { $mb->do_system(@make, 'realclean'); } );
738349a8	243	ok ! -e $makefile, "$makefile shouldn't exist";
bb4e9162	244
bb4e9162	245	1 while unlink 'Makefile.PL';
7a827510	246	ok ! -e 'Makefile.PL', "Makefile.PL cleaned up";
738349a8	247
738349a8	248	1 while unlink $libdir, $libdir2;
bb4e9162	249	}
	250
	251	{ # Make sure tilde-expansion works
	252
	253	# C<glob> on MSWin32 uses $ENV{HOME} if defined to do tilde-expansion
	254	local $ENV{HOME} = 'C:/' if $^O =~ /MSWin/ && !exists( $ENV{HOME} );
	255
94410036	256	create_makefile_pl('passthrough', $mb);
bb4e9162	257
7a827510	258	stdout_of( sub {
	259	$mb->run_perl_script('Makefile.PL', [], ['INSTALL_BASE=~/foo']);
	260	});
bb4e9162	261	my $b2 = Module::Build->current;
7a827510	262	ok $b2->install_base, "install_base set";
bb4e9162	263	unlike $b2->install_base, qr/^~/, "Tildes should be expanded";
bb4e9162	264
7a827510	265	stdout_of( sub { $mb->do_system(@make, 'realclean'); } );
738349a8	266	ok ! -e $makefile, "$makefile shouldn't exist";
7a827510	267
bb4e9162	268	1 while unlink 'Makefile.PL';
7a827510	269	ok ! -e 'Makefile.PL', "Makefile.PL cleaned up";
bb4e9162	270	}
7a827510	271
738349a8	272	# cleanup
	273	$dist->remove;
	274
bb4e9162	275	#########################################################
bb4e9162	276
7a827510	277	sub test_makefile_types {
	278	my %opts = @_;
	279	$opts{requires} \|\|= {};
15cb7b9d	280	$opts{PL_files} \|\|= {};
7a827510	281
	282	foreach my $type (@makefile_types) {
	283	# Create M::B instance
	284	my $mb;
	285	stdout_of( sub {
	286	$mb = Module::Build->new_from_context;
	287	});
	288	ok $mb, "Module::Build->new_from_context";
	289
	290	# Create and test Makefile.PL
94410036	291	create_makefile_pl($type, $mb);
94410036	292
7a827510	293	test_makefile_pl_requires_perl( $opts{requires}{perl} );
	294	test_makefile_creation($mb);
	295	test_makefile_prereq_pm( $opts{requires} );
15cb7b9d	296	test_makefile_pl_files( $opts{PL_files} ) if $type eq 'traditional';
7a827510	297
	298	my ($output,$success);
	299	# Capture output to keep our STDOUT clean
	300	$output = stdout_of( sub {
	301	$success = $mb->do_system(@make);
	302	});
	303	ok $success, "make ran without error";
	304
15cb7b9d	305	for my $file (values %{ $opts{PL_files} }) {
	306	ok -e $file, "PL_files generated - $file";
	307	}
	308
7a827510	309	# Can't let 'test' STDOUT go to our STDOUT, or it'll confuse Test::Harness.
	310	$output = stdout_of( sub {
	311	$success = $mb->do_system(@make, 'test');
	312	});
	313	ok $success, "make test ran without error";
	314	like uc $output, qr{DONE\.\|SUCCESS}, "make test output indicated success";
	315
	316	$output = stdout_of( sub {
	317	$success = $mb->do_system(@make, 'realclean');
	318	});
	319	ok $success, "make realclean ran without error";
	320
	321	# Try again with some Makefile.PL arguments
94410036	322	test_makefile_creation($mb, [], 'INSTALLDIRS=vendor', 'realclean');
7a827510	323
94410036	324	# Try again using distclean
	325	test_makefile_creation($mb, [], '', 'distclean');
	326
7a827510	327	1 while unlink 'Makefile.PL';
	328	ok ! -e 'Makefile.PL', "cleaned up Makefile";
	329	}
	330	}
	331
bb4e9162	332	sub test_makefile_creation {
	333	my ($build, $preargs, $postargs, $cleanup) = @_;
	334
7a827510	335	my ($output, $result);
	336	# capture output to avoid polluting our test output
	337	$output = stdout_of( sub {
	338	$result = $build->run_perl_script('Makefile.PL', $preargs, $postargs);
	339	});
	340	my $label = "Makefile.PL ran without error";
	341	if ( defined $postargs && length $postargs ) {
	342	$label .= " (postargs: $postargs)";
	343	}
	344	ok $result, $label;
738349a8	345	ok -e $makefile, "$makefile exists";
bb4e9162	346
bb4e9162	347	if ($cleanup) {
94410036	348	# default to 'realclean' unless we recognize the clean method
	349	$cleanup = 'realclean' unless $cleanup =~ /^(dist\|real)clean$/;
	350	my ($stdout, $stderr ) = stdout_stderr_of (sub {
	351	$build->do_system(@make, $cleanup);
7a827510	352	});
94410036	353	ok ! -e $makefile, "$makefile cleaned up with $cleanup";
7a827510	354	}
	355	else {
	356	pass '(skipping cleanup)'; # keep test count constant
bb4e9162	357	}
	358	}
	359
7a827510	360	sub test_makefile_prereq_pm {
	361	my %requires = %{ $_[0] };
	362	delete $requires{perl}; # until EU::MM supports this
	363	SKIP: {
738349a8	364	skip "$makefile not found", 1 unless -e $makefile;
15cb7b9d	365	my $prereq_pm = find_params_in_makefile()->{PREREQ_PM} \|\| {};
7a827510	366	is_deeply $prereq_pm, \%requires,
738349a8	367	"$makefile has correct PREREQ_PM line";
7a827510	368	}
	369	}
	370
15cb7b9d	371	sub test_makefile_pl_files {
	372	my $expected = shift;
	373
	374	SKIP: {
94410036	375	skip 1, 'Makefile.PL not found' unless -e 'Makefile.PL';
	376	my $args = extract_writemakefile_args() \|\| {};
	377	is_deeply $args->{PL_FILES}, $expected,
	378	"Makefile.PL has correct PL_FILES line";
15cb7b9d	379	}
	380	}
	381
7a827510	382	sub test_makefile_pl_requires_perl {
	383	my $perl_version = shift \|\| q{};
	384	SKIP: {
94410036	385	skip 1, 'Makefile.PL not found' unless -e 'Makefile.PL';
7a827510	386	my $file_contents = slurp 'Makefile.PL';
	387	my $found_requires = $file_contents =~ m{^require $perl_version;}ms;
	388	if (length $perl_version) {
	389	ok $found_requires, "Makefile.PL has 'require $perl_version;'"
	390	or diag "Makefile.PL:\n$file_contents";
	391	}
	392	else {
	393	ok ! $found_requires, "Makefile.PL does not require a perl version";
	394	}
	395	}
	396	}
	397
15cb7b9d	398	sub find_params_in_makefile {
738349a8	399	my $fh = IO::File->new( $makefile, 'r' )
738349a8	400	or die "Can't read $makefile: $!";
7a827510	401	local($/) = "\n";
15cb7b9d	402
15cb7b9d	403	my %params;
7a827510	404	while (<$fh>) {
15cb7b9d	405	# Blank line after params.
	406	last if keys %params and !/\S+/;
	407
	408	next unless m{^\# \s+ ( [A-Z_]+ ) \s+ => \s+ ( .* )$}x;
	409
	410	my($key, $val) = ($1, $2);
	411	# extract keys and values
	412	while ( $val =~ m/(?:\s)(\S+)=>(q\[.*?\]\|undef),?/g ) {
7a827510	413	my($m,$n) = ($1,$2);
	414	if ($n =~ /^q\[(.*?)\]$/) {
	415	$n = $1;
	416	}
15cb7b9d	417	$params{$key}{$m} = $n;
7a827510	418	}
7a827510	419	}
15cb7b9d	420
15cb7b9d	421	return \%params;
7a827510	422	}
94410036	423
	424	sub extract_writemakefile_args {
	425	SKIP: {
	426	skip 1, 'Makefile.PL not found' unless -e 'Makefile.PL';
	427	my $file_contents = slurp 'Makefile.PL';
	428	my ($args) = $file_contents =~ m{^WriteMakefile\n\((.)\).;}ms;
	429	ok $args, "Found WriteMakefile arguments"
	430	or diag "Makefile.PL:\n$file_contents";
	431	my %args = eval $args or diag $args; ## no critic
	432	return \%args;
	433	}
	434	}
	435
	436	sub create_makefile_pl {
	437	Module::Build::Compat->create_makefile_pl(@_);
	438	my $ok = ok -e 'Makefile.PL', "$_[0] Makefile.PL created";
	439
	440	# Some really conservative make's, like HP/UX, assume files with the same
	441	# timestamp are out of date. Send the Makefile.PL one second into the past
	442	# so its older than the Makefile it will generate.
	443	# See [rt.cpan.org 45700]
	444	my $mtime = (stat("Makefile.PL"))[9];
	445	utime $mtime, $mtime - 1, "Makefile.PL";
	446
	447	return $ok;
	448	}