Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

We’re showing branches in this repository, but you can also compare across forks.

base: 4cb18a
...
compare: master
  • 15 commits
  • 7 files changed
  • 0 commit comments
  • 3 contributors
Commits on Feb 09, 2012
Ricardo Signes advise against isnt(e{}, undef) 97571f9
Ricardo Signes elaborate on previous advice a0a2027
Ricardo Signes v0.009
          advise against using isnt(exception{...},undef)
116df1c
Commits on Feb 16, 2012
Ricardo Signes test fix for perl 5.6 a912db0
Ricardo Signes v0.010
          avoid tickling an overloading bug in perl 5.6 during testing (thanks,
          Zefram)
e6dc77f
Commits on Sep 15, 2013
Karen Etheridge 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
Jesse Luehrs doy try to fix $TODO not working when the user test uses $T::B::Level 60ec4cd
Ricardo Signes update changelog 855aef2
Ricardo Signes 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
Ricardo Signes go back to auto-prereqs for Test::More
reverting fix for rt.cpan.org #62699
0e9c1ae
Ricardo Signes 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
Ricardo Signes v0.013
        - rebuild to get a newer compile test that may work on 5.6.x
6a495ab
Commits on Jun 30, 2014
Karen Etheridge karenetheridge added convert-to-test-fatal, imported from the Moose repository c58ba9b
Commits on Dec 09, 2014
Ricardo Signes do not assume we know the format of the filename d7532e2
Ricardo Signes v0.014
        - avoid assuming that t/todo.t is always called t/todo.t
581f7ac
44 Changes
View
@@ -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
6 dist.ini
View
@@ -5,9 +5,3 @@ copyright_holder = Ricardo Signes
copyright_year = 2010
[@RJBS]
-
-[RemovePrereqs]
-remove = Test::More
-
-[Prereqs / TestRequires]
-Test::More = 0.47
128 examples/convert-to-test-fatal
View
@@ -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;
+}
23 examples/exception_like.t
View
@@ -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;
56 lib/Test/Fatal.pm
View
@@ -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(
@@ -53,7 +53,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 +73,59 @@ 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' );
+
+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;
$code->();
return undef;
} catch {
2  t/basic.t
View
@@ -67,7 +67,7 @@ if ($] < 5.013001) {
{
package FalseObject;
- use overload 'bool' => sub { return };
+ use overload 'bool' => sub { 0 };
}
like(
133 t/todo.t
View
@@ -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.