package Test::Base::Less;
use strict;
use warnings;
use utf8;
our $VERSION = '0.12';
use parent qw/Test::Builder::Module Exporter/;
use Test::More;
use Data::Section::TestBase ();
use Carp ();
our @EXPORT = (@Test::More::EXPORT, qw/filters blocks register_filter run run_is run_is_deeply/);
our %FILTER_MAP;
our %FILTERS;
sub register_filter($&) {
my ($name, $code) = @_;
$FILTERS{$name} = $code;
}
sub filters($) {
my $data = shift;
for my $key (keys %$data) {
$FILTER_MAP{$key} ||= [];
push @{$FILTER_MAP{$key}}, @{$data->{$key}};
}
return;
}
sub blocks() {
my @blocks = _get_blocks(scalar(caller(0)));
return @blocks;
}
sub _get_blocks {
my $package = shift;
my $d = do { no strict 'refs'; \*{"${package}::DATA"} };
unless (defined fileno $d) {
Carp::croak("Missing __DATA__ section in $package.");
}
seek $d, 0, 0;
my $content = join '', <$d>;
my $parser = Text::TestBase->new();
my @blocks = $parser->parse($content);
my @retval;
for my $block (@blocks) {
for my $section_name ($block->get_section_names) {
my @data = $block->get_section($section_name);
if (my $filter_names = $FILTER_MAP{$section_name}) {
for my $filter_stuff (@$filter_names) {
if (ref $filter_stuff eq 'CODE') { # filters { input => [\&code] };
@data = $filter_stuff->(@data);
} else { # filters { input => [qw/eval/] };
my $filter = $FILTERS{$filter_stuff};
unless ($filter) {
Carp::croak "Unknown filter name: $filter_stuff";
}
@data = $filter->(@data);
}
}
}
$block->set_section($section_name => @data);
}
if ($block->has_section('ONLY')) {
__PACKAGE__->builder->diag("I found ONLY: maybe you're debugging?");
return $block;
}
if ($block->has_section('SKIP')) {
next;
}
push @retval, $block;
if ($block->has_section('LAST')) {
return @retval;
}
}
return @retval;
}
sub run(&) {
my $code = shift;
for my $block (_get_blocks(scalar(caller(0)))) {
__PACKAGE__->builder->subtest($block->name || 'L: ' . $block->get_lineno, sub {
$code->($block);
});
}
}
sub run_is($$) {
my ($a, $b) = @_;
for my $block (_get_blocks(scalar(caller(0)))) {
__PACKAGE__->builder->is_eq(
$block->get_section($a),
$block->get_section($b),
$block->name || 'L: ' . $block->get_lineno
);
}
}
sub run_is_deeply($$) {
my ($a, $b) = @_;
for my $block (_get_blocks(scalar(caller(0)))) {
local $Test::Builder::Level = $Test::Builder::Level + 1;
Test::More::is_deeply(
$block->get_section($a),
$block->get_section($b),
$block->name || 'L: ' . $block->get_lineno
);
}
}
package Test::Base::Less::Filter;
Test::Base::Less::register_filter(eval => \&_eval);
sub _eval {
my $src = shift;
no warnings;
my @return = CORE::eval $src;
return $@ if $@;
return @return;
}
Test::Base::Less::register_filter(chomp => \&_chomp);
sub _chomp {
map { CORE::chomp; $_ } @_;
}
Test::Base::Less::register_filter(uc => \&_uc);
sub _uc {
map { CORE::uc($_) } @_;
}
Test::Base::Less::register_filter(trim => \&_trim);
sub _trim {
map {
s/\A([ \t]*\n)+//;
s/(?<=\n)\s*\z//g;
$_;
} @_;
}
1;
__END__
=head1 NAME
Test::Base::Less - Limited version of Test::Base.
=head1 SYNOPSIS
use Test::Base::Less;
filters {
input => [qw/eval/],
};
for my $block (blocks) {
is($block->input, $block->expected);
}
done_testing;
__DATA__
===
--- input: 4*2
--- expected: 8
=head1 DESCRIPTION
This is a less clever version of Test::Base.
=head1 FUNCTIONS
This module exports all Test::More's exportable functions, and following functions:
=over 4
=item filters(+{ } : HashRef);
filters {
input => [qw/eval/],
};
Set a filter for the section name.
=item blocks()
Get a list of Text::TestBase::Block as filtered.
=item register_filter($name: Str, $code: CodeRef)
Register a filter for $name using $code.
=back
=head1 DEFAULT FILTERS
This module provides only few filters. If you want to add more filters, pull-reqs welcome.
(I only merge a patch using no depended modules)
=over 4
=item eval
eval() the code.
=item chomp
C<chomp()> the arguments.
=item uc
C<uc()> the arguments.
=item trim
Remove extra blank lines from the beginning and end of the data. This
allows you to visually separate your test data with blank lines.
=back
=head1 REGISTER YOUR OWN FILTER
You can register your own filter by following form:
use Digest::MD5 qw/md5_hex/;
Test::Base::Less::register_filter(md5_hex => \&md5_hex);
=head1 USE CODEREF AS FILTER
You can use a CodeRef as filter.
use Digest::MD5 qw/md5_hex/;
filters {
input => [\&md5_hex],
};
=head1 SEE ALSO
Most of code is taken from L<Test::Base>. Thanks Ingy.