Author: ericwilhelm
Date: Thu Dec 28 02:51:14 2006
New Revision: 8481
Added:
Module-Build/trunk/t/test_type.t (contents, props changed)
Module-Build/trunk/t/test_types.t (contents, props changed)
Modified:
Module-Build/trunk/Changes
Module-Build/trunk/MANIFEST
Module-Build/trunk/lib/Module/Build.pm
Module-Build/trunk/lib/Module/Build/Base.pm
Log:
** test profiles support via ACTION_testall and test_types => {} parameter
t/test_type.t - coverage for one special test type
t/test_types.t - additional test profiles coverage
MANIFEST - update
lib/Module/Build/Base.pm - added ACTION_testall(), generic_test() refactor
lib/Module/Build.pm - testall documentation
Changes - added 0.2806 mark (after the fact), update
Modified: Module-Build/trunk/Changes
==============================================================================
--- Module-Build/trunk/Changes (original)
+++ Module-Build/trunk/Changes Thu Dec 28 02:51:14 2006
@@ -1,5 +1,8 @@
Revision history for Perl extension Module::Build.
+ - Added test profiles support via the test_types property and "testall"
+ target. [Eric Wilhelm, Jeff Lavallee]
+
- Use syscopy() on OS/2 in copy_if_modified() so we make sure to
overwrite any existing target file. [Ilya Zakharevich]
Modified: Module-Build/trunk/MANIFEST
==============================================================================
--- Module-Build/trunk/MANIFEST (original)
+++ Module-Build/trunk/MANIFEST Thu Dec 28 02:51:14 2006
@@ -59,6 +59,8 @@
t/ppm.t
t/runthrough.t
t/signature.t
+t/test_type.t
+t/test_types.t
t/tilde.t
t/versions.t
t/xs.t
Modified: Module-Build/trunk/lib/Module/Build.pm
==============================================================================
--- Module-Build/trunk/lib/Module/Build.pm (original)
+++ Module-Build/trunk/lib/Module/Build.pm Thu Dec 28 02:51:14 2006
@@ -567,6 +567,29 @@
./Build test --test_files 't/01-*.t'
+=item testall
+
+[verion 0.2807]
+
+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]
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 Thu Dec 28 02:51:14 2006
@@ -2013,13 +2013,54 @@
$self->do_tests;
}
+sub ACTION_testall {
+ my ($self) = @_;
+
+ for my $action ('', grep { $_ ne 'all' } $self->get_test_types) {
+ $self->_call_action( "test$action" );
+ }
+}
+
+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} = [ @[EMAIL PROTECTED] ];
$self->depends_on('code');
-
+
# Protect others against our @INC changes
local @INC = @INC;
@@ -2083,8 +2124,12 @@
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{^[^.].*$_$})} } @$exts
+ if $self->recursive_test_files;
+
+ return sort map { glob File::Spec->catfile($dir, "*$_") } @$exts;
}
sub ACTION_testdb {
@@ -2263,7 +2308,7 @@
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($_) : $_ }
Added: Module-Build/trunk/t/test_type.t
==============================================================================
--- (empty file)
+++ Module-Build/trunk/t/test_type.t Thu Dec 28 02:51:14 2006
@@ -0,0 +1,70 @@
+#!/usr/bin/perl -w
+
+use strict;
+use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
+use MBTest tests => 9;
+
+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';
+
+SKIP: {
+ skip "no blib in core", 1 if $ENV{PERL_CORE};
+ like $INC{'Module/Build.pm'}, qr/\bblib\b/, "Make sure Module::Build was
loaded from blib/";
+}
+
+
+# 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;
Added: Module-Build/trunk/t/test_types.t
==============================================================================
--- (empty file)
+++ Module-Build/trunk/t/test_types.t Thu Dec 28 02:51:14 2006
@@ -0,0 +1,90 @@
+#!/usr/bin/perl -w
+
+use strict;
+use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
+use MBTest tests => 14;
+
+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->regen;
+
+chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+
+#########################
+
+use_ok 'Module::Build';
+
+SKIP: {
+ skip "no blib in core", 1 if $ENV{PERL_CORE};
+ like $INC{'Module/Build.pm'}, qr/\bblib\b/, "Make sure Module::Build was
loaded from blib/";
+}
+
+
+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)} ));
+
+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;
+
+is( scalar( @{[ $all_output =~ m/(OK 1)/mg ]} ), 3 ); # we get a third one
from basic.t
+is( scalar( @{[ $all_output =~ m/(OK)/mg ]} ), 8 );
+
+chdir( $cwd ) or die "Can't chdir to '$cwd': $!";
+$dist->remove;
+
