use strict;
use vars qw(@EXPORT $VERSION @ISA);
-$VERSION = "1.03";
+$VERSION = "1.07";
use Test::Builder;
use Symbol;
use Test::Builder::Tester tests => 1;
use Test::More;
- test_fail(+1, "foo");
+ test_out("not ok 1 - foo");
+ test_fail(+1);
fail("foo");
test_test("fail works");
- test_pass("baz");
- ok(1, "baz");
- test_test("pass works");
-
- test_fail(+3, "is foo bar?");
- test_err("# got: 'foo'",
- "# expected: 'bar'");
- is("foo", "bar", "is foo bar?");
- test_test("diagnostic checking works");
-
-
=head1 DESCRIPTION
A module that helps you test testing modules that are built with
The testing system is designed to be used by performing a three step
process for each test you wish to test. This process starts with using
-Test::Builder::Tester functions to declare what the testsuite you
-are testing will output with B<Test::Builder>.
+C<test_out> and C<test_err> in advance to declare what the testsuite you
+are testing will output with B<Test::Builder> to stdout and stderr.
You then can run the test(s) from your test suite that call
B<Test::Builder>. At this point the output of B<Test::Builder> is
use Exporter;
@ISA = qw(Exporter);
-@EXPORT = qw(test_out test_err test_fail test_diag test_test line_num test_pass);
+@EXPORT = qw(test_out test_err test_fail test_diag test_test line_num);
# _export_to_level and import stolen directly from Test::More. I am
# the king of cargo cult programming ;-)
my $error_handle = gensym;
# and tie them to this package
-my $out = tie *$output_handle, "Test::Tester::Tie", "STDOUT";
-my $err = tie *$error_handle, "Test::Tester::Tie", "STDERR";
+my $out = tie *$output_handle, "Test::Builder::Tester::Tie", "STDOUT";
+my $err = tie *$error_handle, "Test::Builder::Tester::Tie", "STDERR";
####
# exported functions
=head2 Functions
-These are the functions exported by default.
+These are the six methods that are exported as default.
=over 4
-=item test_pass
+=item test_out
- test_pass();
- test_pass($description);
+=item test_err
-Because the standard success message that B<Test::Builder> produces
-whenever a test passes will be common in your test error
-output, rather than forcing you to call C<test_out> with the string
-all the time like so
+Procedures for predeclaring the output that your test suite is
+expected to produce until C<test_test> is called. These procedures
+automatically assume that each line terminates with "\n". So
- test_out("ok 1 - some test name here");
+ test_out("ok 1","ok 2");
-C<test_pass> exists as a convenience function that you can call instead. It
-takes one optional argument, the test description from the test you expect to
-pass. The following is equivalent to the above C<test_out> call.
+is the same as
+
+ test_out("ok 1\nok 2");
+
+which is even the same as
- test_pass("some test name here");
+ test_out("ok 1");
+ test_out("ok 2");
+
+Once C<test_out> or C<test_err> (or C<test_fail> or C<test_diag>) have
+been called once all further output from B<Test::Builder> will be
+captured by B<Test::Builder::Tester>. This means that your will not
+be able perform further tests to the normal output in the normal way
+until you call C<test_test> (well, unless you manually meddle with the
+output filehandles)
=cut
-sub test_pass(;$)
+sub test_out(@)
{
- _start_testing() unless $testing++;
- my $mess = "ok $testing";
- $mess .= ' - ' . shift if @_;
- $out->expect( $mess, @_ );
+ # do we need to do any setup?
+ _start_testing() unless $testing;
+
+ $out->expect(@_)
}
+sub test_err(@)
+{
+ # do we need to do any setup?
+ _start_testing() unless $testing;
-=item test_fail
+ $err->expect(@_)
+}
- test_fail($line_num_offset);
- test_fail($line_num_offset, $description);
+=item test_fail
Because the standard failure message that B<Test::Builder> produces
whenever a test fails will be a common occurrence in your test error
the line that causes the fail is on.
test_fail(+1);
- ok(0);
-It optionally takes the $description of the test.
+This means that the example in the synopsis could be rewritten
+more simply as:
- test_fail(+1, "kaboom");
- fail("kaboom");
+ test_out("not ok 1 - foo");
+ test_fail(+1);
+ fail("foo");
+ test_test("fail works");
=cut
sub test_fail
{
# do we need to do any setup?
- _start_testing() unless $testing++;
+ _start_testing() unless $testing;
# work out what line we should be on
my ($package, $filename, $line) = caller;
$line = $line + (shift() || 0); # prevent warnings
- my $mess = "not ok $testing";
- $mess .= ' - ' . shift if @_;
- $out->expect( $mess );
-
# expect that on stderr
$err->expect("# Failed test ($0 at line $line)");
}
-
-=item test_out
-
- test_out(@output);
-
-=item test_err
-
- test_err(@diagnostic_output);
-
-Procedures for predeclaring the output that your test suite is
-expected to produce until C<test_test> is called. These procedures
-automatically assume that each line terminates with "\n". So
-
- test_out("foo","bar");
-
-is the same as
-
- test_out("foo\nbar");
-
-which is even the same as
-
- test_out("foo");
- test_out("bar");
-
-Once C<test_out> or C<test_err> (or C<test_fail>, C<test_pass>, or
-C<test_diag>) have been called once all further output from B<Test::Builder>
-will be captured by B<Test::Builder::Tester>. This means that your will not be
-able perform further tests to the normal output in the normal way until you
-call C<test_test>.
-
-=cut
-
-sub test_out(@)
-{
- # do we need to do any setup?
- _start_testing() unless $testing;
-
- $out->expect(@_)
-}
-
-sub test_err(@)
-{
- # do we need to do any setup?
- _start_testing() unless $testing;
-
- $err->expect(@_)
-}
-
-
=item test_diag
As most of the remaining expected output to the error stream will be
&& ($args{skip_err} || $err->check),
$mess))
{
+ # print out the diagnostic information about why this
# test failed
local $_;
####################################################################
# Helper class that is used to remember expected and received data
-package Test::Tester::Tie;
+package Test::Builder::Tester::Tie;
##
# add line(s) to be expected
my @checks = @_;
foreach my $check (@checks) {
$check = $self->_translate_Failed_check($check);
- push @{$self->[2]}, ref $check ? $check : "$check\n";
+ push @{$self->{wanted}}, ref $check ? $check : "$check\n";
}
}
-sub _translate_Failed_check
+sub _translate_Failed_check
{
my($self, $check) = @_;
- if( $check =~ /\A(.*)# (Failed .*test) \((.*?) at line (\d+)\)\z/ ) {
- $check = qr/\Q$1\E#\s+\Q$2\E.*?\n?.*?\Q$3\E at line \Q$4\E.*\n?/;
+ if( $check =~ /\A(.*)# (Failed .*test) \((.*?) at line (\d+)\)\Z(?!\n)/ ) {
+ $check = "/\Q$1\E#\\s+\Q$2\E.*?\\n?.*?\Qat $3\E line \Q$4\E.*\\n?/";
}
return $check;
# turn off warnings as these might be undef
local $^W = 0;
- my @checks = @{$self->[2]};
- my $got = $self->[1];
+ my @checks = @{$self->{wanted}};
+ my $got = $self->{got};
foreach my $check (@checks) {
- $check = qr/^\Q$check\E/ unless ref $check;
+ $check = "\Q$check\E" unless ($check =~ s,^/(.*)/$,$1, or ref $check);
return 0 unless $got =~ s/^$check//;
}
my $self = shift;
my $type = $self->type;
my $got = $self->got;
- my $wanted = join '', @{$self->wanted};
+ my $wanted = join "\n", @{$self->wanted};
# are we running in colour mode?
if (Test::Builder::Tester::color)
sub reset
{
my $self = shift;
- @$self = ($self->[0], '', []);
+ %$self = (
+ type => $self->{type},
+ got => '',
+ wanted => [],
+ );
}
sub got
{
my $self = shift;
- return $self->[1];
+ return $self->{got};
}
sub wanted
{
my $self = shift;
- return $self->[2];
+ return $self->{wanted};
}
sub type
{
my $self = shift;
- return $self->[0];
+ return $self->{type};
}
###
sub PRINT {
my $self = shift;
- $self->[1] .= join '', @_;
+ $self->{got} .= join '', @_;
}
sub TIEHANDLE {
my($class, $type) = @_;
- my $self = bless [$type], $class;
+ my $self = bless {
+ type => $type
+ }, $class;
+
$self->reset;
return $self;
projects / p5sagit/p5-mst-13.2.git / blobdiff