package Test::Kit;
use warnings;
use strict;
use Carp ();
use namespace::clean;
use Test::Kit::Features;
=head1 NAME
Test::Kit - Build custom test packages with only the features you want.
=head1 VERSION
Version 0.100
=cut
our $VERSION = '0.101';
$VERSION = eval $VERSION;
=head1 SYNOPSIS
package My::Custom::Tests;
use Test::Kit
'Test::More',
'Test::XML',
'Test::Differences',
'+explain',
);
=head1 DESCRIPTION
Build custom test modules, using other test modules for parts.
=over 4
=item * C<kit>:
A set of materials or parts from which something can be assembled.
=back
How many times have you opened up a test program in a large test suite and
seen 5 or 6 C<use Test::...> lines? And then you open up a bunch of other
test programs and they all have the same 5 or 6 lines. That's duplication you
don't want. C<Test::Kit> allows you to I<safely> push that code into one
custom test package and merely use that package. It does this by treating
various test module's functions as pieces you can assemble together.
Also, you can import 'features' to extend your testing possibilities.
=head1 USAGE
=head2 Basic
Create a package for your tests and add the test modules you want.
package My::Tests;
use Test::Kit qw(
Test::Differences
Test::Exception
);
Then in your test programs, all exported test functions from those modules
will be available. C<Test::More> functions are included by default. If you
add 'Test::Most' to your C<Test::Kit> import list, it will take precedence
over C<Test::More>.
use My::Tests plan => 3;
is 3, 3, 'this if from Test::More';
eq_or_diff [ 3, 3 ], [ 3, 3 ], 'this is from Test::Differences';
throws_ok { die 'test message' }
qr/^test message/,
'... and this is from Test::Exception';
=head2 Using "Features"
Additional features, as detailed in L<Test::Kit::Features>, are available.
Two common features are 'explain' and 'on_fail'. To use a feature, just add a
'+' (plus) before the feature name:
package My::Tests;
use Test::Kit qw(
Test::Differences
Test::Exception
Test::XML
Test::JSON
+explain
+on_fail
);
=head2 Advanced usage
Sometimes two or more test modules may try to export a function with the same
name. This will cause a compile time failure listing which modules export
which conflicting function. There are two ways of dealing with this: renaming
and excluding. To do this, add a hashref after the module name with keys
'exclude', 'rename', or both.
use Test::Most
'Test::Something' => {
# or a scalar for just one
exclude => [qw/ list of excluded functions/],
},
'Test::Something::Else' => {
# takes a hashref
rename => {
old_test_function_name => 'new_test_function_name',
},
},
'+explain';
=cut
my %FUNCTION;
sub import {
my $class = shift;
my $callpack = caller(1);
my $basic_functions = namespace::clean->get_functions($class);
# not implementing features yet
my ( $packages, $features ) = $class->_packages_and_features(@_);
$class->_setup_import($features);
foreach my $package ( keys %$packages ) {
my $internal_package = "Test::Kit::_INTERNAL_::$package";
eval "package $internal_package; use $package;";
if ( my $error = $@ ) {
Carp::croak("Cannot require $package: $error");
}
$class->_register_new_functions( $callpack, $basic_functions,
$packages->{$package}, $package, $internal_package, );
}
$class->_validate_functions($callpack);
$class->_export_to($callpack);
{
# Otherwise, "local $TODO" won't work for caller.
no strict 'refs';
our $TODO;
*{"$callpack\::TODO"} = \$TODO;
}
return 1;
}
sub _setup_import {
my ( $class, $features ) = @_;
my $callpack = caller(1); # this is the composed test package
my $import = "$callpack\::import";
my $isa = "$callpack\::ISA";
no strict 'refs';
if ( defined &$import ) {
Carp::croak("Class $callpack must not define an &import method");
}
else {
unshift @$isa => 'Test::Kit::Features';
*$import = sub {
my ( $class, @args ) = @_;
@args = $class->BUILD(@args) if $class->can('BUILD');
@args = $class->_setup_features( $features, @args );
@_ = ( $class, @args );
goto &Test::Builder::Module::import;
};
}
}
sub _reset { # internal testing hook
%FUNCTION = ();
}
sub _validate_functions {
my ( $class, $callpack ) = @_;
my @errors;
while ( my ( $function, $definition ) = each %{ $FUNCTION{$callpack} } ) {
my @source = @{ $definition->{source} };
if ( @source > 1 ) {
my $sources = join ', ' => sort @source;
push @errors =>
"Function &$function exported from more than one package: $sources";
}
}
Carp::croak( join "\n" => @errors ) if @errors;
}
# XXX ouch. This is really getting crufty
sub _register_new_functions {
my ( $class, $callpack, $basic_functions, $definition, $source, $package ) =
@_;
my $new_functions = namespace::clean->get_functions($package);
$new_functions =
$class->_remove_basic_functions( $basic_functions, $new_functions, );
my $exclude = delete $definition->{exclude};
$exclude = [$exclude] unless 'ARRAY' eq ref $exclude;
my $rename = delete $definition->{rename} || {};
if ( my @keys = keys %$definition ) {
my $keys = join ', ' => sort @keys;
Carp::croak("Uknown keys in module definition: $keys");
}
# turn it into a hash lookup
no warnings 'uninitialized';
$exclude = { map { $_ => 1 } @$exclude };
foreach my $function ( keys %$new_functions ) {
next if $exclude->{$function};
my $glob = $new_functions->{$function};
if ( my $new_name = $rename->{$function} ) {
$function = $new_name;
}
$FUNCTION{$callpack}{$function}{glob} = $glob;
$FUNCTION{$callpack}{$function}{source} ||= [];
push @{ $FUNCTION{$callpack}{$function}{source} } => $source;
}
}
sub _packages_and_features {
my ( $class, @requests ) = @_;
my ( %packages, @features );
while ( my $package = shift @requests ) {
if ( $package =~ s/\A\+// ) {
# it's a feature, not a package
push @features => $package;
next;
}
my $definition = 'HASH' eq ref $requests[0] ? shift @requests : {};
$packages{$package} = $definition;
}
# Don't include Test::More because Test::Most will automatically provide
# these features
$packages{'Test::More'} ||= {}
unless exists $packages{'Test::Most'};
return ( \%packages, \@features );
}
sub _remove_basic_functions {
my ( $class, $basic, $new ) = @_;
delete @{$new}{ keys %$basic };
return $new;
}
sub _export_to {
my ( $class, $target ) = @_;
while ( my ( $function, $definition ) = each %{ $FUNCTION{$target} } ) {
my $target_function = "$target\::$function";
no strict 'refs';
*$target_function = $definition->{glob};
}
return 1;
}
=head1 AUTHOR
Curtis "Ovid" Poe, C<< <ovid at cpan.org> >>
=head1 BUGS
Please report any bugs or feature requests to C<bug-test-kit at rt.cpan.org>,
or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Kit>. I will be
notified, and then you'll automatically be notified of progress on your bug as
I make changes.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc Test::Kit
You can also look for information at:
=over 4
=item * RT: CPAN's request tracker
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Test-Kit>
=item * AnnoCPAN: Annotated CPAN documentation
L<http://annocpan.org/dist/Test-Kit>
=item * CPAN Ratings
L<http://cpanratings.perl.org/d/Test-Kit>
=item * Search CPAN
L<http://search.cpan.org/dist/Test-Kit>
=back
=head1 ACKNOWLEDGEMENTS
=head1 COPYRIGHT & LICENSE
Copyright 2008 Curtis "Ovid" Poe, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
1; # End of Test::Kit