whitespace
[p5sagit/Try-Tiny.git] / t / basic.t
CommitLineData
3176feef 1use strict;
f9d19a00 2use warnings;
3176feef 3
c6d66f74 4use Test::More tests => 25;
01b96275 5use Try::Tiny;
3176feef 6
7sub _eval {
8d2ee831 8 local $@;
9 local $Test::Builder::Level = $Test::Builder::Level + 2;
10 return ( scalar(eval { $_[0]->(); 1 }), $@ );
3176feef 11}
12
13
14sub lives_ok (&$) {
8d2ee831 15 my ( $code, $desc ) = @_;
16 local $Test::Builder::Level = $Test::Builder::Level + 1;
3176feef 17
8d2ee831 18 my ( $ok, $error ) = _eval($code);
3176feef 19
8d2ee831 20 ok($ok, $desc );
3176feef 21
8d2ee831 22 diag "error: $@" unless $ok;
3176feef 23}
24
25sub throws_ok (&$$) {
8d2ee831 26 my ( $code, $regex, $desc ) = @_;
27 local $Test::Builder::Level = $Test::Builder::Level + 1;
3176feef 28
8d2ee831 29 my ( $ok, $error ) = _eval($code);
3176feef 30
8d2ee831 31 if ( $ok ) {
32 fail($desc);
33 } else {
34 like($error || '', $regex, $desc );
35 }
3176feef 36}
37
38
511c05ca 39my $prev;
40
3176feef 41lives_ok {
8d2ee831 42 try {
43 die "foo";
44 };
3176feef 45} "basic try";
46
47throws_ok {
8d2ee831 48 try {
49 die "foo";
50 } catch { die $_ };
3176feef 51} qr/foo/, "rethrow";
52
53
54{
8d2ee831 55 local $@ = "magic";
56 is( try { 42 }, 42, "try block evaluated" );
57 is( $@, "magic", '$@ untouched' );
3176feef 58}
59
60{
8d2ee831 61 local $@ = "magic";
62 is( try { die "foo" }, undef, "try block died" );
63 is( $@, "magic", '$@ untouched' );
3176feef 64}
65
66{
8d2ee831 67 local $@ = "magic";
68 like( (try { die "foo" } catch { $_ }), qr/foo/, "catch block evaluated" );
69 is( $@, "magic", '$@ untouched' );
3176feef 70}
71
82ef0e61 72is( scalar(try { "foo", "bar", "gorch" }), "gorch", "scalar context try" );
73is_deeply( [ try {qw(foo bar gorch)} ], [qw(foo bar gorch)], "list context try" );
74
75is( scalar(try { die } catch { "foo", "bar", "gorch" }), "gorch", "scalar context catch" );
76is_deeply( [ try { die } catch {qw(foo bar gorch)} ], [qw(foo bar gorch)], "list context catch" );
77
3176feef 78
7195fc08 79{
8d2ee831 80 my ($sub) = catch { my $a = $_; };
81 is(ref($sub), 'Try::Tiny::Catch', 'Checking catch subroutine scalar reference is correctly blessed');
d864c889 82}
83
84{
8d2ee831 85 my ($sub) = finally { my $a = $_; };
86 is(ref($sub), 'Try::Tiny::Finally', 'Checking finally subroutine scalar reference is correctly blessed');
7195fc08 87}
3176feef 88
e605bd35 89lives_ok {
8d2ee831 90 try {
91 die "foo";
92 } catch {
93 my $err = shift;
94
95 try {
96 like $err, qr/foo/;
97 } catch {
98 fail("shouldn't happen");
99 };
100
101 pass "got here";
102 }
e605bd35 103} "try in try catch block";
104
105throws_ok {
8d2ee831 106 try {
107 die "foo";
108 } catch {
109 my $err = shift;
e605bd35 110
8d2ee831 111 try { } catch { };
e605bd35 112
8d2ee831 113 die "rethrowing $err";
114 }
e605bd35 115} qr/rethrowing foo/, "rethrow with try in catch block";
116
3176feef 117
1f7c5af6 118sub Evil::DESTROY {
8d2ee831 119 eval { "oh noes" };
1f7c5af6 120}
121
122sub Evil::new { bless { }, $_[0] }
123
3176feef 124{
8d2ee831 125 local $@ = "magic";
126 local $_ = "other magic";
127
128 try {
129 my $object = Evil->new;
130 die "foo";
131 } catch {
132 pass("catch invoked");
8c34b0ef 133 local $TODO = "i don't think we can ever make this work sanely, maybe with SIG{__DIE__}" if "$]" < 5.014;
8d2ee831 134 like($_, qr/foo/);
135 };
136
137 is( $@, "magic", '$@ untouched' );
138 is( $_, "other magic", '$_ untouched' );
3176feef 139}
511c05ca 140
141{
8d2ee831 142 my ( $caught, $prev );
511c05ca 143
8d2ee831 144 {
145 local $@;
511c05ca 146
8d2ee831 147 eval { die "bar\n" };
511c05ca 148
8d2ee831 149 is( $@, "bar\n", 'previous value of $@' );
511c05ca 150
8d2ee831 151 try {
152 die {
153 prev => $@,
154 }
155 } catch {
156 $caught = $_;
157 $prev = $@;
158 }
159 }
511c05ca 160
8d2ee831 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' );
511c05ca 163}