summaryrefslogtreecommitdiff
path: root/lib/Test
diff options
context:
space:
mode:
authorSteve Peters <steve@fisharerojo.org>2006-07-16 14:54:58 +0000
committerSteve Peters <steve@fisharerojo.org>2006-07-16 14:54:58 +0000
commit1be77ff7d37fc4eb628469fa5911923c9a996995 (patch)
treee08584d98a2472a001f14c036899ab471ba712cb /lib/Test
parent1bdfa2dec136126216e8edf2320ed0ca1f645494 (diff)
downloadperl-1be77ff7d37fc4eb628469fa5911923c9a996995.tar.gz
Upgrade to Test-Simple-0.64
p4raw-id: //depot/perl@28586
Diffstat (limited to 'lib/Test')
-rw-r--r--lib/Test/Builder/Tester.pm150
-rw-r--r--lib/Test/More.pm9
-rw-r--r--lib/Test/Simple.pm2
-rw-r--r--lib/Test/Simple/Changes6
-rw-r--r--lib/Test/Simple/t/skip.t14
-rw-r--r--lib/Test/Simple/t/tbt_01basic.t28
-rw-r--r--lib/Test/Simple/t/tbt_05faildiag.t13
-rw-r--r--lib/Test/Simple/t/tbt_06errormess.t4
-rw-r--r--lib/Test/Simple/t/tbt_07args.t4
9 files changed, 100 insertions, 130 deletions
diff --git a/lib/Test/Builder/Tester.pm b/lib/Test/Builder/Tester.pm
index 92ca0962af..7eab5a5dc4 100644
--- a/lib/Test/Builder/Tester.pm
+++ b/lib/Test/Builder/Tester.pm
@@ -2,7 +2,7 @@ package Test::Builder::Tester;
use strict;
use vars qw(@EXPORT $VERSION @ISA);
-$VERSION = "1.03";
+$VERSION = "1.04";
use Test::Builder;
use Symbol;
@@ -18,21 +18,11 @@ Test::Builder
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
@@ -40,8 +30,8 @@ B<Test::Builder>.
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
@@ -68,7 +58,7 @@ my $t = Test::Builder->new;
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 ;-)
@@ -112,8 +102,8 @@ my $output_handle = gensym;
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
@@ -166,43 +156,55 @@ sub _start_testing
=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
@@ -217,81 +219,30 @@ instead. It takes one argument, the offset from the current line that
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
@@ -407,6 +358,7 @@ sub test_test
&& ($args{skip_err} || $err->check),
$mess))
{
+ # print out the diagnostic information about why this
# test failed
local $_;
@@ -533,7 +485,7 @@ L<Test::Builder>, L<Test::Builder::Tester::Color>, L<Test::More>.
####################################################################
# 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
@@ -591,7 +543,7 @@ sub complaint
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)
diff --git a/lib/Test/More.pm b/lib/Test/More.pm
index be7e9fcf05..465ccd3e5d 100644
--- a/lib/Test/More.pm
+++ b/lib/Test/More.pm
@@ -16,7 +16,7 @@ sub _carp {
use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
-$VERSION = '0.63';
+$VERSION = '0.64';
$VERSION = eval $VERSION; # make the alpha version come out as a number
use Test::Builder::Module;
@@ -487,7 +487,7 @@ sub can_ok ($@) {
my $name;
$name = @methods == 1 ? "$class->can('$methods[0]')"
: "$class->can(...)";
-
+
my $ok = $tb->ok( !@nok, $name );
$tb->diag(map " $class->can('$_') failed\n", @nok);
@@ -1001,6 +1001,11 @@ sub skip {
$how_many = 1;
}
+ if( defined $how_many and $how_many =~ /\D/ ) {
+ _carp "skip() was passed a non-numeric number of tests. Did you get the arguments backwards?";
+ $how_many = 1;
+ }
+
for( 1..$how_many ) {
$tb->skip($why);
}
diff --git a/lib/Test/Simple.pm b/lib/Test/Simple.pm
index d9d1617f2a..ae912d29ba 100644
--- a/lib/Test/Simple.pm
+++ b/lib/Test/Simple.pm
@@ -4,7 +4,7 @@ use 5.004;
use strict 'vars';
use vars qw($VERSION @ISA @EXPORT);
-$VERSION = '0.63';
+$VERSION = '0.64';
$VERSION = eval $VERSION; # make the alpha version come out as a number
use Test::Builder::Module;
diff --git a/lib/Test/Simple/Changes b/lib/Test/Simple/Changes
index 83c82d56de..94491eb3f1 100644
--- a/lib/Test/Simple/Changes
+++ b/lib/Test/Simple/Changes
@@ -1,3 +1,9 @@
+0.64 Sun Jul 16 02:47:29 PDT 2006
+ * 0.63's change to test_fail() broke backwards compatibility. They
+ have been removed for the time being. test_pass() went with it.
+ This is [rt.cpan.org 11317] and [rt.cpan.org 11319].
+ - skip() will now warn if you get the args backwards.
+
0.63 Sun Jul 9 02:36:36 PDT 2006
* Fixed can_ok() to gracefully handle no class name.
Submitted by "Pete Krawczyk" <perl@bsod.net>
diff --git a/lib/Test/Simple/t/skip.t b/lib/Test/Simple/t/skip.t
index 526c5acd80..f2ea9fbf20 100644
--- a/lib/Test/Simple/t/skip.t
+++ b/lib/Test/Simple/t/skip.t
@@ -7,7 +7,7 @@ BEGIN {
}
}
-use Test::More tests => 15;
+use Test::More tests => 17;
# If we skip with the same name, Test::Harness will report it back and
# we won't get lots of false bug reports.
@@ -84,3 +84,15 @@ SKIP: {
pass("This is supposed to run, too");
}
+{
+ my $warning = '';
+ local $SIG{__WARN__} = sub { $warning .= join "", @_ };
+
+ SKIP: {
+ skip 1, "This is backwards" if 1;
+
+ pass "This does not run";
+ }
+
+ like $warning, qr/^skip\(\) was passed a non-numeric number of tests/;
+}
diff --git a/lib/Test/Simple/t/tbt_01basic.t b/lib/Test/Simple/t/tbt_01basic.t
index b79f2e5ef2..77d10814b7 100644
--- a/lib/Test/Simple/t/tbt_01basic.t
+++ b/lib/Test/Simple/t/tbt_01basic.t
@@ -7,7 +7,7 @@ BEGIN {
}
}
-use Test::Builder::Tester tests => 12;
+use Test::Builder::Tester tests => 9;
use Test::More;
ok(1,"This is a basic test");
@@ -36,37 +36,27 @@ is("foo","bar","should fail");
test_test("testing failing");
+test_out("not ok 1");
+test_out("not ok 2");
test_fail(+2);
test_fail(+1);
fail(); fail();
test_test("testing failing on the same line with no name");
-test_fail(+2, 'name');
-test_fail(+1, 'name_two');
-fail("name"); fail("name_two");
+test_out("not ok 1 - name");
+test_out("not ok 2 - name");
+test_fail(+2);
+test_fail(+1);
+fail("name"); fail("name");
test_test("testing failing on the same line with the same name");
test_out("not ok 1 - name # TODO Something");
-my $line = __LINE__ + 4;
-test_err("# Failed (TODO) test ($0 at line $line)");
+test_err("# Failed (TODO) test ($0 at line 59)");
TODO: {
local $TODO = "Something";
fail("name");
}
test_test("testing failing with todo");
-test_pass();
-pass();
-test_test("testing passing with test_pass()");
-
-test_pass("some description");
-pass("some description");
-test_test("testing passing with test_pass() and description");
-
-test_pass("one test");
-test_pass("... and another");
-ok(1, "one test");
-ok(1, "... and another");
-test_test("testing pass_test() and multiple tests");
diff --git a/lib/Test/Simple/t/tbt_05faildiag.t b/lib/Test/Simple/t/tbt_05faildiag.t
index d643e3f251..0ae875a321 100644
--- a/lib/Test/Simple/t/tbt_05faildiag.t
+++ b/lib/Test/Simple/t/tbt_05faildiag.t
@@ -12,23 +12,26 @@ use Test::More;
# test_fail
-test_fail(+1, 'one');
+test_out("not ok 1 - one");
+test_fail(+1);
ok(0,"one");
-test_fail(+2, 'two');
+test_out("not ok 2 - two");
+test_fail(+2);
ok(0,"two");
test_test("test fail");
-test_fail(+1, 'one');
+test_fail(+2);
+test_out("not ok 1 - one");
ok(0,"one");
test_test("test_fail first");
# test_diag
use Test::Builder;
-my $test = Test::Builder->new();
+my $test = new Test::Builder;
test_diag("this is a test string","so is this");
$test->diag("this is a test string\n", "so is this\n");
@@ -44,3 +47,5 @@ test_diag("so is this");
$test->diag("this is a test string\n");
$test->diag("so is this\n");
test_test("test diag multiple");
+
+
diff --git a/lib/Test/Simple/t/tbt_06errormess.t b/lib/Test/Simple/t/tbt_06errormess.t
index e7625ea818..159038e2ca 100644
--- a/lib/Test/Simple/t/tbt_06errormess.t
+++ b/lib/Test/Simple/t/tbt_06errormess.t
@@ -25,8 +25,8 @@ my $output_handle = gensym;
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";
# ooooh, use the test suite
my $t = Test::Builder->new;
diff --git a/lib/Test/Simple/t/tbt_07args.t b/lib/Test/Simple/t/tbt_07args.t
index 8e802348b0..37f105094d 100644
--- a/lib/Test/Simple/t/tbt_07args.t
+++ b/lib/Test/Simple/t/tbt_07args.t
@@ -25,8 +25,8 @@ my $output_handle = gensym;
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";
# ooooh, use the test suite
my $t = Test::Builder->new;