Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Comparing changes

Choose two branches to see what’s changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
  • 18 commits
  • 8 files changed
  • 0 commit comments
  • 4 contributors
Commits on Feb 09, 2012
@rjbs advise against isnt(e{}, undef) 97571f9
@rjbs elaborate on previous advice a0a2027
@rjbs v0.009
          advise against using isnt(exception{...},undef)
116df1c
Commits on Feb 16, 2012
@rjbs test fix for perl 5.6 a912db0
@rjbs v0.010
          avoid tickling an overloading bug in perl 5.6 during testing (thanks,
          Zefram)
e6dc77f
Commits on Sep 15, 2013
@karenetheridge karenetheridge reword the Achtung! about wrapping calls that may generate stack traces
The example in the documentation is not actually a problem. What is of concern
is a wrapper sub that includes the regex in its arguments, which will then
cause a false positive via the stack trace that is produced.

The example was adapted from a similar warning in Test::Warnings, which
originally came from this dist itself, and then amended several times after
conversations with ribasushi.
d7d8f92
Commits on Sep 16, 2013
@doy doy try to fix $TODO not working when the user test uses $T::B::Level 60ec4cd
@rjbs update changelog 855aef2
@rjbs v0.011
        - more clearly (and correctly) document the way NOT to use Test::Fatal
          (thanks, Karen Etheridge!)

        - try to fix $TODO not working when the user test uses $T::B::Level
          (thanks, Jesse Luehrs)
4401aa1
Commits on Sep 17, 2013
@rjbs go back to auto-prereqs for Test::More
reverting fix for rt.cpan.org #62699
0e9c1ae
@rjbs v0.012
        - go back to auto-detecting the required Test::More, reverting the
          changes made for [rt.cpan.org #62699]
210973c
Commits on Sep 23, 2013
@rjbs v0.013
        - rebuild to get a newer compile test that may work on 5.6.x
6a495ab
Commits on Jun 30, 2014
@karenetheridge karenetheridge added convert-to-test-fatal, imported from the Moose repository c58ba9b
Commits on Dec 09, 2014
@rjbs do not assume we know the format of the filename d7532e2
@rjbs v0.014
        - avoid assuming that t/todo.t is always called t/todo.t
581f7ac
Commits on Jul 19, 2015
@rjbs default descriptions for lives_ok and dies_ok e7e166a
Commits on Jul 22, 2015
@dagolden dagolden clarify Test::Fatal limitations 82d309b
@rjbs set $Carp::MaxArgNums to -1 while running code
as suggested in #12
4515821
View
44 Changes
@@ -2,31 +2,55 @@ Revision history for {{$dist->name}}
{{$NEXT}}
+0.014 2014-12-09 18:35:59-05:00 America/New_York
+ - avoid assuming that t/todo.t is always called t/todo.t
+
+0.013 2013-09-23 10:31:15 America/New_York
+ - rebuild to get a newer compile test that may work on 5.6.x
+
+0.012 2013-09-17 22:01:45 Asia/Tokyo
+ - go back to auto-detecting the required Test::More, reverting the
+ changes made for [rt.cpan.org #62699]
+
+0.011 2013-09-17 08:48:20 Asia/Tokyo
+ - more clearly (and correctly) document the way NOT to use Test::Fatal
+ (thanks, Karen Etheridge!)
+
+ - try to fix $TODO not working when the user test uses $T::B::Level
+ (thanks, Jesse Luehrs)
+
+0.010 2012-02-16 10:27:54 America/New_York
+ - avoid tickling an overloading bug in perl 5.6 during testing (thanks,
+ Zefram)
+
+0.009 2012-02-09 15:26:11 America/New_York
+ - advise against using isnt(exception{...},undef)
+
0.008 2011-11-06 21:10:14 America/New_York
- no changes since 0.007
+ - no changes since 0.007
0.007 2011-10-31 23:22:47 America/New_York
- revert the mistake by which 0.004 allowed blocks after "exception" as
+ - revert the mistake by which 0.004 allowed blocks after "exception" as
well as "success"
0.006 2011-06-01 22:55:10 America/New_York
- crank back the Test::More and Exporter requirements
+ - crank back the Test::More and Exporter requirements
- add lives_ok and dies_ok emulation (thanks, Paul "LeoNerd" Evans)
+ - add lives_ok and dies_ok emulation (thanks, Paul "LeoNerd" Evans)
0.005 2011-04-26 07:50:48 America/New_York
- fix the logic that picks tests for 5.13.1+ (thanks, Zefram)
+ - fix the logic that picks tests for 5.13.1+ (thanks, Zefram)
0.004 2011-04-25 11:57:59 America/New_York
- success blocks now allow trailing blocks like finally, catch, etc.
+ - success blocks now allow trailing blocks like finally, catch, etc.
(thanks, Joel Bernstein)
0.003 2010-10-28 22:10:59 America/New_York
- more tests for false exceptions, especially on 5.13
+ - more tests for false exceptions, especially on 5.13
0.002 2010-10-28 00:11:09 America/New_York
- add tests for handling of false exceptions
- fix precedence error in documentation (thanks, ether)
+ - add tests for handling of false exceptions
+ - fix precedence error in documentation (thanks, ether)
0.001 2010-10-24 00:23:24 America/New_York
- first release
+ - first release
View
6 dist.ini
@@ -5,9 +5,3 @@ copyright_holder = Ricardo Signes
copyright_year = 2010
[@RJBS]
-
-[RemovePrereqs]
-remove = Test::More
-
-[Prereqs / TestRequires]
-Test::More = 0.47
View
128 examples/convert-to-test-fatal
@@ -0,0 +1,128 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Path::Tiny;
+use PPI;
+
+rewrite_doc($_) for grep { -w } @ARGV;
+
+sub rewrite_doc {
+ my $file = shift;
+
+ my $doc = PPI::Document->new($file);
+
+ return unless $doc =~ /Test::Exception/;
+
+ print $file, "\n";
+
+ my $pattern = sub {
+ my $elt = $_[1];
+
+ return 1
+ if $elt->isa('PPI::Statement')
+ && $elt->content()
+ =~ /^\s*(?:::)?(?:lives_|throws_|dies_)(?:ok|and)/;
+
+ return 0;
+ };
+
+ for my $elt ( @{ $doc->find($pattern) || [] } ) {
+ transform_statement($elt);
+ }
+
+ my $content = $doc->content();
+ $content =~ s/Test::Exception/Test::Fatal/g;
+
+ path( $file )->spew( $content );
+}
+
+sub transform_statement {
+ my $stmt = shift;
+
+ my @children = $stmt->schildren;
+
+ my $func = shift @children;
+
+ my $colons = $func =~ /^::/ ? '::' : q{};
+
+ my $code;
+ if ( $func =~ /lives_/ ) {
+ $code = function(
+ $colons . 'is',
+ $children[0],
+ 'undef',
+ $children[1]
+ );
+ }
+ elsif ( $func =~ /dies_/ ) {
+ $code = function(
+ $colons . 'isnt',
+ $children[0],
+ 'undef',
+ $children[1]
+ );
+ }
+ elsif ( $func =~ /throws_/ ) {
+
+ # $children[2] is always a comma if it exists
+ if ( $children[1]->isa('PPI::Token::QuoteLike::Regexp') ) {
+ $code = function(
+ $colons . 'like',
+ $children[0],
+ $children[1],
+ $children[3]
+ );
+ }
+ else {
+ $code = function(
+ $colons . 'is',
+ $children[0],
+ $children[1],
+ $children[3]
+ );
+ }
+ }
+
+ $stmt->insert_before($code);
+ $stmt->remove;
+}
+
+sub function {
+ my $func = shift;
+ my $exception = shift;
+ my $expect = shift;
+ my $desc = shift;
+
+ my $exc_func = $func =~ /^::/ ? '::exception' : 'exception';
+
+ my @code;
+
+ push @code,
+ PPI::Token::Word->new($func),
+ PPI::Token::Structure->new('('),
+ PPI::Token::Whitespace->new(q{ }),
+ PPI::Token::Word->new($exc_func),
+ PPI::Token::Whitespace->new(q{ }),
+ $exception->clone,
+ PPI::Token::Operator->new(','),
+ PPI::Token::Whitespace->new(q{ }),
+ ( ref $expect ? $expect->clone : PPI::Token::Word->new($expect) );
+
+ if ( $desc && $desc->isa('PPI::Token::Quote') ) {
+ push @code, PPI::Token::Operator->new(','),
+ PPI::Token::Whitespace->new(q{ }),
+ $desc->clone;
+ }
+
+ push @code,
+ PPI::Token::Whitespace->new(q{ }),
+ PPI::Token::Structure->new(')'),
+ PPI::Token::Structure->new(';');
+
+ my $stmt = PPI::Statement->new;
+ $stmt->add_element($_) for @code;
+
+ return $stmt;
+}
View
23 examples/exception_like.t
@@ -0,0 +1,23 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Test::More;
+use Test::Fatal;
+use Carp 'confess';
+
+sub exception_like(&$;$)
+{
+ my ($code, $pattern, $name) = @_;
+ like( &exception($code), $pattern, $name );
+}
+
+exception_like(sub { confess 'blah blah' }, qr/foo/, 'foo seems to appear in the exception');
+
+# the test only passes when we invert it
+unlike(
+ ( exception { confess 'blah blah' } || '' ),
+ qr/foo/,
+ 'foo does NOT ACTUALLY appear in the exception',
+);
+
+done_testing;
View
87 lib/Test/Fatal.pm
@@ -16,10 +16,10 @@ package Test::Fatal;
"the code lived",
);
- isnt(
+ like(
exception { might_die; },
- undef,
- "the code died",
+ qr/turns out it died/,
+ "the code died as expected",
);
isa_ok(
@@ -36,6 +36,12 @@ with about the same amount of typing.
It exports one routine by default: C<exception>.
+B<Achtung!> C<exception> intentionally does not manipulate the call stack.
+User-written test functions that use C<exception> must be careful to avoid
+false positives if exceptions use stack traces that show arguments. For a more
+magical approach involving globally overriding C<caller>, see
+L<Test::Exception>.
+
=cut
use Carp ();
@@ -53,7 +59,7 @@ our @EXPORT_OK = qw(exception success dies_ok lives_ok);
C<exception> takes a bare block of code and returns the exception thrown by
that block. If no exception was thrown, it returns undef.
-B<ACHTUNG!> If the block results in a I<false> exception, such as 0 or the
+B<Achtung!> If the block results in a I<false> exception, such as 0 or the
empty string, Test::Fatal itself will die. Since either of these cases
indicates a serious problem with the system under testing, this behavior is
considered a I<feature>. If you must test for these conditions, you should use
@@ -73,21 +79,80 @@ C<Sub::Uplevel> mechanism.
B<Achtung!> This is not a great idea:
- like( exception { ... }, qr/foo/, "foo appears in the exception" );
+ sub exception_like(&$;$) {
+ my ($code, $pattern, $name) = @_;
+ like( &exception($code), $pattern, $name );
+ }
+
+ exception_like(sub { }, qr/foo/, 'foo appears in the exception');
If the code in the C<...> is going to throw a stack trace with the arguments to
-each subroutine in its call stack, the test name, "foo appears in the
-exception" will itself be matched by the regex. Instead, write this:
+each subroutine in its call stack (for example via C<Carp::confess>,
+the test name, "foo appears in the exception" will itself be matched by the
+regex. Instead, write this:
- my $exception = exception { ... };
- like( $exception, qr/foo/, "foo appears in the exception" );
+ like( exception { ... }, qr/foo/, 'foo appears in the exception' );
+
+If you really want a test function that passes the test name, wrap the
+arguments in an array reference to hide the literal text from a stack trace:
+
+ sub exception_like(&$) {
+ my ($code, $args) = @_;
+ my ($pattern, $name) = @$args;
+ like( &exception($code), $pattern, $name );
+ }
+
+ exception_like(sub { }, [ qr/foo/, 'foo appears in the exception' ] );
+
+To aid in avoiding the problem where the pattern is seen in the exception
+because of the call stack, C<$Carp::MAxArgNums> is locally set to -1 when the
+code block is called. If you really don't want that, set it back to whatever
+value you like at the beginning of the code block. Obviously, this solution
+doens't affect all possible ways that args of subroutines in the call stack
+might taint the test. The intention here is to prevent some false passes from
+people who didn't read the documentation. Your punishment for reading it is
+that you must consider whether to do anything about this.
+
+B<Achtung>: One final bad idea:
+
+ isnt( exception { ... }, undef, "my code died!");
+
+It's true that this tests that your code died, but you should really test that
+it died I<for the right reason>. For example, if you make an unrelated mistake
+in the block, like using the wrong dereference, your test will pass even though
+the code to be tested isn't really run at all. If you're expecting an
+inspectable exception with an identifier or class, test that. If you're
+expecting a string exception, consider using C<like>.
=cut
+our ($REAL_TBL, $REAL_CALCULATED_TBL) = (1, 1);
+
sub exception (&) {
my $code = shift;
return try {
+ my $incremented = $Test::Builder::Level - $REAL_CALCULATED_TBL;
+ local $Test::Builder::Level = $REAL_CALCULATED_TBL;
+ if ($incremented) {
+ # each call to exception adds 5 stack frames
+ $Test::Builder::Level += 5;
+ for my $i (1..$incremented) {
+ # -2 because we want to see it from the perspective of the call to
+ # is() within the call to $code->()
+ my $caller = caller($Test::Builder::Level - 2);
+ if ($caller eq __PACKAGE__) {
+ # each call to exception adds 5 stack frames
+ $Test::Builder::Level = $Test::Builder::Level + 5;
+ }
+ else {
+ $Test::Builder::Level = $Test::Builder::Level + 1;
+ }
+ }
+ }
+
+ local $REAL_CALCULATED_TBL = $Test::Builder::Level;
+ local $Carp::MaxArgNums = -1;
$code->();
return undef;
} catch {
@@ -151,7 +216,7 @@ my $Tester;
# Signature should match that of Test::Exception
sub dies_ok (&;$) {
my $code = shift;
- my $name = shift;
+ my $name = shift || "code should throw an exception";
require Test::Builder;
$Tester ||= Test::Builder->new;
@@ -163,7 +228,7 @@ sub dies_ok (&;$) {
sub lives_ok (&;$) {
my $code = shift;
- my $name = shift;
+ my $name = shift || "code should not throw an exception";
require Test::Builder;
$Tester ||= Test::Builder->new;
View
2  t/basic.t
@@ -67,7 +67,7 @@ if ($] < 5.013001) {
{
package FalseObject;
- use overload 'bool' => sub { return };
+ use overload 'bool' => sub { 0 };
}
like(
View
10 t/like-exception.t
@@ -2,7 +2,7 @@
use strict;
-use Test::Builder::Tester tests => 4;
+use Test::Builder::Tester tests => 6;
use Test::Fatal qw( dies_ok lives_ok );
@@ -10,6 +10,10 @@ test_out( "ok 1 - died" );
dies_ok { die "FAIL" } 'died';
test_test( "die dies" );
+test_out( "ok 1 - code should throw an exception" );
+dies_ok { die "FAIL" };
+test_test( "die dies (default description)" );
+
test_out( "not ok 1 - returned" );
test_fail( +2 );
test_err( "# expected an exception but none was raised" );
@@ -20,6 +24,10 @@ test_out( "ok 1 - returned" );
lives_ok { return 1 } 'returned';
test_test( "return lived" );
+test_out( "ok 1 - code should not throw an exception" );
+lives_ok { return 1 };
+test_test( "return lived (default description)" );
+
test_out( "not ok 1 - died" );
test_fail( +2 );
test_err( "# expected return but an exception was raised" );
View
133 t/todo.t
@@ -0,0 +1,133 @@
+#!/usr/bin/perl
+
+use strict;
+
+use Test::Builder::Tester tests => 4;
+
+use Test::More;
+use Test::Fatal;
+
+my $file = __FILE__;
+
+{
+ my $line = __LINE__ + 13;
+ my $out = <<FAIL;
+not ok 1 - succeeded # TODO unimplemented
+# Failed (TODO) test 'succeeded'
+# at $file line $line.
+# got: '0'
+# expected: '1'
+ok 2 - no exceptions # TODO unimplemented
+FAIL
+ chomp($out);
+ test_out($out);
+ {
+ local $TODO = "unimplemented";
+ is(exception { is(0, 1, "succeeded") }, undef, "no exceptions");
+ }
+ test_test( "\$TODO works" );
+}
+
+{
+ my $line = __LINE__ + 13;
+ my $out = <<FAIL;
+not ok 1 - succeeded # TODO unimplemented
+# Failed (TODO) test 'succeeded'
+# at $file line $line.
+# got: '0'
+# expected: '1'
+ok 2 - no exceptions # TODO unimplemented
+FAIL
+ chomp($out);
+ test_out($out);
+ {
+ local $TODO = "unimplemented";
+ stuff_is_ok(0, 1);
+ }
+ test_test( "\$TODO works" );
+
+ sub stuff_is_ok {
+ my ($got, $expected) = @_;
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ is(
+ exception { is($got, $expected, "succeeded") },
+ undef,
+ "no exceptions"
+ );
+ }
+}
+
+{
+ my $line = __LINE__ + 13;
+ my $out = <<FAIL;
+not ok 1 - succeeded # TODO unimplemented
+# Failed (TODO) test 'succeeded'
+# at $file line $line.
+# got: '0'
+# expected: '1'
+ok 2 - no exceptions # TODO unimplemented
+FAIL
+ chomp($out);
+ test_out($out);
+ {
+ local $TODO = "unimplemented";
+ stuff_is_ok2(0, 1);
+ }
+ test_test( "\$TODO works" );
+
+ sub stuff_is_ok2 {
+ my ($got, $expected) = @_;
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ _stuff_is_ok2(@_);
+ }
+
+ sub _stuff_is_ok2 {
+ my ($got, $expected) = @_;
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ is(
+ exception { is($got, $expected, "succeeded") },
+ undef,
+ "no exceptions"
+ );
+ }
+}
+
+{
+ my $line = __LINE__ + 14;
+ my $out = <<FAIL;
+not ok 1 - succeeded # TODO unimplemented
+# Failed (TODO) test 'succeeded'
+# at $file line $line.
+# got: '0'
+# expected: '1'
+ok 2 - no exceptions # TODO unimplemented
+ok 3 - level 1 # TODO unimplemented
+FAIL
+ chomp($out);
+ test_out($out);
+ {
+ local $TODO = "unimplemented";
+ multi_level_ok(0, 1);
+ }
+ test_test( "\$TODO works" );
+
+ sub multi_level_ok {
+ my ($got, $expected) = @_;
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ is(
+ exception { _multi_level_ok($got, $expected) },
+ undef,
+ "level 1"
+ );
+ }
+
+ sub _multi_level_ok {
+ my ($got, $expected) = @_;
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ is(
+ exception { is($got, $expected, "succeeded") },
+ undef,
+ "no exceptions"
+ );
+ }
+}

No commit comments for this range

Something went wrong with that request. Please try again.