Author: kwilliams
Date: Mon Jul 23 19:55:37 2007
New Revision: 9791
Modified:
Module-Build/trunk/Changes
Module-Build/trunk/lib/Module/Build/Base.pm
Module-Build/trunk/lib/Module/Build/Compat.pm
Module-Build/trunk/t/compat.t
Module-Build/trunk/t/lib/MBTest.pm
Log:
David Golden attacks t/compat.t and fixes a couple bugs along the way
Modified: Module-Build/trunk/Changes
==============================================================================
--- Module-Build/trunk/Changes (original)
+++ Module-Build/trunk/Changes Mon Jul 23 19:55:37 2007
@@ -1,5 +1,15 @@
Revision history for Perl extension Module::Build.
+ - Module::Build::Compat adds "require 5.XXXXX" to Makefile.PL when
+ 'perl' is specified as a 'requires' prerequisite [David Golden]
+
+ - Refactored t/compat.t for modularity and transparency; added
+ labels for all tests; supressed subprocess output to
+ STDOUT and STDERR [David Golden]
+
+ - Fixed bug in perl_version_to_float when version is already a float
+ [David Golden]
+
- Removed a mention of $build->{config} from the documentation, the
official interface to Config.pm settings is now via the
$build->config() and has been for some time. [Suggested by Michael
Modified: Module-Build/trunk/lib/Module/Build/Base.pm
==============================================================================
--- Module-Build/trunk/lib/Module/Build/Base.pm (original)
+++ Module-Build/trunk/lib/Module/Build/Base.pm Mon Jul 23 19:55:37 2007
@@ -1189,6 +1189,7 @@
sub perl_version_to_float {
my ($self, $version) = @_;
+ return $version if grep( /\./, $version ) < 2;
$version =~ s/\./../;
$version =~ s/\.(\d+)/sprintf '%03d', $1/eg;
return $version;
Modified: Module-Build/trunk/lib/Module/Build/Compat.pm
==============================================================================
--- Module-Build/trunk/lib/Module/Build/Compat.pm (original)
+++ Module-Build/trunk/lib/Module/Build/Compat.pm Mon Jul 23 19:55:37 2007
@@ -42,6 +42,13 @@
print {$fh} "# Note: this file was auto-generated by ", __PACKAGE__, "
version $VERSION\n";
+ # Minimum perl version should be specified as "require 5.XXXXXX" in
+ # Makefile.PL
+ my $requires = $build->requires;
+ if ( my $minimum_perl = $requires->{perl} ) {
+ print {$fh} "require $minimum_perl;\n";
+ }
+
# If a *bundled* custom subclass is being used, make sure we add its
# directory to @INC.
my $subclass_load = '';
Modified: Module-Build/trunk/t/compat.t
==============================================================================
--- Module-Build/trunk/t/compat.t (original)
+++ Module-Build/trunk/t/compat.t Mon Jul 23 19:55:37 2007
@@ -4,6 +4,7 @@
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
@@ -12,13 +13,13 @@
delete @[EMAIL PROTECTED];
my @makefile_types = qw(small passthrough traditional);
-my $tests_per_type = 10;
+my $tests_per_type = 14;
if ( $Config{make} && find_in_path($Config{make}) ) {
- plan tests => 30 + @makefile_types*$tests_per_type;
+ plan tests => 38 + @makefile_types*$tests_per_type*2;
} else {
plan skip_all => "Don't know how to invoke 'make'";
}
-ok(1); # Loaded
+ok 1, "Loaded";
#########################
@@ -27,6 +28,7 @@
my $cwd = Cwd::cwd;
my $tmp = File::Spec->catdir( $cwd, 't', '_tmp' );
+# Create test distribution; set requires and build_requires
use DistGen;
my $dist = DistGen->new( dir => $tmp );
$dist->regen;
@@ -45,32 +47,48 @@
#########################
+# Test without requires
-my $mb = Module::Build->new_from_context;
-ok $mb;
+test_makefile_types();
+
+# Test with requires
+
+my $distname = $dist->name;
+$dist->change_build_pl({
+ module_name => $distname,
+ license => 'perl',
+ requires => {
+ 'perl' => $],
+ 'File::Spec' => 0,
+ },
+ build_requires => {
+ 'Test::More' => 0,
+ },
+});
+
+$dist->regen;
+
+test_makefile_types( requires => {
+ 'perl' => $],
+ 'File::Spec' => 0,
+ 'Test::More' => 0,
+});
+
+######################
+
+$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";
-foreach my $type (@makefile_types) {
- Module::Build::Compat->create_makefile_pl($type, $mb);
- test_makefile_creation($mb);
-
- ok $mb->do_system(@make);
-
- # Can't let 'test' STDOUT go to our STDOUT, or it'll confuse Test::Harness.
- my $success;
- my $output = stdout_of( sub {
- $success = $mb->do_system(@make, 'test');
- } );
- ok $success;
- like uc $output, qr{DONE\.|SUCCESS};
-
- ok $mb->do_system(@make, 'realclean');
-
- # Try again with some Makefile.PL arguments
- test_makefile_creation($mb, [], 'INSTALLDIRS=vendor', 1);
-
- 1 while unlink 'Makefile.PL';
- ok ! -e 'Makefile.PL';
-}
{
# Make sure fake_makefile() can run without 'build_class', as it may be
@@ -78,35 +96,45 @@
my $warning = '';
local $SIG{__WARN__} = sub { $warning = shift; };
my $maketext = eval { Module::Build::Compat->fake_makefile(makefile =>
'Makefile') };
- is $@, '';
- like $maketext, qr/^realclean/m;
- like $warning, qr/build_class/;
+ 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 = Foo::Builder->new_from_context;
+ my $foo_builder;
+ stdout_of( sub {
+ $foo_builder = Foo::Builder->new_from_context;
+ });
foreach my $style ('passthrough', 'small') {
Module::Build::Compat->create_makefile_pl($style, $foo_builder);
- ok -e 'Makefile.PL';
+ ok -e 'Makefile.PL', "$style Makefile.PL created";
# Should fail with "can't find Foo/Builder.pm"
- my $warning = stderr_of
- (sub {
- my $result = $mb->run_perl_script('Makefile.PL');
- ok ! $result;
- });
- like $warning, qr{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 = Module::Build->subclass( class => 'Bar::Builder'
)->new_from_context;
+ my $bar_builder;
+ stdout_of( sub {
+ $bar_builder = Module::Build->subclass( class => 'Bar::Builder'
)->new_from_context;
+ });
foreach my $style ('passthrough', 'small') {
Module::Build::Compat->create_makefile_pl($style, $bar_builder);
- ok -e 'Makefile.PL';
- ok $mb->run_perl_script('Makefile.PL');
+ ok -e 'Makefile.PL', "$style Makefile.PL created via subclass";
+ my $result;
+ stdout_of( sub {
+ $result = $mb->run_perl_script('Makefile.PL');
+ });
+ ok $result, "Makefile.PL ran without error";
}
}
@@ -115,33 +143,36 @@
Module::Build::Compat->create_makefile_pl('passthrough', $mb);
my $libdir = File::Spec->catdir( $cwd, 't', 'libdir' );
- my $result = $mb->run_perl_script('Makefile.PL', [],
- [
- "LIB=$libdir",
- 'TEST_VERBOSE=1',
- 'INSTALLDIRS=perl',
- 'POLLUTE=1',
- ]
- );
- ok $result;
- ok -e 'Build.PL';
+ 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';
- is $new_build->verbose, 1;
- is $new_build->install_destination('lib'), $libdir;
- is $new_build->extra_compiler_flags->[0], '-DPERL_POLLUTE';
+ 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;
+ 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
$output = stdout_of( sub { $ran_ok = $mb->do_system(@make, 'test',
'TEST_VERBOSE=0') } );
- ok $ran_ok;
+ ok $ran_ok, "make test without verbose ran ok";
$output =~ s/^/# /gm; # Don't confuse our own test output
like $output, qr/(?:# .+basic\.+ok\s+(?:[\d.]+\s*m?s\s*)?)# All tests/,
'Should be non-verbose';
@@ -149,11 +180,11 @@
$mb->delete_filetree($libdir);
ok ! -e $libdir, "Sample installation directory should be cleaned up";
- $mb->do_system(@make, 'realclean');
+ stdout_of( sub { $mb->do_system(@make, 'realclean'); } );
ok ! -e 'Makefile', "Makefile shouldn't exist";
1 while unlink 'Makefile.PL';
- ok ! -e 'Makefile.PL';
+ ok ! -e 'Makefile.PL', "Makefile.PL cleaned up";
}
{ # Make sure tilde-expansion works
@@ -163,29 +194,148 @@
Module::Build::Compat->create_makefile_pl('passthrough', $mb);
- $mb->run_perl_script('Makefile.PL', [], ['INSTALL_BASE=~/foo']);
+ stdout_of( sub {
+ $mb->run_perl_script('Makefile.PL', [], ['INSTALL_BASE=~/foo']);
+ });
my $b2 = Module::Build->current;
- ok $b2->install_base;
+ ok $b2->install_base, "install_base set";
unlike $b2->install_base, qr/^~/, "Tildes should be expanded";
- $mb->do_system(@make, 'realclean');
+ 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";
}
+
#########################################################
+sub test_makefile_types {
+ my %opts = @_;
+ $opts{requires} ||= {};
+
+ 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
+ Module::Build::Compat->create_makefile_pl($type, $mb);
+ ok -e 'Makefile.PL', "$type Makefile.PL created";
+ test_makefile_pl_requires_perl( $opts{requires}{perl} );
+ test_makefile_creation($mb);
+ test_makefile_prereq_pm( $opts{requires} );
+
+ 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";
+
+ # 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', 1);
+
+ 1 while unlink 'Makefile.PL';
+ ok ! -e 'Makefile.PL', "cleaned up Makefile";
+ }
+}
+
sub test_makefile_creation {
my ($build, $preargs, $postargs, $cleanup) = @_;
- my $result = $build->run_perl_script('Makefile.PL', $preargs, $postargs);
- ok $result;
- ok -e 'Makefile', "Makefile should exist";
+ 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) {
- $build->do_system(@make, 'realclean');
- ok ! -e 'Makefile', "Makefile shouldn't exist";
+ $output = stdout_of( sub {
+ $build->do_system(@make, 'realclean');
+ });
+ ok ! -e 'Makefile', "Makefile cleaned up";
+ }
+ 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_makefile_prereq_pm();
+ is_deeply $prereq_pm, \%requires,
+ "Makefile has correct PREREQ_PM line";
+ }
+}
+
+sub test_makefile_pl_requires_perl {
+ my $perl_version = shift || q{};
+ SKIP: {
+ skip 'Makefile.PL not found', 1 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";
+ }
+ }
+}
+
+# Following subroutine adapted from code in CPAN.pm
+# by Andreas Koenig and A. Speer.
+sub find_makefile_prereq_pm {
+ my $fh = IO::File->new( 'Makefile', 'r' )
+ or die "Can't read Makefile: $!";
+ my $req = {};
+ local($/) = "\n";
+ while (<$fh>) {
+ # locate PREREQ_PM
+ last if /MakeMaker post_initialize section/;
+ my($p) = m{^[\#]
+ \s+PREREQ_PM\s+=>\s+(.+)
+ }x;
+ next unless $p;
+
+ # extract modules
+ while ( $p =~ m/(?:\s)([\w\:]+)=>(q\[.*?\]|undef),?/g ){
+ my($m,$n) = ($1,$2);
+ if ($n =~ /^q\[(.*?)\]$/) {
+ $n = $1;
+ }
+ $req->{$m} = $n;
+ }
+ last;
+ }
+ return $req;
+}
# cleanup
chdir( $cwd ) or die "Can''t chdir to '$cwd': $!";
Modified: Module-Build/trunk/t/lib/MBTest.pm
==============================================================================
--- Module-Build/trunk/t/lib/MBTest.pm (original)
+++ Module-Build/trunk/t/lib/MBTest.pm Mon Jul 23 19:55:37 2007
@@ -44,14 +44,24 @@
# We have a few extra exports, but Test::More has a special import()
# that won't take extra additions.
-my @extra_exports = qw(stdout_of stderr_of slurp find_in_path check_compiler
have_module);
+my @extra_exports = qw(stdout_of stderr_of stdout_stderr_of slurp find_in_path
check_compiler have_module);
push @EXPORT, @extra_exports;
__PACKAGE__->export(scalar caller, @extra_exports);
+# Setup a temp directory if it doesn't exist
+use Cwd ();
+my $cwd = Cwd::cwd;
+my $tmp = File::Spec->catdir( $cwd, 't', '_tmp' );
+mkdir $tmp unless -d $tmp;
+
+# backwards compatible temp filename recipe adapted from perlfaq
+my $tmp_count = 0;
+my $tmp_base_name = sprintf("%d-%d", $$, time());
+sub temp_file_name { sprintf("%s-%04d", $tmp_base_name, ++$tmp_count) }
sub save_handle {
my ($handle, $subr) = @_;
- my $outfile = 'save_out';
+ my $outfile = temp_file_name();
local *SAVEOUT;
open SAVEOUT, ">&" . fileno($handle) or die "Can't save output handle: $!";
@@ -67,6 +77,14 @@
sub stdout_of { save_handle(\*STDOUT, @_) }
sub stderr_of { save_handle(\*STDERR, @_) }
+sub stdout_stderr_of {
+ my $subr = shift;
+ my ($stdout, $stderr);
+ $stdout = stdout_of ( sub {
+ $stderr = stderr_of( $subr )
+ });
+ return ($stdout, $stderr);
+}
sub slurp {
my $fh = IO::File->new($_[0]) or die "Can't open $_[0]: $!";
