Test-Lazy
view release on metacpan or search on metacpan
lib/Test/Lazy/Template.pm view on Meta::CPAN
my $template = new Test::Lazy::Template([
[ "qw/1/" ],
[ "qw/a/" ],
[ "qw/apple/" ],
[ "qw/2/" ],
[ "qw/0/" ],
[ "qw/-1/" ],
[ "map { \$_ => \$_ * 2 } qw/0 1 2 3 4/" ],
]);
# Run some different tests.
# NOTE: Don't have to use '%?' if the statement will run without modification.
$template->test("defined(%?)" => ok => undef);
$template->test("length(%?) >= 1" => ok => undef);
$template->test("length(%?)" => '>=' => 1);
$template->test("length(%?)" => '<' => 10);
$template->test([
[ '%?' => is => 1 ],
[ is => 'a' ],
[ is => 'apple' ],
[ is => 2 ],
[ is => 0 ],
[ is => is => -1 ],
[ is => { 0 => 0, 1 => 2, 2 => 4, 3 => 6, 4 => 8 } ],
]);
=head1 METHODS
=head2 Test::Lazy::Template->new( <template> )
=head2 Test::Lazy::Template->new( <test>, <test>, ..., <test> )
Create a new C<Test::Lazy::Template> object using the giving test specification.
If <template> is a SCALAR reference, then new will split <template> on each newline,
ignoring empty lines and lines beginning with a pound (#).
# You could do something like this:
my $template = template(\<<_END_);
qw/1/
qw/a/
qw/apple/
qw/2/
qw/0/
qw/-1/
# Let's test this one too.
map { \$_ => \$_ * 2 } qw/0 1 2 3 4/
_END_
Returns the new C<Test::Lazy::Template> object
=cut
sub new {
my $self = bless {}, shift;
my $tester = blessed $_[0] && $_[0]->isa("Test::Lazy::Tester") ? shift : Test::Lazy::Tester->new;
my $template = $_[0];
if (ref $template eq 'SCALAR') {
my @template = map { [ $_ ] } grep { length $_ && $_ !~ m/^\s*#/ } split m/\n/, $$template;
$template = \@template;
}
elsif (ref $template eq 'ARRAY') {
}
else {
$template = [ @_ ];
}
$self->tester($tester);
$self->template($template);
return $self;
}
=head2 $template->test( <template> )
For each test in $template, modify and run each the test according to the corresponding entry in <template>.
=head2 $template->test( <test> )
Modify and then run each test in $template by using <test> to complete each test's specification.
=cut
sub test {
my $self = shift;
my $template = $self->template;
my $size = @$template;
my $mdf_template;
my $base_stmt;
if (ref $_[0] eq 'ARRAY') {
$mdf_template = shift;
}
elsif (ref $_[1] eq 'ARRAY') {
$base_stmt = shift;
$mdf_template = shift;
}
else {
my ($mdf_stmt, $mdf_cmpr, $mdf_rslt);
if (2 == @_) {
($mdf_stmt, $mdf_cmpr, $mdf_rslt) = (undef, @_);
}
else {
($mdf_stmt, $mdf_cmpr, $mdf_rslt) = @_;
}
$mdf_template = [ map { [ $mdf_stmt, $mdf_cmpr, $mdf_rslt ] } (0 .. $size - 1) ];
}
for (my $index = 0; $index < $size; ++$index) {
my $line = $template->[$index];
my $mdf_line = $mdf_template->[$index];
my ($mdf_stmt, $mdf_cmpr, $mdf_rslt);
if (2 == @$mdf_line) {
($mdf_stmt, $mdf_cmpr, $mdf_rslt) = ($base_stmt, @$mdf_line);
}
else {
($mdf_stmt, $mdf_cmpr, $mdf_rslt) = @$mdf_line;
}
( run in 1.196 second using v1.01-cache-2.11-cpan-71847e10f99 )