1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
use strict;
use warnings;
use Test::More tests => 4;
$TryCatch::SPECIAL_VALUE = \"foo";
sub try {}
sub catch (&$) {
my ($cond, $err) = @_;
local *_ = \$err;
return $cond->($err);
}
use Scalar::Util qw/blessed/;
sub simple_return {
# try {
# return "simple_return";
# die "Foo";
# }
# This doesn't work with wantarray
try my $__t_c_ret = eval {
return "simple_return";
die "Foo";
return $TryCatch::SPECIAL_VALUE;
};
if (my $__t_c_error = $@) {
die $__t_c_error;
}
if (!ref($__t_c_ret) || $__t_c_ret != $TryCatch::SPECIAL_VALUE) {
return $__t_c_ret;
}
}
sub simple_catch {
# try {
# die "Foo";
# }
# catch (Str $e) {
# return "str_error: $e";
# }
try my $__t_c_ret = eval {
die "Foo\n";
return $TryCatch::SPECIAL_VALUE;
};
if (my $__t_c_error = $@) {
if ( !ref($__t_c_error)) {
my $e = $__t_c_error;
return "str_error: $e";
}
die $__t_c_error;
}
if (!ref($__t_c_ret) || $__t_c_ret != $TryCatch::SPECIAL_VALUE) {
return $__t_c_ret;
}
}
sub simple_catch_cond {
# try {
# if ($_[0]) {
# Foo::Error->throw;
# } else {
# die "Foo\n";
# }
# }
# catch (Str $e) {
# return "str_error: $e";
# }
# catch (Foo::Error $err) {
# return "Foo::Error\n"
# }
try my $__t_c_ret = eval {
if ($_[0]) {
Foo::Error->throw;
} else {
die "Foo\n";
}
return $TryCatch::SPECIAL_VALUE;
};
if (my $__t_c_error = $@) {
if (catch { !ref } $@) {
my $e = $__t_c_error;
return "str_error: $e";
}
if (catch { blessed($_) && $_->isa('Foo::Error') } $@) {
my $err = shift;
return "Foo::Error\n";
return $TryCatch::SPECIAL_VALUE;
}
else {
die $__t_c_error;
}
}
if (!ref($__t_c_ret) || $__t_c_ret != $TryCatch::SPECIAL_VALUE) {
return $__t_c_ret;
}
return "bar";
}
is(simple_return(), "simple_return");
is(simple_catch(), "str_error: Foo\n");
is(simple_catch_cond(0), "str_error: Foo\n");
is(simple_catch_cond(1), "Foo::Error\n");
package #
Foo::Error;
sub throw {
die bless {}, __PACKAGE__;
}
|
