From: Steve Peters <steve@fisharerojo.org>
Date: Tue, 8 May 2007 16:34:36 +0000 (+0000)
Subject: Upgrade to Module-Build-0.2808
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c1d8f74eb4326dca73e3ac3f73812dff8489ecf7;p=p5sagit%2Fp5-mst-13.2.git

Upgrade to Module-Build-0.2808

p4raw-id: //depot/perl@31171
---

diff --git a/MANIFEST b/MANIFEST
index 3510276..cc8d430 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2125,6 +2125,7 @@ lib/Module/Build/t/destinations.t	Module::Build
 lib/Module/Build/t/extend.t	Module::Build
 lib/Module/Build/t/ext.t	Module::Build
 lib/Module/Build/t/files.t	Module::Build
+lib/Module/Build/t/help.t	Module::Build
 lib/Module/Build/t/install.t	Module::Build
 lib/Module/Build/t/lib/DistGen.pm	Module::Build
 lib/Module/Build/t/lib/MBTest.pm	Module::Build
@@ -2136,6 +2137,7 @@ lib/Module/Build/t/moduleinfo.t	Module::Build
 lib/Module/Build/t/new_from_context.t	Module::Build
 lib/Module/Build/t/notes.t	Module::Build
 lib/Module/Build/t/parents.t	Module::Build
+lib/Module/Build/t/par.t	Module::Build
 lib/Module/Build/t/pod_parser.t	Module::Build
 lib/Module/Build/t/ppm.t	Module::Build
 lib/Module/Build/t/runthrough.t	Module::Build
diff --git a/lib/Module/Build.pm b/lib/Module/Build.pm
index aa9db8a..978b833 100644
--- a/lib/Module/Build.pm
+++ b/lib/Module/Build.pm
@@ -15,7 +15,7 @@ use Module::Build::Base;
 
 use vars qw($VERSION @ISA);
 @ISA = qw(Module::Build::Base);
-$VERSION = '0.2807';
+$VERSION = '0.2808';
 $VERSION = eval $VERSION;
 
 # Okay, this is the brute-force method of finding out what kind of
@@ -95,6 +95,10 @@ if (grep {-e File::Spec->catfile($_, qw(Module Build Platform), $^O) . '.pm'} @I
 
 sub os_type { $OSTYPES{$^O} }
 
+sub is_vmsish { return ((os_type() || '') eq 'VMS') }
+sub is_windowsish { return ((os_type() || '') eq 'Windows') }
+sub is_unixish { return ((os_type() || '') eq 'Unix') }
+
 1;
 
 __END__
diff --git a/lib/Module/Build/API.pod b/lib/Module/Build/API.pod
index cbb7ebb..c7b8cbf 100644
--- a/lib/Module/Build/API.pod
+++ b/lib/Module/Build/API.pod
@@ -1295,6 +1295,18 @@ whatever is appropriate.  If you're running on an unknown platform, it
 will return C<undef> - there shouldn't be many unknown platforms
 though.
 
+=item is_vmsish()
+
+=item is_windowsish()
+
+=item is_unixish()
+
+Convenience functions that return a boolean value indicating whether
+this platform behaves respectively like VMS, Windows, or Unix.  For
+arbitrary reasons other platforms don't get their own such functions,
+at least not yet.
+
+
 =item prefix_relpaths()
 
 =item prefix_relpaths($installdirs)
diff --git a/lib/Module/Build/Base.pm b/lib/Module/Build/Base.pm
index 7e9b503..0cc78e6 100644
--- a/lib/Module/Build/Base.pm
+++ b/lib/Module/Build/Base.pm
@@ -1630,6 +1630,10 @@ sub read_args {
   }
   $args{ARGV} = \@argv;
 
+  for ('extra_compiler_flags', 'extra_linker_flags') {
+    $args{$_} = [ $self->split_like_shell($args{$_}) ] if exists $args{$_};
+  }
+
   # Hashify these parameters
   for ($self->hash_properties, 'config') {
     next unless exists $args{$_};
@@ -1674,6 +1678,8 @@ sub read_args {
 }
 
 
+# (bash shell won't expand tildes mid-word: "--foo=~/thing")
+# TODO: handle ~user/foo
 sub _detildefy {
     my $arg = shift;
 
@@ -1862,6 +1868,7 @@ sub get_action_docs {
   my ($files_found, @docs) = (0);
   foreach my $class ($self->super_classes) {
     (my $file = $class) =~ s{::}{/}g;
+    # NOTE: silently skipping relative paths if any chdir() happened
     $file = $INC{$file . '.pm'} or next;
     my $fh = IO::File->new("< $file") or next;
     $files_found++;
@@ -1874,20 +1881,41 @@ sub get_action_docs {
       last if /^=head1 ACTIONS\s/;
     }
 
-    # Look for our action
-    my ($found, $inlist) = (0, 0);
+    # Look for our action and determine the style
+    my $style;
     while (<$fh>) {
-      if (/^=item\s+\Q$action\E\b/)  {
-        $found = 1;
-      } elsif (/^=(item|back)/) {
-        last if $found > 1 and not $inlist;
+      last if /^=head1 /;
+
+      # only item and head2 are allowed (3&4 are not in 5.005)
+      if(/^=(item|head2)\s+\Q$action\E\b/) {
+        $style = $1;
+        push @docs, $_;
+        last;
       }
-      next unless $found;
-      push @docs, $_;
-      ++$inlist if /^=over/;
-      --$inlist if /^=back/;
-      ++$found  if /^\w/; # Found descriptive text
     }
+    $style or next; # not here
+
+    # and the content
+    if($style eq 'item') {
+      my ($found, $inlist) = (0, 0);
+      while (<$fh>) {
+        if (/^=(item|back)/) {
+          last unless $inlist;
+        }
+        push @docs, $_;
+        ++$inlist if /^=over/;
+        --$inlist if /^=back/;
+      }
+    }
+    else { # head2 style
+      # stop at anything equal or greater than the found level
+      while (<$fh>) {
+        last if(/^=(?:head[12]|cut)/);
+        push @docs, $_;
+      }
+    }
+    # TODO maybe disallow overriding just pod for an action
+    # TODO and possibly: @docs and last;
   }
 
   unless ($files_found) {
@@ -2261,7 +2289,7 @@ sub process_script_files {
   
   foreach my $file (keys %$files) {
     my $result = $self->copy_if_modified($file, $script_dir, 'flatten') or next;
-    $self->fix_shebang_line($result) unless $self->os_type eq 'VMS';
+    $self->fix_shebang_line($result) unless $self->is_vmsish;
     $self->make_executable($result);
   }
 }
@@ -2348,7 +2376,7 @@ sub _find_file_by_type {
 
 sub localize_file_path {
   my ($self, $path) = @_;
-  $path =~ s/\.\z// if $self->os_type eq 'VMS';
+  $path =~ s/\.\z// if $self->is_vmsish;
   return File::Spec->catfile( split m{/}, $path );
 }
 
@@ -2381,7 +2409,7 @@ sub fix_shebang_line { # Adapted from fixin() in ExtUtils::MM_Unix 1.35
     $shb .= qq{
 eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}'
     if 0; # not running under some shell
-} unless $self->os_type eq 'Windows'; # this won't work on win32, so don't
+} unless $self->is_windowsish; # this won't work on win32, so don't
     
     my $FIXOUT = IO::File->new(">$file.new")
       or die "Can't create new $file: $!\n";
@@ -2433,6 +2461,18 @@ sub ACTION_testpodcoverage {
     or die "The 'testpodcoverage' action requires ",
            "Test::Pod::Coverage version 1.00";
 
+  # TODO this needs test coverage!
+
+  # XXX work-around a bug in Test::Pod::Coverage previous to v1.09
+  # Make sure we test the module in blib/
+  local @INC = @INC;
+  my $p = $self->{properties};
+  unshift(@INC,
+    # XXX any reason to include arch?
+    File::Spec->catdir($p->{base_dir}, $self->blib, 'lib'),
+    #File::Spec->catdir($p->{base_dir}, $self->blib, 'arch')
+  );
+
   all_pod_coverage_ok();
 }
 
diff --git a/lib/Module/Build/Compat.pm b/lib/Module/Build/Compat.pm
index aea1960..c64dfc0 100644
--- a/lib/Module/Build/Compat.pm
+++ b/lib/Module/Build/Compat.pm
@@ -206,11 +206,11 @@ sub fake_makefile {
     warn "Unknown 'build_class', defaulting to 'Module::Build'\n";
     $args{build_class} = 'Module::Build';
   }
+  my $class = $args{build_class};
 
-  my $perl = $args{build_class}->find_perl_interpreter;
-  my $os_type = $args{build_class}->os_type;
-  my $noop = ($os_type eq 'Windows' ? 'rem>nul' :
-	      $os_type eq 'VMS'     ? 'Continue' :
+  my $perl = $class->find_perl_interpreter;
+  my $noop = ($class->is_windowsish ? 'rem>nul'  :
+	      $class->is_vmsish     ? 'Continue' :
 	      'true');
   my $Build = 'Build --makefile_env_macros 1';
 
@@ -226,7 +226,7 @@ force_do_it :
 	@ $noop
 EOF
 
-  foreach my $action ($args{build_class}->known_actions) {
+  foreach my $action ($class->known_actions) {
     next if $action =~ /^(all|realclean|force_do_it)$/;  # Don't double-define
     $maketext .= <<"EOF";
 $action : force_do_it
diff --git a/lib/Module/Build/Notes.pm b/lib/Module/Build/Notes.pm
index 6d14a99..aaabbc3 100644
--- a/lib/Module/Build/Notes.pm
+++ b/lib/Module/Build/Notes.pm
@@ -6,8 +6,6 @@ use strict;
 use Data::Dumper;
 use IO::File;
 
-use Carp; BEGIN{ $SIG{__DIE__} = \&carp::confess }
-
 sub new {
   my ($class, %args) = @_;
   my $file = delete $args{file} or die "Missing required parameter 'file' to new()";
diff --git a/lib/Module/Build/t/basic.t b/lib/Module/Build/t/basic.t
index d05ea42..57a8550 100644
--- a/lib/Module/Build/t/basic.t
+++ b/lib/Module/Build/t/basic.t
@@ -2,7 +2,7 @@
 
 use strict;
 use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
-use MBTest tests => 49;
+use MBTest tests => 52;
 
 use Cwd ();
 my $cwd = Cwd::cwd;
@@ -206,6 +206,14 @@ my \$build = Module::Build->new(
   ok $mb;
   is_deeply $mb->extra_compiler_flags, ['-I/foo', '-I/bar'], "Should split shell string into list";
   is_deeply $mb->extra_linker_flags,   ['-L/foo', '-L/bar'], "Should split shell string into list";
+
+  # Try again with command-line args
+  eval {Module::Build->run_perl_script('Build.PL', [], ['--extra_compiler_flags', '-I/foo -I/bar',
+							'--extra_linker_flags', '-L/foo -L/bar'])};
+  $mb = Module::Build->resume;
+  ok $mb;
+  is_deeply $mb->extra_compiler_flags, ['-I/foo', '-I/bar'], "Should split shell string into list";
+  is_deeply $mb->extra_linker_flags,   ['-L/foo', '-L/bar'], "Should split shell string into list";
 }
 
 
diff --git a/lib/Module/Build/t/help.t b/lib/Module/Build/t/help.t
new file mode 100644
index 0000000..ba42514
--- /dev/null
+++ b/lib/Module/Build/t/help.t
@@ -0,0 +1,279 @@
+#!/usr/bin/perl -w
+
+use strict;
+use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
+use MBTest 'no_plan';#tests => 0;
+
+use Cwd ();
+use File::Path ();
+
+my $cwd = Cwd::cwd();
+my $tmp = File::Spec->catdir($cwd, 't', '_tmp');
+
+use DistGen;
+
+my $dist = DistGen->new(dir => $tmp);
+
+
+$dist->regen;
+
+my $restart = sub {
+  $dist->clean();
+  chdir( $cwd );
+  File::Path::rmtree( $tmp );
+  # we're redefining the same package as we go, so...
+  delete($::{'MyModuleBuilder::'});
+  delete($INC{'MyModuleBuilder.pm'});
+  $dist->regen;
+  chdir($dist->dirname) or
+    die "Can't chdir to '@{[$dist->dirname]}': $!";
+};
+
+chdir($dist->dirname) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+
+use_ok 'Module::Build';
+
+########################################################################
+{ # check the =item style
+my $mb = Module::Build->subclass(
+  code => join "\n", map {s/^ {4}//; $_} split /\n/, <<'  ---',
+    =head1 ACTIONS
+
+    =over
+
+    =item foo
+
+    Does the foo thing.
+
+    =item bar
+
+    Does the bar thing.
+
+    =item help
+
+    Does the help thing.
+
+    You should probably not be seeing this.  That is, we haven't
+    overridden the help action, but we're able to override just the
+    docs?  That almost seems reasonable, but is probably wrong.
+
+    =back
+
+    =cut
+
+    sub ACTION_foo { die "fooey" }
+    sub ACTION_bar { die "barey" }
+    sub ACTION_baz { die "bazey" }
+
+    # guess we can have extra pod later 
+
+    =over
+
+    =item baz
+
+    Does the baz thing.
+
+    =back
+
+    =cut
+
+  ---
+  )->new(
+      module_name => $dist->name,
+  );
+
+ok $mb;
+can_ok($mb, 'ACTION_foo');
+
+foreach my $action (qw(foo bar baz)) { # typical usage
+  my $doc = $mb->get_action_docs($action);
+  ok($doc, "got doc for '$action'");
+  like($doc, qr/^=\w+ $action\n\nDoes the $action thing\./s,
+    'got the right doc');
+}
+
+{ # user typo'd the action name
+  ok( ! eval {$mb->get_action_docs('batz'); 1}, 'slap');
+  like($@, qr/No known action 'batz'/, 'informative error');
+}
+
+{ # XXX this one needs some thought
+  my $action = 'help';
+  my $doc = $mb->get_action_docs($action);
+  ok($doc, "got doc for '$action'");
+  0 and warn "help doc >\n$doc<\n";
+  TODO: {
+    local $TODO = 'Do we allow overrides on just docs?';
+    unlike($doc, qr/^=\w+ $action\n\nDoes the $action thing\./s,
+      'got the right doc');
+  }
+}
+} # end =item style
+$restart->();
+########################################################################
+if(0) { # the =item style without spanning =head1 sections
+my $mb = Module::Build->subclass(
+  code => join "\n", map {s/^ {4}//; $_} split /\n/, <<'  ---',
+    =head1 ACTIONS
+
+    =over
+
+    =item foo
+
+    Does the foo thing.
+
+    =item bar
+
+    Does the bar thing.
+
+    =back
+
+    =head1 thbbt
+
+    =over
+
+    =item baz
+
+    Should not see this.
+
+    =back
+
+    =cut
+
+    sub ACTION_foo { die "fooey" }
+    sub ACTION_bar { die "barey" }
+    sub ACTION_baz { die "bazey" }
+
+  ---
+  )->new(
+      module_name => $dist->name,
+  );
+
+ok $mb;
+can_ok($mb, 'ACTION_foo');
+
+foreach my $action (qw(foo bar)) { # typical usage
+  my $doc = $mb->get_action_docs($action);
+  ok($doc, "got doc for '$action'");
+  like($doc, qr/^=\w+ $action\n\nDoes the $action thing\./s,
+    'got the right doc');
+}
+is($mb->get_action_docs('baz'), undef, 'no jumping =head1 sections');
+
+} # end =item style without spanning =head1's
+$restart->();
+########################################################################
+TODO: { # the =item style with 'Actions' not 'ACTIONS'
+local $TODO = 'Support capitalized Actions section';
+my $mb = Module::Build->subclass(
+  code => join "\n", map {s/^ {4}//; $_} split /\n/, <<'  ---',
+    =head1 Actions
+
+    =over
+
+    =item foo
+
+    Does the foo thing.
+
+    =item bar
+
+    Does the bar thing.
+
+    =back
+
+    =cut
+
+    sub ACTION_foo { die "fooey" }
+    sub ACTION_bar { die "barey" }
+
+  ---
+  )->new(
+      module_name => $dist->name,
+  );
+
+foreach my $action (qw(foo bar)) { # typical usage
+  my $doc = $mb->get_action_docs($action);
+  ok($doc, "got doc for '$action'");
+  like($doc || 'undef', qr/^=\w+ $action\n\nDoes the $action thing\./s,
+    'got the right doc');
+}
+
+} # end =item style with Actions
+$restart->();
+########################################################################
+{ # check the =head2 style
+my $mb = Module::Build->subclass(
+  code => join "\n", map {s/^ {4}//; $_} split /\n/, <<'  ---',
+    =head1 ACTIONS
+
+    =head2 foo
+
+    Does the foo thing.
+
+    =head2 bar
+
+    Does the bar thing.
+
+    =head3 bears
+
+    Be careful with bears.
+
+    =cut
+
+    sub ACTION_foo { die "fooey" }
+    sub ACTION_bar { die "barey" }
+    sub ACTION_baz { die "bazey" }
+    sub ACTION_batz { die "batzey" }
+
+    # guess we can have extra pod later 
+    # Though, I do wonder whether we should allow them to mix...
+    # maybe everything should have to be head2?
+
+    =head2 baz
+
+    Does the baz thing.
+
+    =head4 What's a baz?
+
+    =head1 not this part
+
+    This is level 1, so the stuff about baz is done.
+
+    =head1 Thing
+
+    =head2 batz
+
+    This is not an action doc.
+
+    =cut
+
+  ---
+  )->new(
+      module_name => $dist->name,
+  );
+
+my %also = (
+  foo => '',
+  bar => "\n=head3 bears\n\nBe careful with bears.\n",
+  baz => "\n=head4 What's a baz\\?\n",
+);
+  
+foreach my $action (qw(foo bar baz)) {
+  my $doc = $mb->get_action_docs($action);
+  ok($doc, "got doc for '$action'");
+  my $and = $also{$action};
+  like($doc || 'undef',
+    qr/^=\w+ $action\n\nDoes the $action thing\.\n$and\n$/s,
+    'got the right doc');
+}
+is($mb->get_action_docs('batz'), undef, 'nothing after uplevel');
+
+} # end =head2 style
+########################################################################
+
+# cleanup
+$dist->clean();
+chdir( $cwd );
+File::Path::rmtree( $tmp );
+
+# vim:ts=2:sw=2:et:sta
diff --git a/lib/Module/Build/t/par.t b/lib/Module/Build/t/par.t
new file mode 100644
index 0000000..3f0b121
--- /dev/null
+++ b/lib/Module/Build/t/par.t
@@ -0,0 +1,94 @@
+#!/usr/bin/perl -w
+
+use strict;
+use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
+use MBTest;
+use Module::Build;
+use Module::Build::ConfigData;
+
+{
+  my ($have_c_compiler, $C_support_feature) = check_compiler();
+  if (! $C_support_feature) {
+    plan skip_all => 'C_support not enabled';
+  } elsif ( ! $have_c_compiler ) {
+    plan skip_all => 'C_support enabled, but no compiler found';
+  } elsif ( ! eval {require PAR::Dist; PAR::Dist->VERSION(0.17)} ) {
+    plan skip_all => "PAR::Dist 0.17 or up not installed to check .par's.";
+  } elsif ( ! eval {require Archive::Zip} ) {
+    plan skip_all => "Archive::Zip required.";
+  } else {
+    plan tests => 3;
+  }
+}
+
+
+use Cwd ();
+my $cwd = Cwd::cwd;
+my $tmp = File::Spec->catdir( $cwd, 't', '_tmp' );
+
+
+use DistGen;
+my $dist = DistGen->new( dir => $tmp, xs => 1 );
+$dist->add_file( 'hello', <<'---' );
+#!perl -w
+print "Hello, World!\n";
+__END__
+
+=pod
+
+=head1 NAME
+
+hello
+
+=head1 DESCRIPTION
+
+Says "Hello"
+
+=cut
+---
+$dist->change_file( 'Build.PL', <<"---" );
+
+my \$build = new Module::Build(
+  module_name => @{[$dist->name]},
+  version => '0.01',
+  license     => 'perl',
+  scripts     => [ 'hello' ],
+);
+
+\$build->create_build_script;
+---
+$dist->regen;
+
+chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+
+use File::Spec::Functions qw(catdir);
+
+use Module::Build;
+my @installstyle = qw(lib perl5);
+my $mb = Module::Build->new_from_context(
+  verbose => 0,
+  quiet   => 1,
+
+  installdirs => 'site',
+);
+
+my $filename = $mb->dispatch('pardist');
+
+ok( -f $filename, '.par distributions exists' );
+my $distname = $dist->name;
+ok( $filename =~ /^\Q$distname\E/, 'Distribution name seems correct' );
+
+my $meta;
+eval { $meta = PAR::Dist::get_meta($filename) };
+
+ok(
+  (not $@ and defined $meta and not $meta eq ''),
+  'Distribution contains META.yml'
+);
+
+$dist->clean();
+
+chdir( $cwd );
+use File::Path;
+rmtree( $tmp );
+
diff --git a/lib/Module/Build/t/tilde.t b/lib/Module/Build/t/tilde.t
index 13a3f4f..95ebe98 100644
--- a/lib/Module/Build/t/tilde.t
+++ b/lib/Module/Build/t/tilde.t
@@ -4,7 +4,7 @@
 
 use strict;
 use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
-use MBTest tests => 10;
+use MBTest tests => 14;
 
 use Cwd ();
 my $cwd = Cwd::cwd;
@@ -46,6 +46,23 @@ sub run_sample {
     $mb = run_sample( install_base => '~/foo' );
     is( $mb->install_base,      "$ENV{HOME}/foo" );
 
+    $mb = run_sample( install_base => '~~' );
+    is( $mb->install_base,      '~~' );
+
+  TODO: {
+    local $TODO = "Not handling spaces in _detildefy() properly yet";
+
+    $mb = run_sample( install_base => '~ foo' );
+    is( $mb->install_base,      '~ foo' );
+
+    # glob() doesn't work on non-existent paths with spaces
+    $mb = run_sample( install_base => '~/ foo' );
+    is( $mb->install_base,      "$ENV{HOME}/ foo" );
+
+    $mb = run_sample( install_base => '~/fo o' );
+    is( $mb->install_base,      "$ENV{HOME}/fo o" );
+  }
+
     $mb = run_sample( install_base => 'foo~' );
     is( $mb->install_base,      'foo~' );
 
diff --git a/lib/Module/Build/t/xs.t b/lib/Module/Build/t/xs.t
index c15a98f..96cede4 100644
--- a/lib/Module/Build/t/xs.t
+++ b/lib/Module/Build/t/xs.t
@@ -85,7 +85,7 @@ is $@, '';
 
 SKIP: {
   skip( "skipping a Unixish-only tests", 1 )
-      unless $mb->os_type eq 'Unix';
+      unless $mb->is_unixish;
 
   $mb->{config}->push(ld => "FOO=BAR ".$mb->config('ld'));
   eval {$mb->dispatch('build')};