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