use vars qw($VERSION @ISA);
@ISA = qw(Module::Build::Base);
-$VERSION = '0.2806_01';
+$VERSION = '0.2807';
$VERSION = eval $VERSION;
# Okay, this is the brute-force method of finding out what kind of
distdir retest
distmeta skipcheck
distsign test
- disttest testcover
- docs testdb
- fakeinstall testpod
- help testpodcoverage
- html versioninstall
- install
+ disttest testall
+ docs testcover
+ fakeinstall testdb
+ help testpod
+ html testpodcoverage
+ install versioninstall
You can run the 'help' action for a complete list of actions.
./Build test --test_files 't/01-*.t'
+=item testall
+
+[verion 0.2807]
+
+[Note: the 'testall' action and the code snippets below are currently
+in alpha stage, see
+L<"http://www.nntp.perl.org/group/perl.module.build/2007/03/msg584.html"> ]
+
+Runs the C<test> action plus each of the C<test$type> actions defined by
+the keys of the C<test_types> parameter.
+
+Currently, you need to define the ACTION_test$type method yourself and
+enumerate them in the test_types parameter.
+
+ my $mb = Module::Build->subclass(
+ code => q(
+ sub ACTION_testspecial { shift->generic_test(type => 'special'); }
+ sub ACTION_testauthor { shift->generic_test(type => 'author'); }
+ )
+ )->new(
+ ...
+ test_types => {
+ special => '.st',
+ author => '.at',
+ },
+ ...
+
=item testcover
[version 0.26]
data in a directory called C<_build/>. Both of these will be removed
when the C<realclean> action is performed.
+Among the files created in C<_build/> is a F<_build/prereqs> file
+containing the set of prerequisites for this distribution, as a hash
+of hashes. This file may be C<eval()>-ed to obtain the authoritative
+set of prereqs, which might be different from the contents of META.yml
+(because F<Build.PL> might have set them dynamically). But fancy
+developers take heed: do not put any fancy custom runtime code in the
+F<_build/prereqs> file, leave it as a static declaration containing
+only strings and numbers. Similarly, do not alter the structure of
+the internal C<< $self->{properties}{requires} >> (etc.) data members,
+because that's where this data comes from.
+
=item current_action()
[version 0.28]
If C<prompt()> detects that it is not running interactively and there
is nothing on STDIN or if the PERL_MM_USE_DEFAULT environment variable
-is set to true, the $default will be used without prompting. This
-prevents automated processes from blocking on user input.
+is set to true, the $default will be used without prompting.
+
+To prevent automated processes from blocking, the user must either set
+PERL_MM_USE_DEFAULT or attach something to STDIN (this can be a
+pipe/file containing a scripted set of answers or /dev/null.)
-If no $default is provided an empty string will be used instead.
+If no $default is provided an empty string will be used instead. In
+non-interactive mode, the absence of $default is an error (though
+explicitly passing C<undef()> as the default is valid as of 0.27.)
This method may be called as a class or object method.
unless ($self->allow_mb_mismatch) {
my $mb_version = $Module::Build::VERSION;
die(" * ERROR: Configuration was initially created with Module::Build version '$self->{properties}{mb_version}',\n".
- " but we are now using version '$mb_version'. Please re-run the Build.PL or Makefile.PL script.\n")
+ " but we are now using version '$mb_version'. Please re-run the Build.PL or Makefile.PL script,\n".
+ " or use --allow_mb_mismatch 1 to skip this version check.\n")
if $mb_version ne $self->{properties}{mb_version};
}
# as it is during resume() (and thereafter).
{
local @ARGV = $package->unparse_args(\%args);
- do 'Build.PL';
+ do './Build.PL';
die $@ if $@;
}
return $package->resume;
return -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)) ; # Pipe?
}
+# NOTE this is a blocking operation if(-t STDIN)
sub _is_unattended {
my $self = shift;
- return $ENV{PERL_MM_USE_DEFAULT} || ( !$self->_is_interactive && eof STDIN );
+ return $ENV{PERL_MM_USE_DEFAULT} ||
+ ( !$self->_is_interactive && eof STDIN );
}
sub _readline {
my $mess = shift
or die "prompt() called without a prompt message";
- my $def;
- if ( $self->_is_unattended && !@_ ) {
+ # use a list to distinguish a default of undef() from no default
+ my @def;
+ @def = (shift) if @_;
+ # use dispdef for output
+ my @dispdef = scalar(@def) ?
+ ('[', (defined($def[0]) ? $def[0] . ' ' : ''), ']') :
+ (' ', '');
+
+ local $|=1;
+ print "$mess ", @dispdef;
+
+ if ( $self->_is_unattended && !@def ) {
die <<EOF;
ERROR: This build seems to be unattended, but there is no default value
for this question. Aborting.
EOF
}
- $def = shift if @_;
- ($def, my $dispdef) = defined $def ? ($def, "[$def] ") : ('', ' ');
-
- local $|=1;
- print "$mess $dispdef";
my $ans = $self->_readline();
if ( !defined($ans) # Ctrl-D or unattended
or !length($ans) ) { # User hit return
- print "$def\n";
- $ans = $def;
+ print "$dispdef[1]\n";
+ $ans = scalar(@def) ? $def[0] : '';
}
return $ans;
die "Invalid default value: y_n() default must be 'y' or 'n'"
if $def && $def !~ /^[yn]/i;
- if ( $self->_is_unattended && !$def ) {
- die <<EOF;
-ERROR: This build seems to be unattended, but there is no default value
-for this question. Aborting.
-EOF
- }
-
my $answer;
while (1) { # XXX Infinite or a large number followed by an exception ?
$answer = $self->prompt(@_);
my ($self) = @_;
my $file = $self->config_file('build_params')
- or die "No build_params?";
+ or die "Can't find 'build_params' in " . $self->config_dir;
my $fh = IO::File->new($file) or die "Can't read '$file': $!";
my $ref = eval do {local $/; <$fh>};
die if $@;
}
sub get_action_docs {
- my ($self, $action, $actions) = @_;
- $actions ||= $self->known_actions;
- $@ = '';
- ($@ = "No known action '$action'\n"), return
- unless $actions->{$action};
-
+ my ($self, $action) = @_;
+ my $actions = $self->known_actions;
+ die "No known action '$action'" unless $actions->{$action};
+
my ($files_found, @docs) = (0);
foreach my $class ($self->super_classes) {
(my $file = $class) =~ s{::}{/}g;
$file = $INC{$file . '.pm'} or next;
my $fh = IO::File->new("< $file") or next;
$files_found++;
-
+
# Code below modified from /usr/bin/perldoc
-
+
# Skip to ACTIONS section
local $_;
while (<$fh>) {
last if /^=head1 ACTIONS\s/;
}
-
+
# Look for our action
my ($found, $inlist) = (0, 0);
while (<$fh>) {
if (/^=item\s+\Q$action\E\b/) {
- $found = 1;
+ $found = 1;
} elsif (/^=(item|back)/) {
- last if $found > 1 and not $inlist;
+ last if $found > 1 and not $inlist;
}
next unless $found;
push @docs, $_;
my $actions = $self->known_actions;
if (@{$self->{args}{ARGV}}) {
- my $msg = $self->get_action_docs($self->{args}{ARGV}[0], $actions) || "$@\n";
- print $msg;
+ my $msg = eval {$self->get_action_docs($self->{args}{ARGV}[0], $actions)};
+ print $@ ? "$@\n" : $msg;
return;
}
$self->do_tests;
}
+sub ACTION_testall {
+ my ($self) = @_;
+
+ my @types;
+ for my $action (grep { $_ ne 'all' } $self->get_test_types) {
+ # XXX We can't just dispatch because we get multiple summaries but
+ # we'll need to dispatch to support custom setup/teardown in the
+ # action. To support that, we'll need to call something besides
+ # Harness::runtests() because we'll need to collect the results in
+ # parts, then run the summary.
+ push(@types, $action);
+ #$self->_call_action( "test$action" );
+ }
+ $self->generic_test(types => ['default', @types]);
+}
+
+sub get_test_types {
+ my ($self) = @_;
+
+ my $t = $self->{properties}->{test_types};
+ return ( defined $t ? ( keys %$t ) : () );
+}
+
sub ACTION_test {
my ($self) = @_;
+ $self->generic_test(type => 'default');
+}
+
+sub generic_test {
+ my $self = shift;
+ (@_ % 2) and croak('Odd number of elements in argument hash');
+ my %args = @_;
+
my $p = $self->{properties};
-
+
+ my @types = (
+ (exists($args{type}) ? $args{type} : ()),
+ (exists($args{types}) ? @{$args{types}} : ()),
+ );
+ @types or croak "need some types of tests to check";
+
+ my %test_types = (
+ default => '.t',
+ (defined($p->{test_types}) ? %{$p->{test_types}} : ()),
+ );
+
+ for my $type (@types) {
+ croak "$type not defined in test_types!"
+ unless defined $test_types{ $type };
+ }
+
+ # we use local here because it ends up two method calls deep
+ local $p->{test_file_exts} = [ @test_types{@types} ];
$self->depends_on('code');
-
+
# Protect others against our @INC changes
local @INC = @INC;
sub expand_test_dir {
my ($self, $dir) = @_;
- return sort @{$self->rscan_dir($dir, qr{^[^.].*\.t$})} if $self->recursive_test_files;
- return sort glob File::Spec->catfile($dir, "*.t");
+ my $exts = $self->{properties}{test_file_exts} || ['.t'];
+
+ return sort map { @{$self->rscan_dir($dir, qr{^[^.].*\Q$_\E$})} } @$exts
+ if $self->recursive_test_files;
+
+ return sort map { glob File::Spec->catfile($dir, "*$_") } @$exts;
}
sub ACTION_testdb {
sub find_test_files {
my $self = shift;
my $p = $self->{properties};
-
+
if (my $files = $p->{test_files}) {
$files = [keys %$files] if UNIVERSAL::isa($files, 'HASH');
$files = [map { -d $_ ? $self->expand_test_dir($_) : $_ }
rename("$file.new", $file)
or die "Can't rename $file.new to $file: $!";
- unlink "$file.bak"
+ $self->delete_filetree("$file.bak")
or $self->log_warn("Couldn't clean up $file.bak, leaving it there");
$self->do_system($c->get('eunicefix'), $file) if $c->get('eunicefix') ne ':';
my %seen;
my $sep = $self->config('path_sep');
local $ENV{PERL5LIB} =
- ( length($ENV{PERL5LIB}) < 500
+ ( !exists($ENV{PERL5LIB}) ? '' :
+ length($ENV{PERL5LIB}) < 500
? $ENV{PERL5LIB}
: join $sep, grep { ! $seen{$_}++ and -d $_ } split($sep, $ENV{PERL5LIB})
);
File::Path::mkpath(File::Basename::dirname($to_path), 0, oct(777));
$self->log_info("Copying $file -> $to_path\n") if $args{verbose};
- File::Copy::copy($file, $to_path) or die "Can't copy('$file', '$to_path'): $!";
+
+ if ($^O eq 'os2') {# copy will not overwrite; 0x1 = overwrite
+ chmod 0666, $to_path;
+ File::Copy::syscopy($file, $to_path, 0x1) or die "Can't copy('$file', '$to_path'): $!";
+ } else {
+ File::Copy::copy($file, $to_path) or die "Can't copy('$file', '$to_path'): $!";
+ }
+
# mode is read-only + (executable if source is executable)
my $mode = oct(444) | ( $self->is_executable($file) ? oct(111) : 0 );
chmod( $mode, $to_path );
perl(1), Module::Build(3)
=cut
+
+# vim:ts=8:sw=2:et:sta:sts=2
# Some of this code came from the ExtUtils:: hierarchy.
- my $eval = qq{q# Hide from _packages_inside()
- #; package Module::Build::ModuleInfo::_version;
- no strict;
-
- local $sigil$var;
- \$$var=undef; do {
- $line
- }; \$$var
- };
+ # We compile into $vsub because 'use version' would cause
+ # compiletime/runtime issues with local()
+ my $vsub;
+ my $eval = qq{BEGIN { q# Hide from _packages_inside()
+ #; package Module::Build::ModuleInfo::_version;
+ no strict;
+
+ local $sigil$var;
+ \$$var=undef;
+ \$vsub = sub {
+ $line;
+ \$$var
+ };
+ }};
local $^W;
- # Try and get the $VERSION
- my $result = eval $eval;
- warn "Error evaling version line '$eval' in $self->{filename}: $@\n" if $@;
+ # Try to get the $VERSION
+ eval $eval;
+ warn "Error evaling version line '$eval' in $self->{filename}: $@\n"
+ if $@;
+ (ref($vsub) eq 'CODE') or
+ die "failed to build version sub for $self->{filename}";
+ my $result = $vsub->();
# Bless it into our own version class
$result = Module::Build::Version->new($result);
package Module::Build::Version;
use strict;
-eval "use version 0.661";
+eval "use version 0.70";
if ($@) { # can't locate version files, use our own
# Avoid redefined warnings if an old version.pm was available
package version::vpp;
use strict;
-use Scalar::Util;
+use locale;
use vars qw ($VERSION @ISA @REGEXS);
-$VERSION = 0.67;
+$VERSION = 0.71;
push @REGEXS, qr/
^v? # optional leading 'v'
/x;
use overload (
- '""' => \&stringify,
- 'cmp' => \&vcmp,
- '<=>' => \&vcmp,
+ '""' => \&stringify,
+ '0+' => \&numify,
+ 'cmp' => \&vcmp,
+ '<=>' => \&vcmp,
+ 'bool' => \&vbool,
+ 'nomethod' => \&vnoop,
);
sub new
{
my ($class, $value) = @_;
my $self = bless ({}, ref ($class) || $class);
+ require POSIX;
+ my $currlocale = POSIX::setlocale(&POSIX::LC_ALL);
+ my $radix_comma = ( POSIX::localeconv()->{decimal_point} eq ',' );
if ( not defined $value or $value =~ /^undef$/ ) {
# RT #19517 - special case for undef comparison
$value = 'v'.$_[2];
}
- # may be a v-string
- if ( $] >= 5.006_002 && length($value) >= 3 && $value !~ /[._]/ ) {
- my $tvalue = sprintf("%vd",$value);
- if ( $tvalue =~ /^\d+\.\d+\.\d+$/ ) {
- # must be a v-string
- $value = $tvalue;
- }
- }
+ $value = _un_vstring($value);
# exponential notation
- if ( $value =~ /\d+e-?\d+/ ) {
+ if ( $value =~ /\d+.?\d*e-?\d+/ ) {
$value = sprintf("%.9f",$value);
$value =~ s/(0+)$//;
}
+ # if the original locale used commas for decimal points, we
+ # just replace commas with decimal places, rather than changing
+ # locales
+ if ( $radix_comma ) {
+ $value =~ tr/,/./;
+ }
+
# This is not very efficient, but it is morally equivalent
# to the XS code (as that is the reference implementation).
# See vutil/vutil.c for details
# pre-scan the input string to check for decimals/underbars
while ( substr($value,$pos,1) =~ /[._\d]/ ) {
if ( substr($value,$pos,1) eq '.' ) {
- die "Invalid version format (underscores before decimal)"
- if $alpha;
+ if ($alpha) {
+ require Carp;
+ Carp::croak("Invalid version format ".
+ "(underscores before decimal)");
+ }
$saw_period++;
$last = $pos;
}
elsif ( substr($value,$pos,1) eq '_' ) {
- die "Invalid version format (multiple underscores)"
- if $alpha;
+ if ($alpha) {
+ require Carp;
+ Carp::croak("Invalid version format ".
+ "(multiple underscores)");
+ }
$alpha = 1;
$width = $pos - $last - 1; # natural width of sub-version
}
}
if ( $alpha && !$saw_period ) {
- die "Invalid version format (alpha without decimal)";
+ require Carp;
+ Carp::croak("Invalid version format (alpha without decimal)");
+ }
+
+ if ( $alpha && $saw_period && $width == 0 ) {
+ require Carp;
+ Carp::croak("Invalid version format (misplaced _ in number)");
}
if ( $saw_period > 1 ) {
$rev += substr($value,$s,1) * $mult;
$mult /= 10;
if ( abs($orev) > abs($rev) ) {
- die "Integer overflow in version";
+ require Carp;
+ Carp::croak("Integer overflow in version");
}
$s++;
if ( substr($value,$s,1) eq '_' ) {
$rev += substr($value,$end,1) * $mult;
$mult *= 10;
if ( abs($orev) > abs($rev) ) {
- die "Integer overflow in version";
+ require Carp;
+ Carp::croak("Integer overflow in version");
}
}
}
{
my ($self) = @_;
unless (_verify($self)) {
- die "Invalid version object";
+ require Carp;
+ Carp::croak("Invalid version object");
}
my $width = $self->{width} || 3;
my $alpha = $self->{alpha} || "";
{
my ($self) = @_;
unless (_verify($self)) {
- die "Invalid version object";
+ require Carp;
+ Carp::croak("Invalid version object");
}
my $alpha = $self->{alpha} || "";
my $len = $#{$self->{version}};
{
my ($self) = @_;
unless (_verify($self)) {
- die "Invalid version object";
+ require Carp;
+ Carp::croak("Invalid version object");
}
if ( exists $self->{qv} ) {
return $self->normal;
($left, $right) = ($right, $left);
}
unless (_verify($left)) {
- die "Invalid version object";
+ require Carp;
+ Carp::croak("Invalid version object");
}
unless (_verify($right)) {
- die "Invalid version object";
+ require Carp;
+ Carp::croak("Invalid version object");
}
my $l = $#{$left->{version}};
my $r = $#{$right->{version}};
return $retval;
}
+sub vbool {
+ my ($self) = @_;
+ return vcmp($self,$self->new("0"),1);
+}
+
+sub vnoop {
+ require Carp;
+ Carp::croak("operation not supported with version object");
+}
+
sub is_alpha {
my ($self) = @_;
return (exists $self->{alpha});
sub qv {
my ($value) = @_;
- my $eval = eval 'Scalar::Util::isvstring($value)';
- if ( !$@ and $eval ) {
- $value = sprintf("v%vd",$value);
- }
- else {
- $value = 'v'.$value unless $value =~ /^v/;
- }
+ $value = _un_vstring($value);
+ $value = 'v'.$value unless $value =~ /^v/;
return version->new($value); # always use base class
}
+sub is_qv {
+ my ($self) = @_;
+ return (exists $self->{qv});
+}
+
+
sub _verify {
my ($self) = @_;
- if ( Scalar::Util::reftype($self) eq 'HASH'
- && exists $self->{version}
+ if ( ref($self)
+ && eval { exists $self->{version} }
&& ref($self->{version}) eq 'ARRAY'
) {
return 1;
}
}
+sub _un_vstring {
+ my $value = shift;
+ # may be a v-string
+ if ( $] >= 5.006_000 && length($value) >= 3 && $value !~ /[._]/ ) {
+ my $tvalue = sprintf("%vd",$value);
+ if ( $tvalue =~ /^\d+\.\d+\.\d+$/ ) {
+ # must be a v-string
+ $value = $tvalue;
+ }
+ }
+ return $value;
+}
+
# Thanks to Yitzchak Scott-Thoennes for this mode of operation
{
local $^W;
no strict 'refs';
eval "require $class" unless %{"$class\::"}; # already existing
- die "$class defines neither package nor VERSION--version check failed"
- if $@ or not %{"$class\::"};
+ return undef if $@ =~ /Can't locate/ and not defined $req;
+
+ if ( not %{"$class\::"} and $] >= 5.008) { # file but no package
+ require Carp;
+ Carp::croak( "$class defines neither package nor VERSION"
+ ."--version check failed");
+ }
my $version = eval "\$$class\::VERSION";
if ( defined $version ) {
+ local $^W if $] <= 5.008;
$version = version::vpp->new($version);
}
if ( defined $req ) {
unless ( defined $version ) {
- my $msg = "$class does not define ".
- "\$$class\::VERSION--version check failed";
+ require Carp;
+ my $msg = $] < 5.006
+ ? "$class version $req required--this is only version "
+ : "$class does not define \$$class\::VERSION"
+ ."--version check failed";
+
if ( $ENV{VERSION_DEBUG} ) {
- require Carp;
Carp::confess($msg);
}
else {
- die($msg);
+ Carp::croak($msg);
}
}
$req = version::vpp->new($req);
if ( $req > $version ) {
- die sprintf ("%s version %s (%s) required--".
- "this is only version %s (%s)", $class,
- $req->numify, $req->normal,
- $version->numify, $version->normal);
+ require Carp;
+ if ( $req->is_qv ) {
+ Carp::croak(
+ sprintf ("%s version %s required--".
+ "this is only version %s", $class,
+ $req->normal, $version->normal)
+ );
+ }
+ else {
+ Carp::croak(
+ sprintf ("%s version %s required--".
+ "this is only version %s", $class,
+ $req->numify, $version->numify)
+ );
+ }
}
}
sub _yaml_value {
my ($value) = @_;
# undefs become ~
- if (! defined $value) {
- return("~");
- }
+ return '~' if not defined $value;
+
# empty strings will become empty strings
- elsif (! defined $value || $value eq "") {
- return('""');
- }
- # quote and escape strings with special values
- elsif ($value =~ /["'`~\n!\@\#^\&\*\(\)\{\}\[\]\|<>\?]/) {
- if ($value !~ /['`~\n!\#^\&\*\(\)\{\}\[\]\|\?]/) { # nothing but " or @ or < or > (email addresses)
- return("'" . $value . "'");
- }
- else {
- $value =~ s/\n/\\n/g; # handle embedded newlines
- $value =~ s/"/\\"/g; # handle embedded quotes
- return('"' . $value . '"');
- }
- }
+ return '""' if $value eq '';
+
# allow simple scalars (without embedded quote chars) to be unquoted
# (includes $%_+=-\;:,./)
- else {
- return($value);
- }
+ return $value if $value !~ /["'`~\n!\@\#^\&\*\(\)\{\}\[\]\|<>\?]/;
+
+ # quote and escape strings with special values
+ return "'$value'"
+ if $value !~ /['`~\n!\#^\&\*\(\)\{\}\[\]\|\?]/; # nothing but " or @ or < or > (email addresses)
+
+ $value =~ s/\n/\\n/g; # handle embedded newlines
+ $value =~ s/"/\\"/g; # handle embedded quotes
+ return qq{"$value"};
}
1;
use strict;
use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
-use MBTest tests => 64;
+use MBTest tests => 65;
use Cwd ();
my $cwd = Cwd::cwd;
$ENV{PERL_MM_USE_DEFAULT} = 1;
eval{ $mb->y_n('Is this a question?') };
+ print "\n"; # fake <enter> because the prompt prints before the checks
like $@, qr/ERROR:/,
'Do not allow default-less y_n() for unattended builds';
eval{ $ans = $mb->prompt('Is this a question?') };
+ print "\n"; # fake <enter> because the prompt prints before the checks
like $@, qr/ERROR:/,
'Do not allow default-less prompt() for unattended builds';
$ans = $mb->y_n("Is this a question", 'y');
ok $ans, " y_n() with a default";
+
+ my @ans = $mb->prompt("Is this a question", undef);
+ is_deeply([@ans], [undef], " prompt() with undef() default");
}
}
return scalar <$fh>;
}
+sub exe_exts {
+ # Some extensions we should know about if we're looking for executables
+
+ if ($^O eq 'MSWin32') {
+ return split($Config{path_sep}, $ENV{PATHEXT} || '.com;.exe;.bat');
+ }
+ if ($^O eq 'os2') {
+ return qw(.exe .com .pl .cmd .bat .sh .ksh);
+ }
+ return;
+}
+
sub find_in_path {
my $thing = shift;
my @path = split $Config{path_sep}, $ENV{PATH};
- my @exe_ext = $^O eq 'MSWin32' ? ('', # may have extension already
- split($Config{path_sep}, $ENV{PATHEXT} || '.com;.exe;.bat')) :
- ('');
+ my @exe_ext = exe_exts();
foreach (@path) {
my $fullpath = File::Spec->catfile($_, $thing);
- foreach my $ext ( @exe_ext ) {
+ foreach my $ext ( '', @exe_ext ) {
return "$fullpath$ext" if -e "$fullpath$ext";
}
}
# Make sure we can find our own action documentation
ok $mb2->get_action_docs('build');
-ok !$mb2->get_action_docs('foo');
+ok !eval{$mb2->get_action_docs('foo')};
# Make sure those docs are the correct ones
foreach ('testcover', 'disttest') {
{
$dist->change_file( 'lib/Simple.pm', <<'---' );
package Simple;
-$VERSION = version->new('0.60.' . qw$Revision: 128 $[1]);
+$VERSION = version->new('0.60.' . (qw$Revision: 128 $)[1]);
package Simple::Simon;
-$VERSION = version->new('0.61.' . qw$Revision: 129 $[1]);
+$VERSION = version->new('0.61.' . (qw$Revision: 129 $)[1]);
---
$dist->regen;
my $provides = new_build()->prepare_metadata()->{provides};
# Make sure we handle version.pm $VERSIONs well
$dist->change_file( 'lib/Simple.pm', <<'---' );
package Simple;
-$VERSION = version->new('0.60.' . qw$Revision: 128 $[1]);
+$VERSION = version->new('0.60.' . (qw$Revision: 128 $)[1]);
package Simple::Simon;
-$VERSION = version->new('0.61.' . qw$Revision: 129 $[1]);
+$VERSION = version->new('0.61.' . (qw$Revision: 129 $)[1]);
---
$dist->regen;
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
+use MBTest tests => 2;
+
+use Cwd ();
+my $cwd = Cwd::cwd;
+my $tmp = File::Spec->catdir( $cwd, 't', '_tmp' );
+
+use DistGen;
+my $dist = DistGen->new( dir => $tmp );
+
+my $libdir = 'badlib';
+$dist->add_file("$libdir/Build.PL", 'die');
+$dist->regen;
+
+chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+
+use IO::File;
+use Module::Build;
+
+unshift(@INC, $libdir);
+my $mb = eval { Module::Build->new_from_context};
+ok(! $@, 'dodged the bullet') or die;
+ok($mb);
+
+# cleanup
+chdir( $cwd ) or die "Can''t chdir to '$cwd': $!";
+$dist->remove;
+
+use File::Path;
+rmtree( $tmp );
+
+# vim:ts=2:sw=2:et:sta
my $files = { map { $_ => 1 } $tar->list_files };
-exists_ok($files, 'blib/arch/auto/Simple/Simple.' . $mb->config('dlext'));
+my $fname = 'Simple';
+$fname = DynaLoader::mod2fname([$fname]) if defined &DynaLoader::mod2fname;
+exists_ok($files, "blib/arch/auto/Simple/$fname." . $mb->config('dlext'));
exists_ok($files, 'blib/lib/Simple.pm');
exists_ok($files, 'blib/script/hello');
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
+use MBTest tests => 8;
+
+use Cwd ();
+my $cwd = Cwd::cwd;
+my $tmp = File::Spec->catdir( $cwd, 't', '_tmp' );
+
+use DistGen;
+
+my $dist = DistGen->new( dir => $tmp );
+
+
+$dist->add_file('t/special_ext.st', <<'---' );
+#!perl
+use Test::More tests => 2;
+ok(1, 'first test in special_ext');
+ok(1, 'second test in special_ext');
+---
+
+$dist->regen;
+
+chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+
+#########################
+
+use_ok 'Module::Build';
+
+# Here we make sure we can define an action that will test a particular type
+$::x = 0;
+my $mb = Module::Build->subclass(
+ code => q#
+ sub ACTION_testspecial {
+ $::x++;
+ shift->generic_test(type => 'special');
+ }
+ #
+)->new(
+ module_name => $dist->name,
+ test_types => { special => '.st' }
+);
+
+ok $mb;
+
+$mb->dispatch('testspecial');
+is($::x, 1, "called once");
+
+
+$mb->add_to_cleanup('save_out');
+# Use uc() so we don't confuse the current test output
+my $verbose_output = uc(stdout_of(
+ sub {$mb->dispatch('testspecial', verbose => 1)}
+));
+
+like($verbose_output, qr/^OK 1 - FIRST TEST IN SPECIAL_EXT/m);
+like($verbose_output, qr/^OK 2 - SECOND TEST IN SPECIAL_EXT/m);
+
+is( $::x, 2, "called again");
+
+my $output = uc(stdout_of(
+ sub {$mb->dispatch('testspecial', verbose => 0)}
+));
+like($output, qr/\.\.OK/);
+
+is($::x, 3, "called a third time");
+
+chdir( $cwd ) or die "Can't chdir to '$cwd': $!";
+$dist->remove;
+
+# vim:ts=4:sw=4:et:sta
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
+use MBTest tests => 14 + 12;
+
+use Cwd ();
+my $cwd = Cwd::cwd();
+my $tmp = File::Spec->catdir($cwd, 't', '_tmp');
+
+use DistGen;
+
+my $dist = DistGen->new(dir => $tmp);
+
+$dist->add_file('t/special_ext.st', <<'---');
+#!perl
+use Test::More tests => 2;
+ok(1, 'first test in special_ext');
+ok(1, 'second test in special_ext');
+---
+
+$dist->add_file('t/another_ext.at', <<'---');
+#!perl
+use Test::More tests => 2;
+ok(1, 'first test in another_ext');
+ok(1, 'second test in another_ext');
+---
+$dist->add_file('t/foo.txt', <<'---');
+#!perl
+use Test::More tests => 1;
+ok 0, "don't run this non-test file";
+die "don't run this non-test file";
+---
+
+$dist->regen;
+
+chdir($dist->dirname) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+
+#########################
+
+use_ok 'Module::Build';
+
+my $mb = Module::Build->subclass(
+ code => q#
+ sub ACTION_testspecial {
+ shift->generic_test(type => 'special');
+ }
+
+ sub ACTION_testanother {
+ shift->generic_test(type => 'another');
+ }
+ #
+ )->new(
+ module_name => $dist->name,
+ test_types => {
+ special => '.st',
+ another => '.at',
+ },
+ );
+
+
+ok $mb;
+
+my $special_output = uc(stdout_of(
+ sub {$mb->dispatch('testspecial', verbose => 1)}
+));
+
+like($special_output, qr/^OK 1 - FIRST TEST IN SPECIAL_EXT/m,
+ 'saw expected output from first test');
+like($special_output, qr/^OK 2 - SECOND TEST IN SPECIAL_EXT/m,
+ 'saw expected output from second test');
+
+my $another_output = uc(stdout_of(
+ sub {$mb->dispatch('testanother', verbose => 1)}
+));
+
+ok($another_output, 'we have some test output');
+
+like($another_output, qr/^OK 1 - FIRST TEST IN ANOTHER_EXT/m,
+ 'saw expected output from first test');
+like($another_output, qr/^OK 2 - SECOND TEST IN ANOTHER_EXT/m,
+ 'saw expected output from second test');
+
+
+my $all_output = uc(stdout_of(
+ sub {$mb->dispatch('testall', verbose => 1)}
+));
+
+0 and warn "\ntestall said >>>\n$all_output\n<<<\n";
+
+like($all_output, qr/^OK 1 - FIRST TEST IN SPECIAL_EXT/m,
+ 'expected output from basic.t');
+like($all_output, qr/^OK 2 - SECOND TEST IN SPECIAL_EXT/m,
+ 'expected output from basic.t');
+
+like($all_output, qr/^OK 1 - FIRST TEST IN ANOTHER_EXT/m);
+like($all_output, qr/^OK 2 - SECOND TEST IN ANOTHER_EXT/m);
+
+# we get a third one from basic.t
+is(scalar(@{[$all_output =~ m/OK 1/mg]}), 3 );
+is(scalar(@{[$all_output =~ m/OK/mg]}), 8 );
+is(scalar(@{[$all_output =~ m/ALL TESTS SUCCESSFUL\./mg]}), 1);
+
+chdir($cwd) or die "Can't chdir to '$cwd': $!";
+$dist->remove;
+
+{ # once-again
+
+$dist->add_file('t/foo/special.st', <<'---');
+#!perl
+use Test::More tests => 2;
+ok(1, 'first test in special_ext');
+ok(1, 'second test in special_ext');
+---
+$dist->add_file('t/foo/basic_foo.t', <<'---');
+use Test::More tests => 1;
+use strict; use Simple;
+ok 1;
+---
+$dist->regen;
+
+chdir($dist->dirname) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+
+my $mb = Module::Build->subclass(
+ code => q#
+ sub ACTION_testspecial {
+ shift->generic_test(type => 'special');
+ }
+
+ sub ACTION_testanother {
+ shift->generic_test(type => 'another');
+ }
+ #
+ )->new(
+ recursive_test_files => 1,
+ module_name => $dist->name,
+ test_types => {
+ special => '.st',
+ another => '.at',
+ },
+ );
+
+ok $mb;
+
+my $special_output = uc(stdout_of(
+ sub {$mb->dispatch('testspecial', verbose => 1)}
+));
+
+like($special_output, qr/^OK 1 - FIRST TEST IN SPECIAL_EXT/m,
+ 'saw expected output from first test');
+like($special_output, qr/^OK 2 - SECOND TEST IN SPECIAL_EXT/m,
+ 'saw expected output from second test');
+
+my $another_output = uc(stdout_of(
+ sub {$mb->dispatch('testanother', verbose => 1)}
+));
+
+ok($another_output, 'we have some test output');
+
+like($another_output, qr/^OK 1 - FIRST TEST IN ANOTHER_EXT/m,
+ 'saw expected output from first test');
+like($another_output, qr/^OK 2 - SECOND TEST IN ANOTHER_EXT/m,
+ 'saw expected output from second test');
+
+
+my $all_output = uc(stdout_of(
+ sub {$mb->dispatch('testall', verbose => 1)}
+));
+
+like($all_output, qr/^OK 1 - FIRST TEST IN SPECIAL_EXT/m,
+ 'expected output from basic.t');
+like($all_output, qr/^OK 2 - SECOND TEST IN SPECIAL_EXT/m,
+ 'expected output from basic.t');
+
+like($all_output, qr/^OK 1 - FIRST TEST IN ANOTHER_EXT/m);
+like($all_output, qr/^OK 2 - SECOND TEST IN ANOTHER_EXT/m);
+
+# we get a third one from basic.t
+is(scalar(@{[$all_output =~ m/(OK 1)/mg]}), 5 );
+is(scalar(@{[$all_output =~ m/(OK)/mg]}), 13 );
+
+chdir($cwd) or die "Can't chdir to '$cwd': $!";
+$dist->remove;
+} # end once-again
+
+# vim:ts=4:sw=4:et:sta
use strict;
use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
-use MBTest tests => 11;
+use MBTest tests => 10;
use Cwd ();
my $cwd = Cwd::cwd;
$mb = run_sample( install_base => '~/foo' );
is( $mb->install_base, "$ENV{HOME}/foo" );
- $mb = run_sample( install_base => '~~' );
- is( $mb->install_base, '~~' );
-
$mb = run_sample( install_base => 'foo~' );
is( $mb->install_base, 'foo~' );
projects / p5sagit/p5-mst-13.2.git / commitdiff