Commit | Line | Data |
3176feef |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Test::More tests => 15; |
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 | |
42 | sub Evil::DESTROY { |
43 | eval { "oh noes" }; |
44 | } |
45 | |
46 | lives_ok { |
47 | try { |
48 | die "foo"; |
49 | }; |
50 | } "basic try"; |
51 | |
52 | throws_ok { |
53 | try { |
54 | die "foo"; |
55 | } catch { die $_ }; |
56 | } qr/foo/, "rethrow"; |
57 | |
58 | |
59 | { |
60 | local $@ = "magic"; |
61 | is( try { 42 }, 42, "try block evaluated" ); |
62 | is( $@, "magic", '$@ untouched' ); |
63 | } |
64 | |
65 | { |
66 | local $@ = "magic"; |
67 | is( try { die "foo" }, undef, "try block died" ); |
68 | is( $@, "magic", '$@ untouched' ); |
69 | } |
70 | |
71 | { |
72 | local $@ = "magic"; |
73 | like( (try { die "foo" } catch { $_ }), qr/foo/, "catch block evaluated" ); |
74 | is( $@, "magic", '$@ untouched' ); |
75 | } |
76 | |
77 | is( scalar(try { qw(foo bar gorch) }), "gorch", "scalar context" ); |
78 | is_deeply( [ try {qw(foo bar gorch)} ], [qw(foo bar gorch)], "list context" ); |
79 | |
80 | |
81 | |
82 | { |
83 | local $@ = "magic"; |
84 | local $_ = "other magic"; |
85 | |
86 | try { |
87 | my $object = bless { }, "Evil"; |
88 | die "foo"; |
89 | } catch { |
90 | pass("catch invoked"); |
91 | local $TODO = "i don't think we can ever make this work sanely, maybe with SIG{__DIE__}"; |
92 | like($_, qr/foo/); |
93 | }; |
94 | |
95 | is( $@, "magic", '$@ untouched' ); |
96 | is( $_, "other magic", '$_ untouched' ); |
97 | } |