4 use Test::More tests => 25;
9 local $Test::Builder::Level = $Test::Builder::Level + 2;
10 return ( scalar(eval { $_[0]->(); 1 }), $@ );
15 my ( $code, $desc ) = @_;
16 local $Test::Builder::Level = $Test::Builder::Level + 1;
18 my ( $ok, $error ) = _eval($code);
22 diag "error: $@" unless $ok;
26 my ( $code, $regex, $desc ) = @_;
27 local $Test::Builder::Level = $Test::Builder::Level + 1;
29 my ( $ok, $error ) = _eval($code);
34 like($error || '', $regex, $desc );
56 is( try { 42 }, 42, "try block evaluated" );
57 is( $@, "magic", '$@ untouched' );
62 is( try { die "foo" }, undef, "try block died" );
63 is( $@, "magic", '$@ untouched' );
68 like( (try { die "foo" } catch { $_ }), qr/foo/, "catch block evaluated" );
69 is( $@, "magic", '$@ untouched' );
72 is( scalar(try { "foo", "bar", "gorch" }), "gorch", "scalar context try" );
73 is_deeply( [ try {qw(foo bar gorch)} ], [qw(foo bar gorch)], "list context try" );
75 is( scalar(try { die } catch { "foo", "bar", "gorch" }), "gorch", "scalar context catch" );
76 is_deeply( [ try { die } catch {qw(foo bar gorch)} ], [qw(foo bar gorch)], "list context catch" );
80 my ($sub) = catch { my $a = $_; };
81 is(ref($sub), 'Try::Tiny::Catch', 'Checking catch subroutine scalar reference is correctly blessed');
85 my ($sub) = finally { my $a = $_; };
86 is(ref($sub), 'Try::Tiny::Finally', 'Checking finally subroutine scalar reference is correctly blessed');
98 fail("shouldn't happen");
103 } "try in try catch block";
113 die "rethrowing $err";
115 } qr/rethrowing foo/, "rethrow with try in catch block";
122 sub Evil::new { bless { }, $_[0] }
126 local $_ = "other magic";
129 my $object = Evil->new;
132 pass("catch invoked");
133 local $TODO = "i don't think we can ever make this work sanely, maybe with SIG{__DIE__}" if "$]" < 5.014;
137 is( $@, "magic", '$@ untouched' );
138 is( $_, "other magic", '$_ untouched' );
142 my ( $caught, $prev );
147 eval { die "bar\n" };
149 is( $@, "bar\n", 'previous value of $@' );
161 is_deeply( $caught, { prev => "bar\n" }, 'previous value of $@ available for capture' );
162 is( $prev, "bar\n", 'previous value of $@ also available in catch block' );