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