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

#!/usr/bin/perl -w

use strict;
use 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);

blib_load('Module::Build');
blib_load('Module::Build::Version');


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

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;


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

blib_load('Module::Build');
blib_load('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.2,
  },
  build_requires => {
      'Test::More' => 0,
      'File::Spec' => 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.2,
    },
    build_requires => {
        'Test::More' => 0,
        'File::Spec' => 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_stderr_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_stderr_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_stderr_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_stderr_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_stderr_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_stderr_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_stderr_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/;
  my $libarch2 = File::Spec->catdir($libdir2, 'arch');

  SKIP: {
    my @cases = (
      {
        label => "INSTALLDIRS=vendor",
        args => [ 'INSTALLDIRS=vendor', "INSTALLVENDORLIB=$libdir2", "INSTALLVENDORARCH=$libarch2"],
        check => qr/\Q$libdir2\E .* Simple\.pm/ix,
      },
      {
        label => "PREFIX=\$libdir2",
        args => [ "PREFIX=$libdir2"],
        check => qr/\Q$libdir2\E .* Simple\.pm/ix,
      },
      {
        label => "PREFIX=\$libdir2 LIB=mylib",
        args => [ "PREFIX=$libdir2", "LIB=mylib" ],
        check => qr{\Q$libdir2\E[/\\]mylib[/\\]Simple\.pm}ix,
      },
    );

    require ExtUtils::Install;
    skip "Needs ExtUtils::Install 1.32 or later", 2 * @cases
      if ExtUtils::Install->VERSION < 1.32;

    for my $c (@cases) {
      my @make_args = @{$c->{args}}; 
      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 {
          $result = $mb->run_perl_script('Makefile.PL', [], \@make_args);
          $ran_ok = $mb->do_system(@make, 'fakeinstall');
        }
      );

      ok $ran_ok, "fakeinstall $c->{label} ran ok";
      $output =~ s/^/# /gm;  # Don't confuse our own test output
      like $output, $c->{check},
          "Saw destination directory for $c->{label}";
    }
  }

  stdout_stderr_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_stderr_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_stderr_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";
}

{
  $dist->add_file('t/deep/foo.t', q{});
  $dist->regen;

  my $mb;
  stdout_stderr_of( sub {
      $mb = Module::Build->new_from_context( recursive_test_files => 1 );
  });

  create_makefile_pl('traditional', $mb);
  my $args = extract_writemakefile_args() || {};

  if ( exists $args->{test}->{TESTS} ) {
    is $args->{test}->{TESTS},
      join( q{ },
        File::Spec->catfile(qw(t *.t)),
        File::Spec->catfile(qw(t deep *.t))
      ),
      'Makefile.PL has correct TESTS line for recursive test files';
  } else {
    ok( ! exists $args->{TESTS}, 'Not using incorrect recursive tests key' );
  }

}

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

sub _merge_prereqs {
  my ($first, $second) = @_;
  my $new = { %$first };
  for my $k (keys %$second) {
    if ( exists $new->{$k} ) {
      my ($v1,$v2) = ($new->{$k},$second->{$k});
      $new->{$k} = ($v1 > $v2 ? $v1 : $v2);
    }
    else {
      $new->{$k} = $second->{$k};
    }
  }
  return $new;
}

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

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