4 use Test::More tests => 25;
10 local $Test::Builder::Level = $Test::Builder::Level + 2;
11 return ( scalar(eval { $_[0]->(); 1 }), $@ );
16 my ( $code, $desc ) = @_;
17 local $Test::Builder::Level = $Test::Builder::Level + 1;
19 my ( $ok, $error ) = _eval($code);
23 diag "error: $@" unless $ok;
27 my ( $code, $regex, $desc ) = @_;
28 local $Test::Builder::Level = $Test::Builder::Level + 1;
30 my ( $ok, $error ) = _eval($code);
35 like($error || '', $regex, $desc );
57 is( try { 42 }, 42, "try block evaluated" );
58 is( $@, "magic", '$@ untouched' );
63 is( try { die "foo" }, undef, "try block died" );
64 is( $@, "magic", '$@ untouched' );
69 like( (try { die "foo" } catch { $_ }), qr/foo/, "catch block evaluated" );
70 is( $@, "magic", '$@ untouched' );
73 is( scalar(try { "foo", "bar", "gorch" }), "gorch", "scalar context try" );
74 is_deeply( [ try {qw(foo bar gorch)} ], [qw(foo bar gorch)], "list context try" );
76 is( scalar(try { die } catch { "foo", "bar", "gorch" }), "gorch", "scalar context catch" );
77 is_deeply( [ try { die } catch {qw(foo bar gorch)} ], [qw(foo bar gorch)], "list context catch" );
81 my ($sub) = catch { my $a = $_; };
82 is(ref($sub), 'Try::Tiny::Catch', 'Checking catch subroutine scalar reference is correctly blessed');
86 my ($sub) = finally { my $a = $_; };
87 is(ref($sub), 'Try::Tiny::Finally', 'Checking finally subroutine scalar reference is correctly blessed');
99 fail("shouldn't happen");
104 } "try in try catch block";
114 die "rethrowing $err";
116 } qr/rethrowing foo/, "rethrow with try in catch block";
123 sub Evil::new { bless { }, $_[0] }
127 local $_ = "other magic";
130 my $object = Evil->new;
133 pass("catch invoked");
134 local $TODO = "i don't think we can ever make this work sanely, maybe with SIG{__DIE__}" if $] < 5.014;
138 is( $@, "magic", '$@ untouched' );
139 is( $_, "other magic", '$_ untouched' );
143 my ( $caught, $prev );
148 eval { die "bar\n" };
150 is( $@, "bar\n", 'previous value of $@' );
162 is_deeply( $caught, { prev => "bar\n" }, 'previous value of $@ available for capture' );
163 is( $prev, "bar\n", 'previous value of $@ also available in catch block' );