6 use Test::More tests => 25;
12 local $Test::Builder::Level = $Test::Builder::Level + 2;
13 return ( scalar(eval { $_[0]->(); 1 }), $@ );
18 my ( $code, $desc ) = @_;
19 local $Test::Builder::Level = $Test::Builder::Level + 1;
21 my ( $ok, $error ) = _eval($code);
25 diag "error: $@" unless $ok;
29 my ( $code, $regex, $desc ) = @_;
30 local $Test::Builder::Level = $Test::Builder::Level + 1;
32 my ( $ok, $error ) = _eval($code);
37 like($error || '', $regex, $desc );
59 is( try { 42 }, 42, "try block evaluated" );
60 is( $@, "magic", '$@ untouched' );
65 is( try { die "foo" }, undef, "try block died" );
66 is( $@, "magic", '$@ untouched' );
71 like( (try { die "foo" } catch { $_ }), qr/foo/, "catch block evaluated" );
72 is( $@, "magic", '$@ untouched' );
75 is( scalar(try { "foo", "bar", "gorch" }), "gorch", "scalar context try" );
76 is_deeply( [ try {qw(foo bar gorch)} ], [qw(foo bar gorch)], "list context try" );
78 is( scalar(try { die } catch { "foo", "bar", "gorch" }), "gorch", "scalar context catch" );
79 is_deeply( [ try { die } catch {qw(foo bar gorch)} ], [qw(foo bar gorch)], "list context catch" );
83 my ($sub) = catch { my $a = $_; };
84 is(ref($sub), 'Try::Tiny::Catch', 'Checking catch subroutine scalar reference is correctly blessed');
88 my ($sub) = finally { my $a = $_; };
89 is(ref($sub), 'Try::Tiny::Finally', 'Checking finally subroutine scalar reference is correctly blessed');
101 fail("shouldn't happen");
106 } "try in try catch block";
116 die "rethrowing $err";
118 } qr/rethrowing foo/, "rethrow with try in catch block";
125 sub Evil::new { bless { }, $_[0] }
129 local $_ = "other magic";
132 my $object = Evil->new;
135 pass("catch invoked");
136 local $TODO = "i don't think we can ever make this work sanely, maybe with SIG{__DIE__}" if $] < 5.014;
140 is( $@, "magic", '$@ untouched' );
141 is( $_, "other magic", '$_ untouched' );
145 my ( $caught, $prev );
150 eval { die "bar\n" };
152 is( $@, "bar\n", 'previous value of $@' );
164 is_deeply( $caught, { prev => "bar\n" }, 'previous value of $@ available for capture' );
165 is( $prev, "bar\n", 'previous value of $@ also available in catch block' );