2 files changed, 151 insertions, 0 deletions
diff --git a/examples/convert-to-test-fatal b/examples/convert-to-test-fatal
new file mode 100755
index 0000000..f937d6e
--- /dev/null
+++ b/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;
+}
diff --git a/examples/exception_like.t b/examples/exception_like.t
new file mode 100644
index 0000000..b5355fe
--- /dev/null
+++ b/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;