[Templates-cvs] cvs commit: TT3/lib/Template Test.pm
cvs@template-toolkit.org
cvs@template-toolkit.org
Thu, 25 Mar 2004 16:58:41 +0000
cvs 04/03/25 16:58:40
Added: lib/Template Test.pm
Log:
* added new Template::Test module
Revision Changes Path
1.1 TT3/lib/Template/Test.pm
Index: Test.pm
===================================================================
#========================================================================
#
# Template::Test
#
# DESCRIPTION
# Module implementing a number of useful functions for writing TT test
# scripts.
#
# AUTHOR
# Andy Wardley <abw@wardley.org>
#
# COPYRIGHT
# Copyright (C) 1996-2003 Andy Wardley. All Rights Reserved.
# Copyright (C) 1998-2002 Canon Research Centre Europe Ltd.
# Copyright (C) 2004 Fotango Ltd.
#
# This module is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# REVISION
# $Id: Test.pm,v 1.1 2004/03/25 16:58:40 abw Exp $
#
#========================================================================
package Template::Test;
use strict;
use warnings;
use Exporter;
use Template::Base;
use base qw( Template::Base Exporter );
use vars qw( $VERSION $DEBUG $ERROR $WARNING
$MAGIC $DATA $DIFF @EXPORT_OK %EXPORT_TAGS );
$VERSION = sprintf("%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/);
$DEBUG = 0 unless defined $DEBUG;
$ERROR = '';
$MAGIC = '\s* -- \s*';
# can we generate a nice diff output?
eval "use Algorithm::Diff qw( diff )";
$DIFF = $@ ? 0 : 1;
@EXPORT_OK = qw( data_text data_tests test_expect diff_result $DIFF );
%EXPORT_TAGS = ( all => [ @EXPORT_OK ] );
#------------------------------------------------------------------------
# data_text()
#
# Returns the text from the DATA section and caches it locally so that
# we can fetch it again and again. It also looks for an extra __END__ tag
# in the text (yes, an extra one coming after the first one), and removes
# anything after it.
#------------------------------------------------------------------------
sub data_text {
return $DATA if defined $DATA;
local $/ = undef;
$DATA = <main::DATA>;
$DATA =~ s/^__END__.*//sm;
return $DATA;
}
#------------------------------------------------------------------------
# data_tests()
#
# Calls data_text() to read the text in the DATA section and splits it
# into a number of tests.
#------------------------------------------------------------------------
sub data_tests {
my $source = shift || data_text();
my (@tests, $test, $input, $expect);
my $count = 0;
# remove any comment lines
$source =~ s/^#.*?\n//gm;
# remove anything before '-- start --' and/or after '-- stop --'
$source =~ s/ .*? ^ $MAGIC start $MAGIC \n //smix;
$source =~ s/ ^ $MAGIC stop $MAGIC \n .* //smix;
@tests = split(/ ^ $MAGIC test /mix, $source);
# if the first line of the file was '-- test --' (optional) then the
# first test will be empty and can be discarded
shift(@tests) if $tests[0] =~ /^\s*$/;
foreach $test (@tests) {
$test =~ s/ ^ \s* (.*?) $MAGIC \n //x;
my $name = $1 || 'test ' . ++$count;
# split input by a line like "-- expect --"
($input, $expect) =
split(/ ^ $MAGIC expect $MAGIC \n/mix, $test);
$expect = ''
unless defined $expect;
my @inflags;
while ($input =~ s/ ^ $MAGIC (.*?) $MAGIC \n //mx) {
push(@inflags, $1);
}
my @exflags;
while ($expect =~ s/ ^ $MAGIC (.*?) $MAGIC \n //mx) {
push(@exflags, $1);
}
for ($input, $expect) {
s/^\s+//;
s/\s+$//;
}
$test = {
name => $name,
input => $input,
expect => $expect,
inflags => \@inflags,
exflags => \@exflags,
};
}
return wantarray ? @tests : \@tests;
}
#------------------------------------------------------------------------
# test_expect()
#
# Run each test in the data section and check the output matches what
# was expected.
#------------------------------------------------------------------------
sub test_expect {
my $config = @_ && ref $_[0] eq 'HASH' ? shift : { @_ };
my $tests = $config->{ tests } || data_tests();
my $handler = $config->{ handler }
|| die "no handler provider for test_expect()\n";
my $ok = $config->{ ok }
|| die "no ok() subroutine provided for test_expect()\n";
foreach my $test (@$tests) {
if (grep(/skip/, @{ $test->{ inflags } })) {
&$ok( 1, "skipping test: $test->{ name }" );
next;
}
my $result = &$handler($test);
if ($result eq $test->{ expect }) {
&$ok(1, $test->{ name });
}
else {
&$ok(0, "$test->{ name } did not match");
# if ($config->{ debug } || $config->{ $DEBUG) {
my ($e, $r) = ($test->{ expect }, $result);
for ($e, $r) {
s/^/#/gm;
}
print STDERR "# -- expect --\n$e\n";
print STDERR "# -- result --\n$r\n";
if ($DIFF) {
print STDERR "# -- diffs --\n";
diff_result($test->{ expect }, $result);
}
# }
}
}
}
sub diff_result {
my ($expect, $result) = @_;
return warn "Algorithm:Diff not installed, cannot run diff_result()\n"
unless $DIFF;
my $diffs = diff( map { [ split(/\n/) ] } $expect, $result );
my $n = 0;
foreach my $hunk (@$diffs) {
print STDERR '# -- hunk ', ++$n, ' of ', scalar @$diffs, " --\n";
foreach my $diff (@$hunk) {
my $line = sprintf('%3d', $diff->[1]);
print STDERR "# $diff->[0] $line $diff->[2]\n";
}
}
}
1;
__END__
=head1 NAME
Template::Test - useful functions for writing test scripts
=head1 SYNOPSIS
use Template::Test qw( :all );
my $data = data_text()
__DATA__
This s
=head1 DESCRIPTION
This module implements a number of useful subroutines for testing
the Template Toolkit.
=head1 SUBROUTINES
=head2 data_text()
Returns the text from the DATA section of the calling program, coming
after an C<__END__> or C<__DATA__> marker. If a second C<__END__>
marker is found in the text then it and anything after it is removed.
use Template::Test qw( data_text )
print data_text(); # hello world
__DATA__
hello world
__END__
This part is ignored. We can put any editor variables/flags here
# Local Variables:
# mode: perl
# perl-indent-level: 4
# indent-tabs-mode: nil
# End:
#
# vim: expandtab shiftwidth=4:
The text is cached internally so that you can call data_text() as many
times as you like and get the same text back each time.
=head2 data_tests()
Calls data_text() to read the text from the DATA section and then
splits it into a number of tests.
The subroutine looks for special command lines embedded in the text,
appearing at the start of a line and surrounded by C<--> character
sequences. For example:
this is ignored
-- start --
-- test number one --
This is the input
-- expect --
This is the expected output
-- end --
this is ignored
Anything coming before a C<-- start --> line or after an C<-- end --> line
is ignored. Each test begins with a C<-- test --> line which can also
contain a short name for the test, e.g. C<-- test number one -->. This is
followed by an C<-- expect --> line and the expected output of the test.
-- test number one --
This is the input
-- expect --
This is the expected output
-- test number two --
This is the input for test number two
-- expect --
This is the expected output of test two
Each 'test' or 'expect' section can be followed any further flags, also
defined in the same way. The C<-- skip --> flag can be set, for example,
to temporarily skip a test.
-- test number one --
-- skip --
This is the input
-- expect --
This is the expected output
=head2 test_expect()
This method calls data_tests() to fetch each of the tests defined in the
data section and then runs each one, passing the input into a handler
provided as an argument, and checking that the output returned matches
the expected output. Any tests that have the C<-- skip --> flag set are
skipped.
Here's an example showing how it is used.
TODO: more docs here.
use Test::More tests => 30;
test_expect({
handler => \&parse,
ok => \&ok,
});
sub parse {
my $test = shift;
my $input = $test->{ input };
return $compiler->compile($input)
|| "error: " . $compiler->error();
}
__END__
-- test number one --
source of template...
-- expect --
compiled perl code for template...
-- test number two --
source of another template...
-- expect --
compiled perl code for another template...
=head1 AUTHOR
Andy Wardley E<lt>abw@wardley.orgE<gt>
=head1 VERSION
$Revision: 1.1 $
=head1 COPYRIGHT
Copyright (C) 1996-2003 Andy Wardley. All Rights Reserved.
Copyright (C) 1998-2002 Canon Research Centre Europe Ltd.
Copyright (C) 2004 Fotango Ltd.
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut
# Local Variables:
# mode: perl
# perl-indent-level: 4
# indent-tabs-mode: nil
# End:
#
# vim: expandtab shiftwidth=4: