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
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
use strict;
use warnings;
use Test::More;
use Test::Exception;
use TryCatch;
my $line;
test_for_error(
qr/^block required after try at .*? line (\d+)\b/,
"no block after try",
<<'EOC' );
use TryCatch;
sub foo { }
try \&foo
EOC
is($line, 4, "Error from line 4");
# Its really *really* wierd that this 'fixes' things. I blame string evals
eval "use TryCatch; try {} catch" if $] >= 5.011000;
test_for_error(
qr/^block required after catch at \(eval \d+\) line (\d+)\b/,
"no block after catch",
<<'EOC');
use TryCatch;
try { 1 }
catch
my $foo = 2;
EOC
is($line, 5, "Error from line 5");
test_for_error(
qr/^Parameter expected near '\^' in '\^Err \$e' at \(eval \d+\) line (\d+)\b/,
"invalid catch signature",
<<'EOC');
# line 1
use TryCatch;
try { }
catch (^Err $e) {}
next;
EOC
is($line, 4, "Error from line 4");
test_for_error(
qr/^Run-away catch signature at \(eval \d+\) line (\d+)/,
"invalid catch signature (missing parenthesis)",
<<'EOC');
use TryCatch;
try { }
catch (
{}
1;
EOC
is($line, 4, "Error from line 4");
test_for_error(
qr/^Can't locate object method "bar" via package "catch" .*?at \(eval \d+\) line (\d+)\b/,
"bareword between try and catch",
<<'EOC');
use TryCatch;
try { } bar
catch {}
EOC
is($line, 3, "Error from line 3");
test_for_error(
qr/^Bareword "catch" not allowed while "strict subs" in use at \(eval \d+\) line (\d+)\b/,
"catch is not special",
<<'EOC');
use TryCatch;
catch;
EOC
is($line, 3, "Error from line 3");
compile_ok("try is not too reserved", <<'EOC');
use TryCatch;
try => 1;
EOC
compile_ok(
"catch is not special",
<<'EOC');
use TryCatch;
catch => 3;
EOC
{
local $TODO = 'Sort out POD';
compile_ok("POD doesn't interfer with things.", <<'EOC');
use TryCatch;
try {
}
=head1 POD
=cut
EOC
}
done_testing;
sub test_for_error {
local $Test::Builder::Level = $Test::Builder::Level + 1;
local $TODO;
local $SIG{__WARN__} = sub {};
my ($re, $msg, $code) = @_;
try {
eval $code;
die $@ if $@;
fail($msg);
}
catch ($e) {
like($e, $re, $msg);
($line) = ($e =~ /$re/);
}
}
sub compile_ok {
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ($msg, $code) = @_;
try {
eval $code;
die $@ if $@;
pass($msg);
}
catch ($e) {
diag($e);
fail($msg);
}
}
|
